# # # patch "Monotone/AutomateStdio.pm" # from [7ea806b1169b0fe80eb2df68f2b22a796381cc0d] # to [a0a2f71fc2ad1d1802e6d45f47a5738e95db8cfb] # # patch "Monotone/AutomateStdio.pod" # from [0f6f685fec6cf9ff61cd678645711c8fa7150224] # to [bae534ed758919e0fe144dcedc56053f3eab4b80] # # patch "mtn-tester" # from [b5805af0a8b9e8fe0dd3b84beae7250ad4161079] # to [68653c125f4059b91d4fe9bf2516d448d3383f2d] # ============================================================ --- Monotone/AutomateStdio.pm 7ea806b1169b0fe80eb2df68f2b22a796381cc0d +++ Monotone/AutomateStdio.pm a0a2f71fc2ad1d1802e6d45f47a5738e95db8cfb @@ -20,13 +20,13 @@ # This library is distributed in the hope that it will be # useful, but WITHOUT ANY WARRANTY; without even the implied # warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR -# PURPOSE. See the GNU Library General Public License for +# PURPOSE. See the GNU Lesser General Public License for # more details. # -# You should have received a copy of the GNU Library General +# You should have received a copy of the GNU Lesser General # Public License along with this library; if not, write to # the Free Software Foundation, Inc., 59 Temple Place - Suite -# 330, Boston, MA 02111-1307 USA. +# 330, Boston, MA 02111-1307 USA. # ############################################################################## # @@ -52,6 +52,7 @@ use IPC::Open3; use integer; use Carp; use IPC::Open3; +use POSIX qw(:errno_h); use Symbol qw(gensym); # ***** GLOBAL DATA DECLARATIONS ***** @@ -75,6 +76,13 @@ my $closing_quote_re = qr/(((^.*[^\\])|^ |(((^.*[^\\])|^)\\{18}\"$) |(((^.*[^\\])|^)\\{20}\"$)/ox; +# Global error callback routine references. + +my $croaker = \&croak; +my $carper = undef; +my($error_handler, + $warning_handler); + # ***** CLASS DEFINITIONS ***** # Class inheritance and declaration. @@ -127,16 +135,17 @@ sub erase_ancestors($\@@); sub db_set($$$$); sub descendents($\@@); sub erase_ancestors($\@@); -sub error_message($); sub get_attributes($\$$); sub get_base_revision_id($\$); sub get_content_changed(address@hidden); sub get_corresponding_path($\$$$$); sub get_current_revision_id($\$); +sub get_error_message($); sub get_file($\$$); sub get_file_of($\$$;$); sub get_manifest_of($$;$); sub get_option($\$$); +sub get_pid($); sub get_revision($\$$); sub graph($$); sub heads($\@;$); @@ -145,21 +154,24 @@ sub leaves($\@); sub inventory($$); sub keys($$); sub leaves($\@); +sub new($;$); sub parents(address@hidden); +sub register_error_handler($$); sub roots($\@); sub select(address@hidden); sub tags($$;$); sub toposort($\@@); -sub new($;$); # Private routines. +sub error_handler_wrapper($); sub get_quoted_value(address@hidden); sub mtn_command($$$@); sub mtn_command_with_options($$$\@@); sub mtn_read_output($\$); sub startup($); sub unescape($); +sub warning_handler_wrapper($); # ############################################################################## # @@ -403,8 +415,8 @@ sub certs($$$) } else { - croak("Corrupt certs list, expected signature field but " - . "didn't find it"); + &$croaker("Corrupt certs list, expected signature field " + . "but didn't find it"); } if ($lines[++ $i] =~ m/^ *name \"/o) { @@ -412,8 +424,8 @@ sub certs($$$) } else { - croak("Corrupt certs list, expected name field but didn't " - . "find it"); + &$croaker("Corrupt certs list, expected name field but " + . "didn't find it"); } if ($lines[++ $i] =~ m/^ *value \"/o) { @@ -421,8 +433,8 @@ sub certs($$$) } else { - croak("Corrupt certs list, expected value field but " - . "didn't find it"); + &$croaker("Corrupt certs list, expected value field but " + . "didn't find it"); } if ($lines[++ $i] =~ m/^ *trust \"/o) { @@ -430,8 +442,8 @@ sub certs($$$) } else { - croak("Corrupt certs list, expected trust field but " - . "didn't find it"); + &$croaker("Corrupt certs list, expected trust field but " + . "didn't find it"); } $$ref[$j ++] = {key => unescape($key), signature => $signature, @@ -735,8 +747,8 @@ sub get_attributes($\$$) } else { - croak("Corrupt attributes list, expected state field but " - . "didn't find it"); + &$croaker("Corrupt attributes list, expected state field " + . "but didn't find it"); } $$ref[$j ++] = {attribute => unescape($key), value => unescape($value), @@ -1058,8 +1070,8 @@ sub get_manifest_of($$;$) } else { - croak("Corrupt manifest, expected content field but " - . "didn't find it"); + &$croaker("Corrupt manifest, expected content field but " + . "didn't find it"); } } if ($lines[$i] =~ m/^ *dir \"/o) @@ -1192,8 +1204,8 @@ sub get_revision($\$$) } else { - croak("Corrupt revision, expected content field but " - . "didn't find it"); + &$croaker("Corrupt revision, expected content field but " + . "didn't find it"); } $$ref[$j ++] = {type => "add_file", name => unescape($name), @@ -1208,8 +1220,8 @@ sub get_revision($\$$) } else { - croak("Corrupt revision, expected attr field but didn't " - . "find it"); + &$croaker("Corrupt revision, expected attr field but " + . "didn't find it"); } $$ref[$j ++] = {type => "clear", name => unescape($name), @@ -1242,8 +1254,8 @@ sub get_revision($\$$) } else { - croak("Corrupt revision, expected from field but didn't " - . "find it"); + &$croaker("Corrupt revision, expected from field but " + . "didn't find it"); } if ($lines[++ $i] =~ m/^ *to \[[^\]]+\]$/o) { @@ -1251,8 +1263,8 @@ sub get_revision($\$$) } else { - croak("Corrupt revision, expected to field but didn't " - . "find it"); + &$croaker("Corrupt revision, expected to field but didn't " + . "find it"); } $$ref[$j ++] = {type => "patch", name => unescape($name), @@ -1268,8 +1280,8 @@ sub get_revision($\$$) } else { - croak("Corrupt revision, expected to field but didn't " - . "find it"); + &$croaker("Corrupt revision, expected to field but didn't " + . "find it"); } $$ref[$j ++] = {type => "rename", from_name => unescape($from_name), @@ -1284,8 +1296,8 @@ sub get_revision($\$$) } else { - croak("Corrupt revision, expected attr field but didn't " - . "find it"); + &$croaker("Corrupt revision, expected attr field but " + . "didn't find it"); } if ($lines[++ $i] =~ m/^ *value \"/o) { @@ -1293,8 +1305,8 @@ sub get_revision($\$$) } else { - croak("Corrupt revision, expected value field but didn't " - . "find it"); + &$croaker("Corrupt revision, expected value field but " + . "didn't find it"); } $$ref[$j ++] = {type => "set", name => unescape($name), @@ -1694,8 +1706,8 @@ sub keys($$) } else { - croak("Corrupt keys, expected public_hash field but " - . "didn't find it"); + &$croaker("Corrupt keys, expected public_hash field but " + . "didn't find it"); } if ($lines[$i] =~ m/^ *private_hash \[[^\]]+\]$/o) { @@ -1709,8 +1721,8 @@ sub keys($$) } else { - croak("Corrupt keys, expected public_location field but " - . "didn't find it"); + &$croaker("Corrupt keys, expected public_location field " + . "but didn't find it"); } if ($i <= $#lines && $lines[$i] =~ m/^ *private_location \"/o) { @@ -1917,8 +1929,8 @@ sub tags($$;$) } else { - croak("Corrupt tags list, expected revision field but " - . "didn't find it"); + &$croaker("Corrupt tags list, expected revision field but " + . "didn't find it"); } if ($lines[++ $i] =~ m/^ *signer \"/o) { @@ -1926,8 +1938,8 @@ sub tags($$;$) } else { - croak("Corrupt tags list, expected signer field but " - . "didn't find it"); + &$croaker("Corrupt tags list, expected signer field but " + . "didn't find it"); } if ($lines[++ $i] =~ m/^ *branches/o) { @@ -1943,8 +1955,8 @@ sub tags($$;$) } else { - croak("Corrupt tags list, expected branches field but " - . "didn't find it"); + &$croaker("Corrupt tags list, expected branches field but " + . "didn't find it"); } $$ref[$j ++] = {tag => unescape($tag), revision_id => $rev, @@ -1990,12 +2002,87 @@ sub toposort($\@@) # ############################################################################## # -# Routine - error_message +# Routine - register_error_handler # +# Description - Register the specified routine as an error handler for this +# library. This is a class method rather than an object one +# as errors can be raised when calling the constructor. +# +# Data - $this : The object. This may not be present depending +# upon how this method is called and is ignored +# if it is present anyway. +# $severity : The level of error that the handler is being +# registered for. One of "error", "warning" or +# "both". +# $callback : A reference to the error handler routine. If +# this is undef then the existing error handler +# routine is unregistered and errors are raised +# in the default way. +# +############################################################################## + + + +sub register_error_handler($$) +{ + + shift() if ($#_ > 1); + my($severity, $handler) = @_; + + if ($severity eq "error") + { + if (defined($handler)) + { + $error_handler = $handler; + $croaker = \&error_handler_wrapper; + } + else + { + $croaker = \&croak; + $error_handler = undef; + } + } + elsif ($severity eq "warning") + { + if (defined($handler)) + { + $warning_handler = $handler; + $carper = \&warning_handler_wrapper; + } + else + { + $carper = $warning_handler = undef; + } + } + elsif ($severity eq "both") + { + if (defined($handler)) + { + $error_handler = $warning_handler = $handler; + $carper = \&warning_handler_wrapper; + $croaker = \&error_handler_wrapper; + } + else + { + $carper = $error_handler = $warning_handler = undef; + $croaker = \&croak; + } + } + else + { + croak("Unknown error handler severity `" . $severity . "'"); + } + +} +# +############################################################################## +# +# Routine - get_error_message +# # Description - Return the last error message received from the mtn # subprocess. # -# Data - $this : The object. +# Data - $this : The object. # Return Value : The last error message received, or an empty # string if nothing has gone wrong yet. # @@ -2003,7 +2090,7 @@ sub toposort($\@@) -sub error_message($) +sub get_error_message($) { my Monotone::AutomateStdio $this = $_[0]; @@ -2014,6 +2101,30 @@ sub error_message($) # ############################################################################## # +# Routine - get_pid +# +# Description - Return the process id of the mtn automate stdio process. +# +# Data - $this : The object. +# Return Value : The process id of the mtn automate stdio +# process, or zero if no process is thought to +# be running. +# +############################################################################## + + + +sub get_pid($) +{ + + my Monotone::AutomateStdio $this = $_[0]; + + return $this->{mtn_pid}; + +} +# +############################################################################## +# # Routine - closedown # # Description - If started then stop the mtn subprocess. @@ -2065,9 +2176,12 @@ sub closedown($) } else { - $err_msg = $!; - kill("KILL", $this->{mtn_pid}); - croak("waitpid failed: $err_msg"); + if ($! != ECHILD) + { + $err_msg = $!; + kill("KILL", $this->{mtn_pid}); + &$croaker("waitpid failed: $err_msg"); + } } } $this->{mtn_pid} = 0; @@ -2256,14 +2370,14 @@ sub mtn_read_output($\$) { if ($char ne "m" && $char ne "l") { - croak("Corrupt/missing mtn chunk header, mtn gave:\n" - . join("", <$err>)); + &$croaker("Corrupt/missing mtn chunk header, mtn " + . "gave:\n" . join("", <$err>)); } } elsif ($char =~ m/\D$/o) { - croak("Corrupt/missing mtn chunk header, mtn gave:\n" - . join("", <$err>)); + &$croaker("Corrupt/missing mtn chunk header, mtn gave:\n" + . join("", <$err>)); } } @@ -2275,7 +2389,7 @@ sub mtn_read_output($\$) ($header =~ m/^(\d+):(\d+):([lm]):(\d+):$/o); if ($cmd_nr != $this->{cmd_cnt}) { - croak("Mtn command count is out of sequence"); + &$croaker("Mtn command count is out of sequence"); } if ($err_code != 0) { @@ -2284,8 +2398,8 @@ sub mtn_read_output($\$) } else { - croak("Corrupt/missing mtn chunk header, mtn gave:\n" - . join("", <$err>)); + &$croaker("Corrupt/missing mtn chunk header, mtn gave:\n" + . join("", <$err>)); } $chunk_start = 0; @@ -2301,7 +2415,7 @@ sub mtn_read_output($\$) $size, $offset))) { - croak("read failed: $!"); + &$croaker("read failed: $!"); } $size -= $bytes_read; $offset += $bytes_read; @@ -2322,6 +2436,7 @@ sub mtn_read_output($\$) { $this->{mtn_err_msg} = $$buffer; $$buffer = ""; + &$carper($this->{mtn_err_msg}) if (defined($carper)); return; } @@ -2438,7 +2553,7 @@ sub unescape($) my $data = $_[0]; - return undef unless defined($data); + return undef unless (defined($data)); $data =~ s/\\\\/\\/g; $data =~ s/\\\"/\"/g; @@ -2446,5 +2561,52 @@ sub unescape($) return $data; } +# +############################################################################## +# +# Routine - error_handler_wrapper +# +# Description - Error handler routine that wraps the user's error handler. +# Essentially this routine simply prepends the severity +# parameter. +# +# Data - $message : The error message. +# +############################################################################## + + +sub error_handler_wrapper($) +{ + + my $message = $_[0]; + + &$error_handler("error", $message); + die(); + +} +# +############################################################################## +# +# Routine - warning_handler_wrapper +# +# Description - Warning handler routine that wraps the user's warning +# handler. Essentially this routine simply prepends the +# severity parameter. +# +# Data - $message : The error message. +# +############################################################################## + + + +sub warning_handler_wrapper($) +{ + + my $message = $_[0]; + + &$warning_handler("warning", $message); + +} + 1; ============================================================ --- Monotone/AutomateStdio.pod 0f6f685fec6cf9ff61cd678645711c8fa7150224 +++ Monotone/AutomateStdio.pod bae534ed758919e0fe144dcedc56053f3eab4b80 @@ -14,7 +14,7 @@ 0.2 my $mtn = Monotone::AutomateStdio->new("/home/fred/venge.mtn"); my @manifest; $mtn->get_manifest_of(address@hidden) - or die("mtn: " . $mtn->error_message()); + or die("mtn: " . $mtn->get_error_message()); =head1 DESCRIPTION @@ -26,7 +26,7 @@ is started, if necessary, when anything The mtn automate subprocess is also controlled by this class. A new subprocess is started, if necessary, when anything that requires it is called. The -subprocess is terminated on object destruction or when $mtn->closedown() is +subprocess is terminated on object destruction or when $mtn-Eclosedown() is called. All automate commands have been implemented in this class except for the @@ -47,23 +47,47 @@ ask about the `stdio' command:-). style commands just seem too scary for words and hopefully you do not have to ask about the `stdio' command:-). -=head1 CONSTRUCTOR +=head1 CONSTRUCTORS =over 4 -=item new() +=item B<$mtn = Monotone::AutomateStdio-Enew()> Creates a new Monotone::AutomateStdio object, using the current workspace's database. -=item new($db) +=item B<$mtn = Monotone::AutomateStdio-Enew($db)> Creates a new Monotone::AutomateStdio object, using the database named in $db. =back -=head1 METHODS +=head1 CLASS METHODS +=over 4 + +=item Bregister_error_handler($severity, +$handler)> + +Registers the handler specified as a subroutine reference in $handler for +errors of a certain severity as specified by $severity. $severity can be one of +"warning", "error" or "both". This is a class method rather than an object one +as errors can be raised when calling a constructor. If undef is passed in +$handler then error handling is reset to the default behaviour for that +severity level. + +The handler subroutine is given two arguments, the first one is a severity +string that indicates the severity of the error being handled, either "warning" +or "error", and the error message. Please note that if the severity is "error" +then it is expected that croak or die will be called by the handler, if this is +not the case then the library will do it anyway upon return. If you really need +to trap errors and prevent program exit then use an eval block to protect +yourself in the calling code. + +=back + +=head1 OBJECT METHODS + See http://monotone.ca/monotone.html for a complete description of the mtn automate commands. @@ -89,25 +113,25 @@ The following methods are provided: =over 4 -=item $mtn->ancestors(address@hidden, @revision_ids) +=item B<$mtn-Eancestors(address@hidden, @revision_ids)> Get a list of ancestors for the specified revisions. -=item $mtn->ancestry_difference(address@hidden, $new_revision_id -[, $old_revision_id ...]) +=item B<$mtn-Eancestry_difference(address@hidden, $new_revision_id +[, $old_revision_id ...])> Get a list of ancestors for the specified revision, that are not also ancestors for the specified old revisions. -=item $mtn->branches(address@hidden) +=item B<$mtn-Ebranches(address@hidden)> Get a list of branches. -=item $mtn->cert($revision_id, $name, $value) +=item B<$mtn-Ecert($revision_id, $name, $value)> Add the specified cert to the specified revision. -=item $mtn->certs(\$buffer | address@hidden, $revision_id) +=item B<$mtn-Ecerts(\$buffer | address@hidden, $revision_id)> Get all the certs for the specified revision. If \$buffer is passed then the output from the command is simply placed into the variable. However if @@ -122,20 +146,20 @@ each one containing the following fields trust - Its trust status. Values can be one of "trusted" or "untrusted". -=item $mtn->children(address@hidden, $revision_id) +=item B<$mtn-Echildren(address@hidden, $revision_id)> Get a list of children for the specified revision. -=item $mtn->closedown() +=item B<$mtn-Eclosedown()> If started then stop the mtn subprocess. -=item $mtn->common_ancestors(address@hidden, $revision_id ...) +=item B<$mtn-Ecommon_ancestors(address@hidden, $revision_id ...)> Get a list of revisions that are all ancestors of the specified revision(s). -=item $mtn->content_diff(\$buffer, $revision_id1, $revision_id2 -[, $file_name ...]) +=item B<$mtn-Econtent_diff(\$buffer, $revision_id1, $revision_id2 +[, $file_name ...])> Get the difference between the two specified revisions, optionally limiting it to the specified list of files. If the second revision id is undefined @@ -143,29 +167,25 @@ listed then differences in all files are then the workspace's and base revisions are used. If no file names are listed then differences in all files are reported. -=item $mtn->db_get(\$buffer, $domain, $name) +=item B<$mtn-Edb_get(\$buffer, $domain, $name)> Get the value of a database variable. -=item $mtn->db_set($domain, $name, $value) +=item B<$mtn-Edb_set($domain, $name, $value)> Set the value of a database variable. -=item $mtn->descendents(address@hidden, $revision_id ...) +=item B<$mtn-Edescendents(address@hidden, $revision_id ...)> Get a list of descendants for the specified revision(s). -=item $mtn->erase_ancestors(address@hidden, $revision_id ...) +=item B<$mtn-Eerase_ancestors(address@hidden, $revision_id ...)> For a given list of revisions, weed out those that are ancestors to other revisions specified within the list. -=item $mtn->error_message() +=item B<$mtn-Eget_attributes(\$buffer, $file_name)> -Return the last error message received from the mtn subprocess. - -=item $mtn->get_attributes(\$buffer, $file_name) - Get the attributes of the specified file. If \$buffer is passed then the output from the command is simply placed into the variable. However if address@hidden is passed then the output is returned as a list of anonymous hashes, each one @@ -176,36 +196,41 @@ containing the following fields: state - The status of the attribute. Values can be one of "added", "changed", "dropped" or "unchanged". -=item $mtn->get_base_revision_id(\$buffer) +=item B<$mtn-Eget_base_revision_id(\$buffer)> Get the revision upon which the workspace is based. -=item $mtn->get_content_changed(address@hidden, $revision_id, $file_name) +=item B<$mtn-Eget_content_changed(address@hidden, $revision_id, $file_name)> Get a list of revisions in which the content was most recently changed, relative to the specified revision. -=item $mtn->get_corresponding_path(\$buffer, $source_revision_id, $file_name, -$target_revision_id) +=item B<$mtn-Eget_corresponding_path(\$buffer, $source_revision_id, +$file_name, $target_revision_id)> For the specified file name in the specified source revision, return the corresponding file name for the specified target revision. -=item $mtn->get_current_revision_id(\$buffer) +=item B<$mtn-Eget_current_revision_id(\$buffer)> Get the revision that would be created if an unrestricted commit was done in the workspace. -=item $mtn->get_file(\$buffer, $file_id) +=item B<$mtn-Eget_error_message()> +Return the last error message received from the mtn subprocess. An empty string +is returned if there is nothing to report. + +=item B<$mtn-Eget_file(\$buffer, $file_id)> + Get the contents of the file referenced by the specified file id. -=item $mtn->get_file_of(\$buffer, $file_name[, $revision_id]) +=item B<$mtn-Eget_file_of(\$buffer, $file_name[, $revision_id])> Get the contents of the specified file under the specified revision. If the revision id is undefined then the current workspace revision is used. -=item $mtn->get_manifest_of(\$buffer | address@hidden, $revision_id) +=item B<$mtn-Eget_manifest_of(\$buffer | address@hidden, $revision_id)> Get the manifest for the current or specified revision. If \$buffer is passed then the output from the command is simply placed into the @@ -218,12 +243,19 @@ of anonymous hashes, each one containing file_id - The id of the file. This field is only present if type is set to "file". -=item $mtn->get_option(\$buffer, $option_name) +=item B<$mtn-Eget_option(\$buffer, $option_name)> Get the value of an option stored in a workspace's _MTN directory. -=item $mtn->get_revision(\$buffer | address@hidden, $revision_id) +=item B<$mtn-Eget_pid()> +Return the process id of the mtn subprocess spawned by this library. Zero is +returned if no subprocess is thought to exist. Also if the subprocess should +exit unexpectedly then this method will carry on returning its process id until +the $mtn-Eclosedown() method is called. + +=item B<$mtn-Eget_revision(\$buffer | address@hidden, $revision_id)> + Get the revision information for the current or specified revision. If \$buffer is passed then the output from the command is simply placed into the variable. However if address@hidden is passed then the output is returned as a list of @@ -269,7 +301,7 @@ type of entry: attribute - The name of the attribute that was set. value - The value that the attribute was set to. -=item $mtn->graph(\$buffer | address@hidden) +=item B<$mtn-Egraph(\$buffer | address@hidden)> Get a complete ancestry graph of the database. If \$buffer is passed then the output from the command is simply placed into the variable. However if address@hidden @@ -279,20 +311,20 @@ containing the following fields: revision_id - The id of a revision. parent_ids - A list of parent revision ids. -=item $mtn->heads(address@hidden, $branch_name]) +=item B<$mtn-Eheads(address@hidden, $branch_name])> Get a list of revision ids that are heads on the specified branch. If no branch is given then the workspace's branch is used. -=item $mtn->identify(\$buffer, $file_name) +=item B<$mtn-Eidentify(\$buffer, $file_name)> Get the file id, i.e. hash, of the specified file. -=item $mtn->interface_version(\$buffer) +=item B<$mtn-Einterface_version(\$buffer)> Get the version of the mtn automate interface. -=item $mtn->inventory(\$buffer | address@hidden) +=item B<$mtn-Einventory(\$buffer | address@hidden)> Get the inventory for the current workspace. If \$buffer is passed then the output from the command is simply placed into the variable. However if address@hidden @@ -329,7 +361,7 @@ containing the following fields: Please note that some fields are not used by all entries, in which case they are set to undef. -=item $mtn->keys(\$buffer | address@hidden) +=item B<$mtn-Ekeys(\$buffer | address@hidden)> Get a list of all the keys known to mtn. If \$buffer is passed then the output from the command is simply placed into the variable. However if address@hidden is @@ -350,23 +382,23 @@ containing the following fields: "keystore". This field is only present if type is set to "public-private". -=item $mtn->leaves(address@hidden) +=item B<$mtn-Eleaves(address@hidden)> Get a list of leaf revisions. -=item $mtn->parents(address@hidden, $revision_id) +=item B<$mtn-Eparents(address@hidden, $revision_id)> Get a list of parents for the specified revision. -=item $mtn->roots(address@hidden) +=item B<$mtn-Eroots(address@hidden)> Get a list of root revisions, i.e. revisions with no parents. -=item $mtn->select(address@hidden, $selector) +=item B<$mtn-Eselect(address@hidden, $selector)> Get a list of revision ids that match the specified selector. -=item $mtn->tags(\$buffer | address@hidden, $branch_pattern]) +=item B<$mtn-Etags(\$buffer | address@hidden, $branch_pattern])> Get all the tags attached to revisions on branches that match the specified branch pattern. If no pattern is given then all branches are searched. If @@ -379,7 +411,7 @@ anonymous hashes, each one containing th signer - The name of the key used to sign the tag cert. branches - A list of all branches that contain this revision. -=item $mtn->toposort(address@hidden, $revision_id ...]) +=item B<$mtn-Etoposort(address@hidden, $revision_id ...])> Sort the specified revisions such that the ancestors come out first. @@ -387,16 +419,20 @@ Sort the specified revisions such that t =head1 RETURN VALUE -Except for the constructor and the $mtn->closedown() and $mtn->error_message() -methods, all remaining methods return a boolean success indicator, true for -success or false for failure. The constructor returns a newly created object, -$mtn->error_message() returns a string and $mtn->closedown() does not return -anything. +Except for the constructor and the +Monotone::AutomateStdio-Eregister_error_handler(), $mtn-Eclosedown(), +$mtn-Eget_error_message() and $mtn-Eget_pid() methods, all remaining +methods return a boolean success indicator, true for success or false for +failure (where true is 1 and false is undef). The constructor returns a newly +created object, $mtn-Eget_error_message() returns a string, +$mtn-Eget_pid() returns an integer and +Monotone::AutomateStdio-Eregister_error_handler() and $mtn-Eclosedown() +do not return anything. =head1 NOTES -The Monotone::AutomateStdio class, with the exception of the $mtn->cert() and -$mtn->db_set() methods, provides a read-only interface to a Monotone +The Monotone::AutomateStdio class, with the exception of the $mtn-Ecert() +and $mtn-Edb_set() methods, provides a read-only interface to a Monotone database. This is a deliberate safety precaution for now. In order to reliably shutdown the mtn subprocess, the alarm() routine is used ============================================================ --- mtn-tester b5805af0a8b9e8fe0dd3b84beae7250ad4161079 +++ mtn-tester 68653c125f4059b91d4fe9bf2516d448d3383f2d @@ -18,13 +18,23 @@ my($data, @list, $mtn); +Monotone::AutomateStdio->register_error_handler + ("both", + sub + { + my($severity, $message) = @_; + printf(STDERR "PROBLEM (%s): %s\n", $severity, $message); + die() if ($severity eq "error"); + }); +# Monotone::AutomateStdio::register_error_handler("both", undef); + $mtn = Monotone::AutomateStdio->new("/home/aecoope/perl/test.mtn"); # $mtn = Monotone->new(); if (0) { if (! $mtn->branches(address@hidden)) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -32,7 +42,7 @@ if (0) } if (! $mtn->certs(address@hidden, "ae65e53a3beca7841a87eb4525f39e3369107b82")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -41,11 +51,11 @@ if (0) if (! $mtn->cert("ae65e53a3beca7841a87eb4525f39e3369107b82", "status", "EXTERMINATE")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } if (! $mtn->children(address@hidden, "78bfd27c26a0c8ac249f30293e6ef6d5f44e6084")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -54,7 +64,7 @@ if (0) } if (! $mtn->children(address@hidden, "ae65e53a3beca7841a87eb4525f39e3369107b82")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -64,7 +74,7 @@ if (0) "ed89ce366c3316f189f01229adc863b3285130e2", "65e51cd2a00b4ee60b9fcc356e8e503d1e690414")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -76,7 +86,7 @@ if (0) "78bfd27c26a0c8ac249f30293e6ef6d5f44e6084", "ff7e085fab7385fbaabc57c1f53a9bbea59bf132")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -86,7 +96,7 @@ if (0) "ae65e53a3beca7841a87eb4525f39e3369107b82", "d612b1ed732ea565085eede32bb2a1fae2ca8804")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -97,7 +107,7 @@ if (0) "d612b1ed732ea565085eede32bb2a1fae2ca8804", "Makefile")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -105,7 +115,7 @@ if (0) } if (! $mtn->descendents(address@hidden, "d612b1ed732ea565085eede32bb2a1fae2ca8804")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -115,7 +125,7 @@ if (0) "ae65e53a3beca7841a87eb4525f39e3369107b82", "d612b1ed732ea565085eede32bb2a1fae2ca8804")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -123,7 +133,7 @@ if (0) } if (! $mtn->get_base_revision_id(\$data)) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -133,7 +143,7 @@ if (0) "ae65e53a3beca7841a87eb4525f39e3369107b82", "Makefile")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -145,7 +155,7 @@ if (0) "Makefile", "d612b1ed732ea565085eede32bb2a1fae2ca8804")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -153,7 +163,7 @@ if (0) } if (! $mtn->get_current_revision_id(\$data)) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -161,7 +171,7 @@ if (0) } if (! $mtn->get_file(\$data, "f7bec98218953adbb833865ccc52ea74d410b24e")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -169,7 +179,7 @@ if (0) } if (! $mtn->get_file_of(\$data, "Makefile")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -177,7 +187,7 @@ if (0) } if (! $mtn->get_option(\$data, "database")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -187,7 +197,7 @@ if (! $mtn->get_attributes(\$data, "scri if (! $mtn->get_attributes(\$data, "script2")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -196,7 +206,7 @@ if (! $mtn->get_attributes(address@hidden, "scri if (! $mtn->get_attributes(address@hidden, "script2")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -205,7 +215,7 @@ if (! $mtn->branches(address@hidden)) if (! $mtn->branches(address@hidden)) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -214,7 +224,7 @@ if (! $mtn->get_option(\$data, "database if (! $mtn->get_option(\$data, "database")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -223,7 +233,7 @@ if (! $mtn->get_revision(\$data, "d83907 if (! $mtn->get_revision(\$data, "d83907887a2a35229ef361a74e98bd296d84e60c")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -232,7 +242,7 @@ if (! $mtn->get_revision(\$data,)) if (! $mtn->get_revision(\$data,)) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -241,7 +251,7 @@ if (! $mtn->get_manifest_of(address@hidden)) if (! $mtn->get_manifest_of(address@hidden)) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -250,7 +260,7 @@ if (! $mtn->get_manifest_of(\$data)) if (! $mtn->get_manifest_of(\$data)) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -259,7 +269,7 @@ if (! $mtn->certs(address@hidden, "d83907887a2a3 if (! $mtn->certs(address@hidden, "d83907887a2a35229ef361a74e98bd296d84e60c")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -268,7 +278,7 @@ if (! $mtn->certs(\$data, "d83907887a2a3 if (! $mtn->certs(\$data, "d83907887a2a35229ef361a74e98bd296d84e60c")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -277,12 +287,12 @@ if (! $mtn->db_set("database", "default- if (! $mtn->db_set("database", "default-server", "www.test.com")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } if (! $mtn->db_get(\$data, "database", "default-server")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -291,7 +301,7 @@ if (! $mtn->graph(address@hidden)) if (! $mtn->graph(address@hidden)) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -300,7 +310,7 @@ if (! $mtn->graph(\$data)) if (! $mtn->graph(\$data)) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -309,7 +319,7 @@ if (! $mtn->heads(address@hidden, "net.venge.mon if (! $mtn->heads(address@hidden, "net.venge.monotone.www")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -318,7 +328,7 @@ if (! $mtn->identify(\$data, "Makefile.a if (! $mtn->identify(\$data, "Makefile.am")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -327,7 +337,7 @@ if (! $mtn->interface_version(\$data)) if (! $mtn->interface_version(\$data)) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -336,7 +346,7 @@ if (! $mtn->inventory(\$data)) if (! $mtn->inventory(\$data)) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -345,7 +355,7 @@ if (! $mtn->inventory(address@hidden)) if (! $mtn->inventory(address@hidden)) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -354,7 +364,7 @@ if (! $mtn->keys(\$data)) if (! $mtn->keys(\$data)) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -363,7 +373,7 @@ if (! $mtn->keys(address@hidden)) if (! $mtn->keys(address@hidden)) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -372,7 +382,7 @@ if (! $mtn->leaves(address@hidden)) if (! $mtn->leaves(address@hidden)) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -381,7 +391,7 @@ if (! $mtn->parents(address@hidden, "d83907887a2 if (! $mtn->parents(address@hidden, "d83907887a2a35229ef361a74e98bd296d84e60c")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -390,7 +400,7 @@ if (! $mtn->roots(address@hidden)) if (! $mtn->roots(address@hidden)) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -399,7 +409,7 @@ if (! $mtn->select(address@hidden, "l:2007-01-01 if (! $mtn->select(address@hidden, "l:2007-01-01/b:net.venge.monotone")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -408,7 +418,7 @@ if (! $mtn->tags(\$data, "net.venge.mono if (! $mtn->tags(\$data, "net.venge.monotone")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -417,7 +427,7 @@ if (! $mtn->tags(address@hidden, "net.venge.mono if (! $mtn->tags(address@hidden, "net.venge.monotone")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -426,7 +436,7 @@ if (! $mtn->get_revision(\$data, "492d55 if (! $mtn->get_revision(\$data, "492d55d26d09e8358bc239eaf2bf422350bf2d13")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { @@ -435,14 +445,14 @@ if (! $mtn->get_revision(address@hidden, "492d55 if (! $mtn->get_revision(address@hidden, "492d55d26d09e8358bc239eaf2bf422350bf2d13")) { - printf(STDERR "OOPS: %s\n", $mtn->error_message()); + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); } else { print Dumper(address@hidden); } -printf("Last error message `%s'\n", $mtn->error_message()); +printf("Last error message `%s'\n", $mtn->get_error_message()); print Dumper (\$mtn); printf("Destroying object.\n");