# # # patch "Monotone/AutomateStdio.pm" # from [ee35d3a30aa2fdf2983f6aba9ba9c0140aceaa3a] # to [2c5747294e7d73b21fdaa7519b20ba8d53a51d80] # # patch "Monotone/AutomateStdio.pod" # from [1ce23141cedc55c1450df1341cebd1bb21a59ecf] # to [d54fc235262827b1cf8a06dc569ca97cfae02458] # ============================================================ --- Monotone/AutomateStdio.pm ee35d3a30aa2fdf2983f6aba9ba9c0140aceaa3a +++ Monotone/AutomateStdio.pm 2c5747294e7d73b21fdaa7519b20ba8d53a51d80 @@ -57,20 +57,27 @@ use Carp; # Standard Perl and CPAN modules. use Carp; -use IO::Poll qw(POLLIN); +use IO::Poll qw(POLLIN POLLPRI); use IPC::Open3; use POSIX qw(:errno_h); use Symbol qw(gensym); # ***** GLOBAL DATA DECLARATIONS ***** +# Constants used to represent the different types of capability Monotone may or +# may not provide depending upon its version. + +use constant MTN_IGNORE_SUSPEND_CERTS => 1; +use constant MTN_INVENTORY_IO_STANZA_FORMAT => 2; +use constant MTN_P_SELECTOR => 3; + # A pre-compiled regular expression for finding the end of a quoted string # possibly containing escaped quotes, i.e. " preceeded by a non-backslash # character or an even number of backslash characters. my $closing_quote_re = qr/((^.*[^\\])|^)(\\{2})*\"$/; -# A pre-compiled regular expression for recoginising database locked conditions +# A pre-compiled regular expression for recognising database locked conditions # in error output. my $database_locked_re = qr/.*sqlite error: database is locked.*/; @@ -97,6 +104,7 @@ sub branches($\@); sub ancestors($\@@); sub ancestry_difference(address@hidden;@); sub branches($\@); +sub can($$); sub cert($$$$); sub certs($$$); sub children(address@hidden); @@ -123,6 +131,7 @@ sub identify($\$$); sub graph($$); sub heads($\@;$); sub identify($\$$); +sub ignore_suspend_certs($$); sub interface_version($\$); sub inventory($$); sub keys($$); @@ -154,8 +163,11 @@ use base qw(Exporter); use base qw(Exporter); +our %EXPORT_TAGS = (constants => [qw(MTN_IGNORE_SUSPEND_CERTS + MTN_INVENTORY_IO_STANZA_FORMAT + MTN_P_SELECTOR)]); our @EXPORT = qw(); -our @EXPORT_OK = qw(); +Exporter::export_ok_tags(qw(constants)); our $VERSION = 0.6; # ############################################################################## @@ -192,6 +204,7 @@ sub new($;$) mtn_err => undef, poll => undef, error_msg => "", + honour_suspend_certs => 1, mtn_aif_major => 0, mtn_aif_minor => 0, cmd_cnt => 0, @@ -1498,7 +1511,7 @@ sub inventory($$) # The output format of this command was switched over to a basic_io # stanza in 0.37 (i/f version 6.x). - if ($this->{mtn_aif_major} < 6) + if (! can($this, MTN_INVENTORY_IO_STANZA_FORMAT)) { my($i, @@ -1975,6 +1988,120 @@ sub toposort($\@@) # ############################################################################## # +# Routine - can +# +# Description - Determine whether a certain feature is available with the +# version of Monotone that is currently being used. +# +# Data - $this : The object. +# $feature : A constant specifying the feature that is +# to be checked for. +# Return Value : True if the feature is supported, otherwise +# false if it is not. +# +############################################################################## + + + +sub can($$) +{ + + my($this, $feature) = @_; + + if ($feature == MTN_IGNORE_SUSPEND_CERTS) + { + + # This is only available from version 0.37 (i/f version 6.x). + + return 1 if ($this->{mtn_aif_major} >= 6); + + } + elsif ($feature == MTN_INVENTORY_IO_STANZA_FORMAT) + { + + # This is only available from version 0.37 (i/f version 6.x). + + return 1 if ($this->{mtn_aif_major} >= 6); + + } + elsif ($feature == MTN_P_SELECTOR) + { + + # This is only available from version 0.37 (i/f version 6.x). + + return 1 if ($this->{mtn_aif_major} >= 6); + + } + else + { + + # An unknown feature was requested. + + $this->{error_msg} = "Unknown feature requested"; + &$carper($this->{error_msg}); + + } + + return; + +} +# +############################################################################## +# +# Routine - ignore_suspend_certs +# +# Description - Determine whether revisions with the suspend cert are to be +# ignored or not. If the head revisions on a branch are all +# suspended then that branch is also ignored. +# +# Data - $this : The object. +# $ignore : True if suspend certs are to be ignored +# (i.e. all revisions are `visible'), +# otherwise false if suspend certs are to be +# honoured. +# Return Value : True on success, otherwise false on +# failure. +# +############################################################################## + + + +sub ignore_suspend_certs($$) +{ + + my($this, $ignore) = @_; + + # This only works from version 0.37 (i/f version 6.x). + + if ($this->{honour_suspend_certs} && $ignore) + { + if (can($this, MTN_IGNORE_SUSPEND_CERTS)) + { + $this->{honour_suspend_certs} = 0; + closedown($this); + startup($this); + } + else + { + $this->{error_msg} = "Ignoring suspend certs is unsupported in " + . "this version of Monotone"; + &$carper($this->{error_msg}); + return; + } + } + elsif (! ($this->{honour_suspend_certs} || $ignore)) + { + $this->{honour_suspend_certs} = 1; + closedown($this); + startup($this); + } + + return 1; + +} +# +############################################################################## +# # Routine - register_error_handler # # Description - Register the specified routine as an error handler for @@ -2173,12 +2300,8 @@ sub register_io_wait_handler(;$$$$) { my $msg = "I/O wait handler timeout invalid or out of range, resetting"; - if (defined($this)) - { - $this->{error_msg} = $msg; - &$carper($this->{error_msg}); - } - carp($msg); + $this->{error_msg} = $msg if (defined($this)); + &$carper($msg); $timeout = 1; } } @@ -2657,7 +2780,7 @@ sub mtn_read_output($\$) # there is an error. for ($header = "", $colons = $i = 0; - $colons < 4 && read($this->{mtn_out}, $header, 1, $i); + $colons < 4 && sysread($this->{mtn_out}, $header, 1, $i); ++ $i) { $char = substr($header, $i, 1); @@ -2709,12 +2832,12 @@ sub mtn_read_output($\$) if ($size > 0) { - if (! defined($bytes_read = read($this->{mtn_out}, - $$buffer, - $size, - $offset))) + if (! defined($bytes_read = sysread($this->{mtn_out}, + $$buffer, + $size, + $offset))) { - croak("read failed: $!"); + croak("sysread failed: $!"); } $size -= $bytes_read; $offset += $bytes_read; @@ -2759,7 +2882,8 @@ sub startup($) my $this = $_[0]; - my $version; + my(@args, + $version); # Switch to the default locale. We only want to parse the output from # Monotone in one language! @@ -2770,28 +2894,19 @@ sub startup($) if ($this->{mtn_pid} == 0) { $this->{mtn_err} = gensym(); - if ($this->{db_name}) - { - $this->{mtn_pid} = open3($this->{mtn_in}, - $this->{mtn_out}, - $this->{mtn_err}, - "mtn", - "--db=" . $this->{db_name}, - "automate", - "stdio"); - } - else - { - $this->{mtn_pid} = open3($this->{mtn_in}, - $this->{mtn_out}, - $this->{mtn_err}, - "mtn", - "automate", - "stdio"); - } + @args = ("mtn"); + push(@args, "--db=" . $this->{db_name}) if ($this->{db_name}); + push(@args, "--ignore-suspend-certs") + if (! $this->{honour_suspend_certs}); + push(@args, "automate", "stdio"); + $this->{mtn_pid} = open3($this->{mtn_in}, + $this->{mtn_out}, + $this->{mtn_err}, + @args); $this->{cmd_cnt} = 0; $this->{poll} = IO::Poll->new(); - $this->{poll}->mask($this->{mtn_out}, POLLIN); + $this->{poll}->mask($this->{mtn_out} => POLLIN, + $this->{mtn_out} => POLLPRI); interface_version($this, $version); ($this->{mtn_aif_major}, $this->{mtn_aif_minor}) = ($version =~ m/^(\d+)\.(\d+)$/); ============================================================ --- Monotone/AutomateStdio.pod 1ce23141cedc55c1450df1341cebd1bb21a59ecf +++ Monotone/AutomateStdio.pod d54fc235262827b1cf8a06dc569ca97cfae02458 @@ -10,10 +10,13 @@ 0.6 =head1 SYNOPSIS - use Monotone::AutomateStdio; - my $mtn = Monotone::AutomateStdio->new("/home/fred/venge.mtn"); - my @manifest; - $mtn->get_manifest_of(address@hidden) + use Monotone::AutomateStdio qw(:constants); + my(@manifest, + $mtn, + @revs); + $mtn = Monotone::AutomateStdio->new("/home/fred/venge.mtn"); + $mtn->select(address@hidden, "h:net.venge.monotone"); + $mtn->get_manifest_of(address@hidden, $revs[0]) or die("mtn: " . $mtn->get_error_message()); =head1 DESCRIPTION @@ -172,11 +175,11 @@ automate commands. See http://monotone.ca/monotone.html for a complete description of the mtn automate commands. -Methods that return data do so via the first argument, which is a reference to -a buffer or list that is to hold the data. Methods that return lists of -structured records also provide the option of returning the data as one raw -string if the reference points to a scalar variable rather than a list or -array. Therefore: +Methods that return data do so via their first argument. This argument is a +reference to either a scalar or a list depending upon whether the data returned +by the method is raw data or a list of items respectively. Methods that return +lists of records also provide the option of returning the data as one raw chunk +if the reference points to a scalar rather than a list. Therefore: $mtn->get_manifest_of(\$buffer); @@ -185,11 +188,20 @@ variable named $buffer, whereas: $mtn->get_manifest_of(address@hidden); -would return the output as a list of structured records (actually anonymous -hashes to be precise). +would return the output as a list of records (actually anonymous hashes to be +precise). However: -The remaining arguments are dependent on the mtn command being used. + $mtn->get_file(\$buffer, $file_id); +will always need a reference to a scalar and: + + $mtn->select(address@hidden, $selector); + +will always need a reference to a list (each item is just a string containing a +revision id rather than a record). + +The remaining arguments depend upon the mtn command being used. + The following methods are provided: =over 4 @@ -208,13 +220,31 @@ Get a list of branches. Get a list of branches. +=item B<$mtn-Ecan($feature)> + +Determine whether a certain feature is available with the version of Monotone +that is currently being used by this object. The list of valid features are: + + MTN_IGNORE_SUSPEND_CERTS + MTN_INVENTORY_IO_STANZA_FORMAT + MTN_P_SELECTOR + +In order to get these constants into your namespace you need to use the +following to load in this library. + + use Monotone::AutomateStdio qw(:constants); + +Please note that if you see (feature: ...) then this means that whatever is +being discussed is only available if $mtn-Ecan() returns true for the +specified feature. + =item B<$mtn-Ecert($revision_id, $name, $value)> -Add the specified cert to the specified revision. +Add the specified certificate to the specified revision. =item B<$mtn-Ecerts(\$buffer | address@hidden, $revision_id)> -Get all the certs for the specified revision. If \$buffer is passed then +Get all the certificates for the 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 anonymous hashes, each one containing the following fields: @@ -409,6 +439,14 @@ Get the file id, i.e. hash, of the speci Get the file id, i.e. hash, of the specified file. +=item B<$mtn-Eignore_suspend_certs($ignore)> + +Determine whether revisions with a suspend certificate are to be ignored or +not. If $ignore is true then suspend certificates are ignored, otherwise they +are honoured (in which case any suspended revisions and branches that only have +suspended revisions on their heads will not be listed). The default behaviour +is to honour suspend certificates. (feature: MTN_IGNORE_SUSPEND_CERTS) + =item B<$mtn-Einterface_version(\$buffer)> Get the version of the mtn automate interface. @@ -427,7 +465,8 @@ containing the following fields: crossref_two - The second cross-referencing number. name - The name of the file or directory. - From version 0.37 of Monotone onwards: + From version 0.37 of Monotone onwards + (feature: MTN_INVENTORY_IO_STANZA_FORMAT): path - The name of the file or directory. old_type - The type of the entry in the base manifest. Values can be one of "directory", "file" or "none".