# # add_dir "" # # add_dir "Monotone" # # add_file "LICENSE" # content [e7d563f52bf5295e6dba1d67ac23e9f6a160fab9] # # add_file "Monotone/AutomateStdio.pm" # content [6156752198819a4ea21d7c830b0c5880584cd8ff] # # add_file "Monotone/AutomateStdio.pod" # content [a62e02b4a6dc8c2aa8f196d8c6dae7fe74c2bed7] # # add_file "README" # content [b2ce5b2c66b387d269d1d0805f98ec69d5d4b3a2] # # add_file "TODO" # content [b384fec2b4f165da1aa814a1c0f8cc3c64b0d9f0] # # add_file "mtn-tester" # content [29673726502ab0bc18945eb21e154b421ea0aa5f] --- LICENSE +++ LICENSE @@ -0,0 +1,165 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + + This version of the GNU Lesser General Public License incorporates +the terms and conditions of version 3 of the GNU General Public +License, supplemented by the additional permissions listed below. + + 0. Additional Definitions. + + As used herein, "this License" refers to version 3 of the GNU Lesser +General Public License, and the "GNU GPL" refers to version 3 of the GNU +General Public License. + + "The Library" refers to a covered work governed by this License, +other than an Application or a Combined Work as defined below. + + An "Application" is any work that makes use of an interface provided +by the Library, but which is not otherwise based on the Library. +Defining a subclass of a class defined by the Library is deemed a mode +of using an interface provided by the Library. + + A "Combined Work" is a work produced by combining or linking an +Application with the Library. The particular version of the Library +with which the Combined Work was made is also called the "Linked +Version". + + The "Minimal Corresponding Source" for a Combined Work means the +Corresponding Source for the Combined Work, excluding any source code +for portions of the Combined Work that, considered in isolation, are +based on the Application, and not on the Linked Version. + + The "Corresponding Application Code" for a Combined Work means the +object code and/or source code for the Application, including any data +and utility programs needed for reproducing the Combined Work from the +Application, but excluding the System Libraries of the Combined Work. + + 1. Exception to Section 3 of the GNU GPL. + + You may convey a covered work under sections 3 and 4 of this License +without being bound by section 3 of the GNU GPL. + + 2. Conveying Modified Versions. + + If you modify a copy of the Library, and, in your modifications, a +facility refers to a function or data to be supplied by an Application +that uses the facility (other than as an argument passed when the +facility is invoked), then you may convey a copy of the modified +version: + + a) under this License, provided that you make a good faith effort to + ensure that, in the event an Application does not supply the + function or data, the facility still operates, and performs + whatever part of its purpose remains meaningful, or + + b) under the GNU GPL, with none of the additional permissions of + this License applicable to that copy. + + 3. Object Code Incorporating Material from Library Header Files. + + The object code form of an Application may incorporate material from +a header file that is part of the Library. You may convey such object +code under terms of your choice, provided that, if the incorporated +material is not limited to numerical parameters, data structure +layouts and accessors, or small macros, inline functions and templates +(ten or fewer lines in length), you do both of the following: + + a) Give prominent notice with each copy of the object code that the + Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the object code with a copy of the GNU GPL and this license + document. + + 4. Combined Works. + + You may convey a Combined Work under terms of your choice that, +taken together, effectively do not restrict modification of the +portions of the Library contained in the Combined Work and reverse +engineering for debugging such modifications, if you also do each of +the following: + + a) Give prominent notice with each copy of the Combined Work that + the Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the Combined Work with a copy of the GNU GPL and this license + document. + + c) For a Combined Work that displays copyright notices during + execution, include the copyright notice for the Library among + these notices, as well as a reference directing the user to the + copies of the GNU GPL and this license document. + + d) Do one of the following: + + 0) Convey the Minimal Corresponding Source under the terms of this + License, and the Corresponding Application Code in a form + suitable for, and under terms that permit, the user to + recombine or relink the Application with a modified version of + the Linked Version to produce a modified Combined Work, in the + manner specified by section 6 of the GNU GPL for conveying + Corresponding Source. + + 1) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (a) uses at run time + a copy of the Library already present on the user's computer + system, and (b) will operate properly with a modified version + of the Library that is interface-compatible with the Linked + Version. + + e) Provide Installation Information, but only if you would otherwise + be required to provide such information under section 6 of the + GNU GPL, and only to the extent that such information is + necessary to install and execute a modified version of the + Combined Work produced by recombining or relinking the + Application with a modified version of the Linked Version. (If + you use option 4d0, the Installation Information must accompany + the Minimal Corresponding Source and Corresponding Application + Code. If you use option 4d1, you must provide the Installation + Information in the manner specified by section 6 of the GNU GPL + for conveying Corresponding Source.) + + 5. Combined Libraries. + + You may place library facilities that are a work based on the +Library side by side in a single library together with other library +facilities that are not Applications and are not covered by this +License, and convey such a combined library under terms of your +choice, if you do both of the following: + + a) Accompany the combined library with a copy of the same work based + on the Library, uncombined with any other library facilities, + conveyed under the terms of this License. + + b) Give prominent notice with the combined library that part of it + is a work based on the Library, and explaining where to find the + accompanying uncombined form of the same work. + + 6. Revised Versions of the GNU Lesser General Public License. + + The Free Software Foundation may publish revised and/or new versions +of the GNU Lesser General Public License from time to time. Such new +versions will be similar in spirit to the present version, but may +differ in detail to address new problems or concerns. + + Each version is given a distinguishing version number. If the +Library as you received it specifies that a certain numbered version +of the GNU Lesser General Public License "or any later version" +applies to it, you have the option of following the terms and +conditions either of that published version or of any later version +published by the Free Software Foundation. If the Library as you +received it does not specify a version number of the GNU Lesser +General Public License, you may choose any version of the GNU Lesser +General Public License ever published by the Free Software Foundation. + + If the Library as you received it specifies that a proxy can decide +whether future versions of the GNU Lesser General Public License shall +apply, that proxy's public statement of acceptance of any version is +permanent authorization for you to choose that version for the +Library. --- Monotone/AutomateStdio.pm +++ Monotone/AutomateStdio.pm @@ -0,0 +1,2147 @@ +#!/usr/bin/perl -w +############################################################################## +# +# File Name - Monontone.pm +# +# Description - Perl class module that provides an interface to Monotone's +# automate stdio interface. +# +# Author - A.E.Cooper. +# +# Legal Stuff - Copyright (c) 2007 Anthony Edward Cooper +# . +# +# This library is free software; you can redistribute it +# and/or modify it under the terms of the GNU Lesser General +# Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your +# option) any later version. +# +# 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 +# more details. +# +# You should have received a copy of the GNU Library 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. +# +############################################################################## +# +############################################################################## +# +# GLOBAL DATA FOR THIS MODULE +# +############################################################################## + + + +# ***** PACKAGE DECLARATION ***** + +package Monotone::AutomateStdio; + +# ***** REQUIRED PACKAGES ***** + +use strict; +use integer; +use Carp; +use IPC::Open3; +use Symbol qw(gensym); + +# ***** GLOBAL DATA DECLARATIONS ***** + +# A pre-compiled rather evil 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. This re is +# not ideal as it would be fooled by something like 22 backslashs followed by +# an unescaped double quote, but at this point I have given up caring. What I +# want to do is something like \{*%2}. + +my $closing_quote_re = qr/(((^.*[^\\])|^)\"$) + |(((^.*[^\\])|^)\\{2}\"$) + |(((^.*[^\\])|^)\\{4}\"$) + |(((^.*[^\\])|^)\\{6}\"$) + |(((^.*[^\\])|^)\\{8}\"$) + |(((^.*[^\\])|^)\\{10}\"$) + |(((^.*[^\\])|^)\\{12}\"$) + |(((^.*[^\\])|^)\\{14}\"$) + |(((^.*[^\\])|^)\\{16}\"$) + |(((^.*[^\\])|^)\\{18}\"$) + |(((^.*[^\\])|^)\\{20}\"$)/ox; + +# ***** CLASS DEFINITIONS ***** + +# Class inheritance and declaration. + +use base qw(Exporter); + +our(@EXPORT, @EXPORT_OK, $VERSION); +BEGIN +{ + @EXPORT = qw(); + @EXPORT_OK = qw(); + $VERSION = 0.1; +} + +# Class attributes: +# db_name - The name of the Monotone database if specified. +# mtn_pid - The process id of the subordinate mtn process. +# mtn_in - The input into the mtn subprocess. +# mtn_out - The output from the mtn subprocess. +# mtn_err - The error output from the mtn subprocess. +# mtn_err_msg - The last error message returned from the mtn subprocess. +# mtn_aif_major - The major version number for the mtn automate interface. +# mtn_aif_minor - The minor version number for the mtn automate interface. +# cmd_cnt - The number of the current command. + +use fields qw(db_name + mtn_pid + mtn_in + mtn_out + mtn_err + mtn_err_msg + mtn_aif_major + mtn_aif_minor + cmd_cnt); + +# ***** FUNCTIONAL PROTOTYPES FOR THIS FILE ***** + +# Public methods. + +sub ancestors($\@@); +sub ancestry_difference(address@hidden;@); +sub attributes($\$$); +sub branches($\@); +sub cert($$$$); +sub certs($$$); +sub children(address@hidden); +sub closedown($); +sub common_ancestors($\@@); +sub content_diff($\$$$;@); +sub db_get($\$$$); +sub db_set($$$$); +sub descendents($\@@); +sub erase_ancestors($\@@); +sub error_message($); +sub get_base_revision_id($\$); +sub get_content_changed(address@hidden); +sub get_corresponding_path($\$$$$); +sub get_current_revision_id($\$); +sub get_file($\$$); +sub get_file_of($\$$;$); +sub get_manifest_of($$;$); +sub get_option($\$$); +sub get_revision($\$$); +sub graph($$); +sub heads(address@hidden); +sub identify($\$$); +sub interface_version($\$); +sub inventory($$); +sub keys($$); +sub leaves($\@); +sub parents(address@hidden); +sub roots($\@); +sub select(address@hidden); +sub tags($$;$); +sub toposort($\@@); +sub new($;$); + +# Private routines. + +sub get_quoted_value(address@hidden); +sub mtn_command($$$@); +sub mtn_command_with_options($$$\@@); +sub mtn_read_output($\$); +sub startup($); +sub unescape($); +# +############################################################################## +# +# Routine - new +# +# Description - Class constructor. +# +# Data - $invocant : Either a reference to an object of the same +# class or the name of the class to be created. +# $db_name : The full path of the Monotone database. If not +# provided then the database associated with the +# current workspace is used. +# +############################################################################## + + + +sub new($;$) +{ + + my ($invocant, $db_name) = @_; + + my Monotone::AutomateStdio $this; + my %entries; + + if (ref($invocant)) + { + $this = fields::new(ref($invocant)); + } + else + { + $this = fields::new($invocant); + } + + $this->{db_name} = $db_name; + $this->{mtn_pid} = 0; + $this->{cmd_cnt} = 0; + $this->{mtn_err_msg} = ""; + + bless($this); + + return $this; + +} +# +############################################################################## +# +# Routine - DESTROY +# +# Description - Class destructor. +# +# Data - None. +# +############################################################################## + + + +sub DESTROY +{ + + my Monotone::AutomateStdio $this = shift(); + + closedown($this); + +} +# +############################################################################## +# +# Routine - ancestors +# +# Description - Get a list of ancestors for the specified revisions. +# +# Data - $this : The object. +# address@hidden : A reference to a list that is to contain +# the revision ids. +# @revision_ids : The revision ids that are to have their +# ancestors returned. +# Return Value : True on success, otherwise false on +# failure. +# +############################################################################## + + + +sub ancestors($\@@) +{ + + my Monotone::AutomateStdio $this = shift(); + my($list, @revision_ids) = @_; + + return mtn_command($this, "ancestors", $list, @revision_ids); + +} +# +############################################################################## +# +# Routine - ancestry_difference +# +# Description - Get a list of ancestors for the specified revision, that +# are not also ancestors for the specified old revisions. +# +# Data - $this : The object. +# address@hidden : A reference to a list that is to +# contain the revision ids. +# $new_revision_id : The revision id that is to have its +# ancestors returned. +# @old_revision_ids : The revision ids that are to have their +# ancestors excluded from the above list. +# Return Value : True on success, otherwise false on +# failure. +# +############################################################################## + + + +sub ancestry_difference(address@hidden;@) +{ + + my Monotone::AutomateStdio $this = shift(); + my($list, $new_revision_id, @old_revision_ids) = @_; + + return mtn_command($this, + "ancestry_difference", + $list, + $new_revision_id, + @old_revision_ids); + +} +# +############################################################################## +# +# Routine - attributes +# +# Description - Get the attributes of the specified file. +# +# Data - $this : The object. +# \$buffer : A reference to a buffer that is to contain +# the output from this command. +# $file_name : The name of the file that is to be reported +# on. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub attributes($\$$) +{ + + my Monotone::AutomateStdio $this = shift(); + my($buffer, $file_name) = @_; + + return mtn_command($this, "attributes", $buffer, $file_name); + +} +# +############################################################################## +# +# Routine - branches +# +# Description - Get a list of branches. +# +# Data - $this : The object. +# address@hidden : A reference to a list that is to contain the +# branch names. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub branches($\@) +{ + + my Monotone::AutomateStdio $this = $_[0]; + my $list = $_[1]; + + return mtn_command($this, "branches", $list); + +} +# +############################################################################## +# +# Routine - cert +# +# Description - Add the specified cert to the specified revision. +# +# Data - $this : The object. +# $revision_id : The revision id to which the cert is to be +# applied. +# $name : The name of the cert to be applied. +# $value : The value of the cert. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub cert($$$$) +{ + + my Monotone::AutomateStdio $this = shift(); + my($revision_id, $name, $value) = @_; + + my @dummy; + + return mtn_command($this, "cert", @dummy, $revision_id, $name, $value); + +} +# +############################################################################## +# +# Routine - certs +# +# Description - Get all the certs for the specified revision. +# +# Data - $this : The object. +# $ref : A reference to a buffer or an array that is +# to contain the output from this command. +# $revision_id : The id of the revision that is to have its +# certs returned. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub certs($$$) +{ + + my Monotone::AutomateStdio $this = shift(); + my($ref, $revision_id) = @_; + + # Run the command and get the data, either as one lump or as a structured + # list. + + if (ref($ref) eq "SCALAR") + { + return mtn_command($this, "certs", $ref, $revision_id); + } + else + { + + my($i, + $j, + $key, + @lines, + $name, + $signature, + $trust, + $value); + + if (! mtn_command($this, "certs", address@hidden, $revision_id)) + { + return; + } + + # Reformat the data into a structured array. + + for ($i = $j = 0, @$ref = (); $i <= $#lines; ++ $i) + { + if ($lines[$i] =~ m/^ *key \"/o) + { + ($key) = ($lines[$i ++] =~ m/^ *key \"([^\"]+)\"$/o); + if ($lines[$i] =~ m/^ *signature \"/o) + { + ($signature) = + ($lines[$i ++] =~ m/^ *signature \"([^\"]+)\"$/o); + } + else + { + croak("Corrupt certs list, expected signature field but " + . "didn't find it"); + } + if ($lines[$i] =~ m/^ *name \"/o) + { + ($name) = ($lines[$i ++] =~ m/^ *name \"([^\"]+)\"$/o); + } + else + { + croak("Corrupt certs list, expected name field but didn't " + . "find it"); + } + if ($lines[$i] =~ m/^ *value \"/o) + { + get_quoted_value(@lines, $i, $value); + ++ $i; + } + else + { + croak("Corrupt certs list, expected value field but " + . "didn't find it"); + } + if ($lines[$i] =~ m/^ *trust \"/o) + { + ($trust) = ($lines[$i] =~ m/^ *trust \"([^\"]+)\"$/o); + } + else + { + croak("Corrupt certs list, expected trust field but " + . "didn't find it"); + } + $$ref[$j ++] = {key => unescape($key), + signature => unescape($signature), + name => unescape($name), + value => unescape($value), + trust => unescape($trust)}; + } + } + + } + + return 1; + +} +# +############################################################################## +# +# Routine - children +# +# Description - Get a list of children for the specified revision. +# +# Data - $this : The object. +# address@hidden : A reference to a list that is to contain the +# revision ids. +# $revision_id : The revision id that is to have its children +# returned. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub children(address@hidden) +{ + + my Monotone::AutomateStdio $this = shift(); + my($list, @revision_ids) = @_; + + return mtn_command($this, "children", $list, @revision_ids); + +} +# +############################################################################## +# +# Routine - common_ancestors +# +# Description - Get a list of revisions that are all ancestors of the +# specified revision. +# +# Data - $this : The object. +# address@hidden : A reference to a list that is to contain +# the revision ids. +# @revision_ids : The revision ids that are to have their +# common ancestors returned. +# Return Value : True on success, otherwise false on +# failure. +# +############################################################################## + + + +sub common_ancestors($\@@) +{ + + my Monotone::AutomateStdio $this = shift(); + my($list, @revision_ids) = @_; + + return mtn_command($this, "common_ancestors", $list, @revision_ids); + +} +# +############################################################################## +# +# Routine - content_diff +# +# Description - Get the difference between the two specified revisions, +# optionally limiting it to the specified list of files. If +# the second revision id is undefined then the workspace's +# revision is used. If both revision ids are undefined then +# the workspace's and base revisions are used. If no file +# names are listed then differences in all files are +# reported. +# +# Data - $this : The object. +# \$buffer : A reference to a buffer that is to contain +# the output from this command. +# $revision_id1 : The first revision id to compare against. +# $revision_id2 : The second revision id to compare against. +# @file_names : The list of file names that are to be +# reported on. +# Return Value : True on success, otherwise false on +# failure. +# +############################################################################## + + + +sub content_diff($\$$$;@) +{ + + my Monotone::AutomateStdio $this = shift(); + my($buffer, $revision_id1, $revision_id2, @file_names) = @_; + + my @options; + + push(@options, {key => "r", value => $revision_id1}) + unless (! defined($revision_id1)); + push(@options, {key => "r", value => $revision_id2}) + unless (! defined($revision_id2)); + + return mtn_command_with_options($this, + "content_diff", + $buffer, + @options, + @file_names); + +} +# +############################################################################## +# +# Routine - db_get +# +# Description - Get the value of a database variable. +# +# Data - $this : The object. +# \$buffer : A reference to a buffer that is to contain +# the output from this command. +# $domain : The domain of the database variable. +# $name : The name of the variable to fetch. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub db_get($\$$$) +{ + + my Monotone::AutomateStdio $this = shift(); + my($buffer, $domain, $name) = @_; + + return mtn_command($this, "db_get", $buffer, $domain, $name); + +} +# +############################################################################## +# +# Routine - db_set +# +# Description - Set the value of a database variable. +# +# Data - $this : The object. +# $domain : The domain of the database variable. +# $name : The name of the variable to set. +# $value : The value to set the variable to. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub db_set($$$$) +{ + + my Monotone::AutomateStdio $this = shift(); + my($domain, $name, $value) = @_; + + my $dummy; + + return mtn_command($this, "db_set", \$dummy, $domain, $name, $value); + +} +# +############################################################################## +# +# Routine - descendents +# +# Description - Get a list of descendents for the specified revisions. +# +# Data - $this : The object. +# address@hidden : A reference to a list that is to contain +# the revision ids. +# @revision_ids : The revision ids that are to have their +# descendents returned. +# Return Value : True on success, otherwise false on +# failure. +# +############################################################################## + + + +sub descendents($\@@) +{ + + my Monotone::AutomateStdio $this = shift(); + my($list, @revision_ids) = @_; + + return mtn_command($this, "descendents", $list, @revision_ids); + +} +# +############################################################################## +# +# Routine - erase_ancestors +# +# Description - For a given list of revisions, weed out those that are +# ancestors to other revisions specified within the list. +# +# Data - $this : The object. +# address@hidden : A reference to a list that is to contain +# the revision ids. +# @revision_ids : The revision ids that are to have their +# descendents returned. +# Return Value : True on success, otherwise false on +# failure. +# +############################################################################## + + + +sub erase_ancestors($\@@) +{ + + my Monotone::AutomateStdio $this = shift(); + my($list, @revision_ids) = @_; + + return mtn_command($this, "erase_ancestors", $list, @revision_ids); + +} +# +############################################################################## +# +# Routine - get_base_revision_id +# +# Description - Get the revision upon which the workspace is based. +# +# Data - $this : The object. +# \$buffer : A reference to a buffer that is to contain +# the output from this command. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub get_base_revision_id($\$) +{ + + my Monotone::AutomateStdio $this = $_[0]; + my $buffer = $_[1]; + + my @list; + + $$buffer = ""; + if (! mtn_command($this, "get_base_revision_id", address@hidden)) + { + return; + } + $$buffer = $list[0]; + + return 1; + +} +# +############################################################################## +# +# Routine - get_content_changed +# +# Description - Get a list of revisions in which the content was most +# recently changed, relative to the specified revision. +# +# Data - $this : The object. +# address@hidden : A reference to a list that is to contain the +# revision ids. +# $revision_id : The id of the revision of the manifest that +# is to be returned. +# $file_name : The name of the file that is to be reported +# on. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub get_content_changed(address@hidden) +{ + + my Monotone::AutomateStdio $this = shift(); + my($list, $revision_id, $file_name) = @_; + + my($i, + $j, + @lines); + + # Run the command and get the data. + + if (! mtn_command($this, "get_content_changed", + address@hidden, + $revision_id, + $file_name)) + { + return; + } + + # Reformat the data into a list. + + for ($i = $j = 0, @$list = (); $i <= $#lines; ++ $i) + { + if ($lines[$i] =~ m/^ *content_mark \[[^\]]+\]$/o) + { + ($$list[$j ++]) = + ($lines[$i] =~ m/^ *content_mark \[([^\]]+)\]$/o); + } + } + + return 1; + +} +# +############################################################################## +# +# Routine - get_corresponding_path +# +# Description - For the specified file name in the specified source +# revision, return the corresponding file name for the +# specified target revision. +# +# Data - $this : The object. +# \$buffer : A reference to a buffer that is to +# contain the output from this command. +# $source_revision_id : The source revision id. +# $file_name : The name of the file that is to be +# searched for. +# $target_revision_id : The target revision id. +# Return Value : True on success, otherwise false on +# failure. +# +############################################################################## + + + +sub get_corresponding_path($\$$$$) +{ + + my Monotone::AutomateStdio $this = shift(); + my($buffer, $source_revision_id, $file_name, $target_revision_id) = @_; + + my($i, + @lines); + + # Run the command and get the data. + + if (! mtn_command($this, "get_corresponding_path", + address@hidden, + $source_revision_id, + $file_name, + $target_revision_id)) + { + return; + } + + # Extract the file name. + + for ($i = 0, $$buffer = ""; $i <= $#lines; ++ $i) + { + if ($lines[$i] =~ m/^ *file \"/o) + { + get_quoted_value(@lines, $i, $$buffer); + $$buffer = unescape($$buffer); + } + } + + return 1; + +} +# +############################################################################## +# +# Routine - get_current_revision_id +# +# Description - Get the revision that would be created if an unrestricted +# commit was done in the workspace. +# +# Data - $this : The object. +# \$buffer : A reference to a buffer that is to contain +# the output from this command. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub get_current_revision_id($\$) +{ + + my Monotone::AutomateStdio $this = $_[0]; + my $buffer = $_[1]; + + my @list; + + $$buffer = ""; + if (! mtn_command($this, "get_current_revision_id", address@hidden)) + { + return; + } + $$buffer = $list[0]; + + return 1; + +} +# +############################################################################## +# +# Routine - get_file +# +# Description - Get the contents of the file referenced by the specified +# file id. +# +# Data - $this : The object. +# \$buffer : A reference to a buffer that is to contain +# the output from this command. +# $file_id : The file id of the file that is to be +# returned. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub get_file($\$$) +{ + + my Monotone::AutomateStdio $this = shift(); + my($buffer, $file_id) = @_; + + return mtn_command($this, "get_file", $buffer, $file_id); + +} +# +############################################################################## +# +# Routine - get_file_of +# +# Description - Get the contents of the specified file under the specified +# revision. If the revision id is undefined then the current +# workspace revision is used. +# +# Data - $this : The object. +# \$buffer : A reference to a buffer that is to contain +# the output from this command. +# $file_name : The name of the file to be fetched. +# $revision_id : The revision id upon which the file contents +# are to be based. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub get_file_of($\$$;$) +{ + + my Monotone::AutomateStdio $this = shift(); + my($buffer, $file_name, $revision_id) = @_; + + my @options; + + push(@options, {key => "r", value => $revision_id}) + unless (! defined($revision_id)); + + return mtn_command_with_options($this, + "get_file_of", + $buffer, + @options, + $file_name); + +} +# +############################################################################## +# +# Routine - get_manifest_of +# +# Description - Get the manifest for the current or specified revision. +# +# Data - $this : The object. +# $ref : A reference to a buffer or an array that is +# to contain the output from this command. +# $revision_id : The revision id which is to have its +# manifest returned. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub get_manifest_of($$;$) +{ + + my Monotone::AutomateStdio $this = shift(); + my($ref, $revision_id) = @_; + + # Run the command and get the data, either as one lump or as a structured + # list. + + if (ref($ref) eq "SCALAR") + { + return mtn_command($this, "get_manifest_of", $ref, $revision_id); + } + else + { + + my($i, + $id, + $j, + @lines, + $name, + $type); + + if (! mtn_command($this, "get_manifest_of", address@hidden, $revision_id)) + { + return; + } + + # Reformat the data into a structured array. + + for ($i = $j = 0, @$ref = (); $i <= $#lines; ++ $i) + { + $type = undef; + if ($lines[$i] =~ m/^ *file \"/o) + { + $type = "f"; + get_quoted_value(@lines, $i, $name); + ++ $i; + if ($lines[$i] =~ m/^ *content \[[^\]]+\]$/o) + { + ($id) = ($lines[$i] =~ m/^ *content \[([^\]]+)\]$/o); + } + else + { + croak("Corrupt manifest, expected content field but " + . "didn't find it"); + } + } + if ($lines[$i] =~ m/^ *dir \"/o) + { + $type = "d"; + get_quoted_value(@lines, $i, $name); + } + if ($type) + { + if ($type eq "f") + { + $$ref[$j ++] = {type => $type, + name => unescape($name), + file_id => $id}; + } + else + { + $$ref[$j ++] = {type => $type, + name => unescape($name)}; + } + } + } + + } + + return 1; + +} +# +############################################################################## +# +# Routine - get_option +# +# Description - Get the value of an option stored in a workspace's _MTN +# directory. +# +# Data - $this : The object. +# \$buffer : A reference to a buffer that is to contain +# the output from this command. +# $option_name : The name of the option to be fetched. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub get_option($\$$) +{ + + my Monotone::AutomateStdio $this = shift(); + my($buffer, $option_name) = @_; + + if (! mtn_command($this, "get_option", $buffer, $option_name)) + { + return; + } + chomp($$buffer); + + return 1; + +} +# +############################################################################## +# +# Routine - get_revision +# +# Description - Get the revision information for the current or specified +# revision. +# +# Data - $this : The object. +# \$buffer : A reference to a buffer that is to contain +# the output from this command. +# $revision_id : The revision id which is to have its data +# returned. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub get_revision($\$$) +{ + + my Monotone::AutomateStdio $this = shift(); + my($buffer, $revision_id) = @_; + + return mtn_command($this, "get_revision", $buffer, $revision_id); + +} +# +############################################################################## +# +# Routine - graph +# +# Description - Get a complete ancestry graph of the database. +# +# Data - $this : The object. +# $ref : A reference to a buffer or an array that is +# to contain the output from this command. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub graph($$) +{ + + my Monotone::AutomateStdio $this = $_[0]; + my $ref = $_[1]; + + # Run the command and get the data, either as one lump or as a structured + # list. + + if (ref($ref) eq "SCALAR") + { + return mtn_command($this, "graph", $ref); + } + else + { + + my($i, + @lines, + @parent_ids, + $rev_id); + + if (! mtn_command($this, "graph", address@hidden)) + { + return; + } + for ($i = 0, @$ref = (); $i <= $#lines; ++ $i) + { + @parent_ids = split(/ /o, $lines[$i]); + $rev_id = shift(@parent_ids); + $$ref[$i] = {revision_id => $rev_id, + parent_ids => address@hidden; + } + + } + + return 1; + +} +# +############################################################################## +# +# Routine - heads +# +# Description - Get a list of revision ids that are heads on the specified +# branch. +# +# Data - $this : The object. +# address@hidden : A reference to a list that is to contain the +# revision ids. +# $branch_name : The name of the branch that is to have its +# heads returned. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub heads(address@hidden) +{ + + my Monotone::AutomateStdio $this = shift(); + my($list, $branch_name) = @_; + + return mtn_command($this, "heads", $list, $branch_name); + +} +# +############################################################################## +# +# Routine - identify +# +# Description - Get the file id, i.e. hash, of the specified file. +# +# Data - $this : The object. +# \$buffer : A reference to a buffer that is to contain +# the output from this command. +# $file_name : The name of the file that is to have its id +# returned. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub identify($\$$) +{ + + my Monotone::AutomateStdio $this = shift(); + my($buffer, $file_name) = @_; + + my @list; + + $$buffer = ""; + if (! mtn_command($this, "identify", address@hidden, $file_name)) + { + return; + } + $$buffer = $list[0]; + + return 1; + +} +# +############################################################################## +# +# Routine - interface_version +# +# Description - Get the version of the mtn automate interface. +# +# Data - $this : The object. +# \$buffer : A reference to a buffer that is to contain +# the output from this command. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub interface_version($\$) +{ + + my Monotone::AutomateStdio $this = $_[0]; + my $buffer = $_[1]; + + my @list; + + $$buffer = ""; + if (! mtn_command($this, "interface_version", address@hidden)) + { + return; + } + $$buffer = $list[0]; + + return 1; + +} +# +############################################################################## +# +# Routine - inventory +# +# Description - Get the inventory for the current workspace. +# +# Data - $this : The object. +# $ref : A reference to a buffer or an array that is +# to contain the output from this command. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub inventory($$) +{ + + my Monotone::AutomateStdio $this = $_[0]; + my $ref = $_[1]; + + # Run the command and get the data, either as one lump or as a structured + # list. + + if (ref($ref) eq "SCALAR") + { + return mtn_command($this, "inventory", $ref); + } + else + { + + my($i, + $j, + @lines, + $name, + $ref1, + $ref2, + $status); + + if (! mtn_command($this, "inventory", address@hidden)) + { + return; + } + + # Reformat the data into a structured array. + + for ($i = $j = 0, @$ref = (); $i <= $#lines; ++ $i) + { + $status = undef; + if ($lines[$i] =~ m/^[A-Z ]{3} \d+ \d+ .+$/o) + { + ($status, $ref1, $ref2, $name) = + ($lines[$i ++] =~ m/^([A-Z ]{3}) (\d+) (\d+) (.+)$/o); + $$ref[$j ++] = {status => $status, + crossref_one => $ref1, + crossref_two => $ref2, + name => $name}; + } + } + + } + + return 1; + +} +# +############################################################################## +# +# Routine - keys +# +# Description - Get a list of all the keys known to mtn. +# +# Data - $this : The object. +# $ref : A reference to a buffer or an array that is +# to contain the output from this command. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub keys($$) +{ + + my Monotone::AutomateStdio $this = shift(); + my($ref, $revision_id) = @_; + + # Run the command and get the data, either as one lump or as a structured + # list. + + if (ref($ref) eq "SCALAR") + { + return mtn_command($this, "keys", $ref); + } + else + { + + my($i, + $id, + $j, + @lines, + $priv_hash, + @priv_loc, + $pub_hash, + @pub_loc, + $name, + $type); + + if (! mtn_command($this, "keys", address@hidden)) + { + return; + } + + # Reformat the data into a structured array. + + for ($i = $j = 0, @$ref = (); $i <= $#lines;) + { + if ($lines[$i] =~ m/^ *name \"/o) + { + $priv_hash = $pub_hash = undef; + @priv_loc = @pub_loc = (); + get_quoted_value(@lines, $i, $name); + ++ $i; + if ($lines[$i] =~ m/^ *public_hash \[[^\]]+\]$/o) + { + ($pub_hash) = + ($lines[$i ++] =~ m/^ *public_hash \[([^\]]+)\]$/o); + } + else + { + croak("Corrupt keys, expected public_hash field but " + . "didn't find it"); + } + if ($lines[$i] =~ m/^ *private_hash \[[^\]]+\]$/o) + { + ($priv_hash) = + ($lines[$i ++] =~ m/^ *private_hash \[([^\]]+)\]$/o); + } + if ($lines[$i] =~ m/^ *public_location \"/o) + { + if ($lines[$i] =~ m/^ *\S+ \"[^\"]+\" \"[^\"]+\"$/o) + { + @pub_loc = ($lines[$i ++] + =~ m/^ *\S+ \"([^\"]+)\" \"([^\"]+)\"$/o); + } + else + { + @pub_loc = ($lines[$i ++] =~ m/^ *\S+ \"([^\"]+)\"$/o); + } + } + else + { + croak("Corrupt keys, expected public_location field but " + . "didn't find it"); + } + if ($i <= $#lines && $lines[$i] =~ m/^ *private_location \"/o) + { + if ($lines[$i] =~ m/^ *\S+ \"[^\"]+\" \"[^\"]+\"$/o) + { + @priv_loc = ($lines[$i ++] + =~ m/^ *\S+ \"([^\"]+)\" \"([^\"]+)\"$/o); + } + else + { + @priv_loc = + ($lines[$i ++] =~ m/^ *\S+ \"([^\"]+)\"$/o); + } + } + + if ($priv_hash) + { + $$ref[$j ++] = {name => unescape($name), + public_hash => $pub_hash, + private_hash => $priv_hash, + public_locations => address@hidden, + private_locations => address@hidden; + } + else + { + $$ref[$j ++] = {name => unescape($name), + public_hash => $pub_hash, + public_locations => address@hidden; + } + } + else + { + ++ $i; + } + } + + } + + return 1; + +} +# +############################################################################## +# +# Routine - leaves +# +# Description - Get a list of leaf revisions. +# +# Data - $this : The object. +# address@hidden : A reference to a list that is to contain the +# revision ids. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub leaves($\@) +{ + + my Monotone::AutomateStdio $this = $_[0]; + my $list = $_[1]; + + return mtn_command($this, "leaves", $list); + +} +# +############################################################################## +# +# Routine - parents +# +# Description - Get a list of parents for the specified revision. +# +# Data - $this : The object. +# address@hidden : A reference to a list that is to contain the +# revision ids. +# $revision_id : The revision id that is to have its parents +# returned. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub parents(address@hidden) +{ + + my Monotone::AutomateStdio $this = shift(); + my($list, $revision_id) = @_; + + return mtn_command($this, "parents", $list, $revision_id); + +} +# +############################################################################## +# +# Routine - roots +# +# Description - Get a list of root revisions, i.e. revisions with no +# parents. +# +# Data - $this : The object. +# address@hidden : A reference to a list that is to contain the +# revision ids. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub roots($\@) +{ + + my Monotone::AutomateStdio $this = $_[0]; + my $list = $_[1]; + + return mtn_command($this, "roots", $list); + +} +# +############################################################################## +# +# Routine - select +# +# Description - Get a list of revision ids that match the specified +# selector. +# +# Data - $this : The object. +# address@hidden : A reference to a list that is to contain the +# revision ids. +# $selector : The selector that is to be used. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub select(address@hidden) +{ + + my Monotone::AutomateStdio $this = shift(); + my($list, $selector) = @_; + + return mtn_command($this, "select", $list, $selector); + +} +# +############################################################################## +# +# Routine - tags +# +# Description - 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. +# +# Data - $this : The object. +# $ref : A reference to a buffer or an array that +# is to contain the output from this +# command. +# $branch_pattern : The branch name pattern that the search +# is to be limited to. +# Return Value : True on success, otherwise false on +# failure. +# +############################################################################## + + + +sub tags($$;$) +{ + + my Monotone::AutomateStdio $this = shift(); + my($ref, $branch_pattern) = @_; + + # Run the command and get the data, either as one lump or as a structured + # list. + + if (ref($ref) eq "SCALAR") + { + return mtn_command($this, "tags", $ref, $branch_pattern); + } + else + { + + my(@branches, + $i, + $j, + $k, + @lines, + $list, + $rev, + $signer, + $tag); + + if (! mtn_command($this, "tags", address@hidden, $branch_pattern)) + { + return; + } + + # Reformat the data into a structured array. + + for ($i = $j = 0, @$ref = (); $i <= $#lines; ++ $i) + { + if ($lines[$i] =~ m/^ *tag \"/o) + { + @branches = (); + ($tag) = ($lines[$i ++] =~ m/^ *tag \"([^\"]+)\"$/o); + if ($lines[$i] =~ m/^ *revision \[[^\]]+\]$/o) + { + ($rev) = ($lines[$i ++] =~ m/^ *revision \[([^\]]+)\]$/o); + } + else + { + croak("Corrupt tags list, expected revision field but " + . "didn't find it"); + } + if ($lines[$i] =~ m/^ *signer \"/o) + { + ($signer) = ($lines[$i ++] =~ m/^ *signer \"([^\"]+)\"$/o); + } + else + { + croak("Corrupt tags list, expected signer field but " + . "didn't find it"); + } + if ($lines[$i] =~ m/^ *branches/o) + { + if ($lines[$i] =~ m/^ *branches \".+\"$/o) + { + ($list) = ($lines[$i] =~ m/^ *branches \"(.+)\"$/o); + @branches = split(/\" \"/o, $list); + } + } + else + { + croak("Corrupt tags list, expected branches field but " + . "didn't find it"); + } + $$ref[$j ++] = {tag => unescape($tag), + revision_id => $rev, + signer => unescape($signer), + branches => address@hidden; + } + } + + } + + return 1; + +} +# +############################################################################## +# +# Routine - toposort +# +# Description - Sort the specified revisions such that the ancestors come +# out first. +# +# Data - $this : The object. +# address@hidden : A reference to a list that is to contain +# the revision ids. +# $revision_ids : The revision id that is to have its +# ancestors returned. +# Return Value : True on success, otherwise false on +# failure. +# +############################################################################## + + + +sub toposort($\@@) +{ + + my Monotone::AutomateStdio $this = shift(); + my($list, @revision_ids) = @_; + + return mtn_command($this, "toposort", $list, @revision_ids); + +} +# +############################################################################## +# +# Routine - error_message +# +# Description - Return the last error message received from the mtn +# subprocess. +# +# Data - $this : The object. +# Return Value : The last error message received, or an empty +# string if nothing has gone wrong yet. +# +############################################################################## + + + +sub error_message($) +{ + + my Monotone::AutomateStdio $this = $_[0]; + + return $this->{mtn_err_msg}; + +} +# +############################################################################## +# +# Routine - closedown +# +# Description - If started then stop the mtn subprocess. +# +# Data - $this : The object. +# +############################################################################## + + + +sub closedown($) +{ + + my Monotone::AutomateStdio $this = $_[0]; + + my($err_msg, + $i, + $ret_val); + + if ($this->{mtn_pid} != 0) + { + close($this->{mtn_in}); + close($this->{mtn_out}); + close($this->{mtn_err}); + for ($i = 0; $i < 3; ++ $i) + { + $ret_val = 0; + eval + { + local $SIG{ALRM} = sub { die("internal sigalarm"); }; + alarm(5); + $ret_val = waitpid($this->{mtn_pid}, 0); + alarm(0); + }; + if ($ret_val == $this->{mtn_pid}) + { + last; + } + elsif ($ret_val == 0) + { + if ($i == 0) + { + kill("TERM", $this->{mtn_pid}); + } + else + { + kill("KILL", $this->{mtn_pid}); + } + } + else + { + $err_msg = $!; + kill("KILL", $this->{mtn_pid}); + croak("waitpid failed: $err_msg"); + } + } + $this->{mtn_pid} = 0; + } + +} +# +############################################################################## +# +# Routine - mtn_command +# +# Description - Handle mtn commands that take no options and zero or more +# arguments. Depending upon what type of reference is passed, +# data is either returned in one large lump (scalar +# reference), or an array of lines (array reference). +# +# Data - $this : The object. +# $cmd : The mtn automate command that is to be run. +# $ref : A reference to a buffer or an array that is +# to contain the output from this command. +# @parameters : A list of parameters to be applied to the +# command. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub mtn_command($$$@) +{ + + my Monotone::AutomateStdio $this = shift(); + my($cmd, $ref, @parameters) = @_; + + my @dummy; + + return mtn_command_with_options($this, $cmd, $ref, @dummy, @parameters); + +} +# +############################################################################## +# +# Routine - mtn_command_with_options +# +# Description - Handle mtn commands that take options and zero or more +# arguments. Depending upon what type of reference is passed, +# data is either returned in one large lump (scalar +# reference), or an array of lines (array reference). +# +# Data - $this : The object. +# $cmd : The mtn automate command that is to be run. +# $ref : A reference to a buffer or an array that is +# to contain the output from this command. +# address@hidden : A reference to a list containing key/value +# anonymous hashes. +# @parameters : A list of parameters to be applied to the +# command. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub mtn_command_with_options($$$\@@) +{ + + my Monotone::AutomateStdio $this = shift(); + my($cmd, $ref, $options, @parameters) = @_; + + my($buffer, + $in, + $opt, + $param); + + if ($this->{mtn_pid} == 0) + { + startup($this); + } + + # Run the command and get the data, the unless below is required just in + # case undef is passed as the only parameter (which can happen when a + # mandatory argument is not passed by the caller). + + $in = $this->{mtn_in}; +if (0) +{ + $in = *STDOUT; +} + printf($in "o") unless ($#$options < 0); + foreach $opt (@$options) + { + printf($in "%d:%s%d:%s", + length($opt->{key}), + $opt->{key}, + length($opt->{value}), + $opt->{value}); + } + printf($in "e ") unless ($#$options < 0); + printf($in "l%d:%s", length($cmd), $cmd); + foreach $param (@parameters) + { + printf($in "%d:%s", length($param), $param) unless (! defined($param)); + } + print($in "e\n"); +if (0) +{ + if(ref($ref) eq "SCALAR") + { + $$ref = ""; + } + else + { + @$ref = (); + } + return 1; +} + + # Depending upon what we have been given a reference to, either return the + # data as one chunk or as an array of lines. + + if (ref($ref) eq "SCALAR") + { + return mtn_read_output($this, $$ref); + } + else + { + if (! mtn_read_output($this, $buffer)) + { + return; + } + @$ref = split(/\n/o, $buffer); + } + + return 1; + +} +# +############################################################################## +# +# Routine - mtn_read_output +# +# Description - Reads the output from mtn, removing chunk headers. +# +# Data - $this : The object. +# \$buffer : A reference to the buffer that is to contain +# the data. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub mtn_read_output($\$) +{ + + my Monotone::AutomateStdio $this = $_[0]; + my $buffer = $_[1]; + + my($bytes_read, + $char, + $chunk_start, + $cmd_nr, + $colons, + $err, + $err_code, + $err_occurred, + $header, + $i, + $last, + $offset, + $size); + + $err = $this->{mtn_err}; + + $$buffer = ""; + $chunk_start = 1; + $err_occurred = 0; + $last = "m"; + $offset = 0; + do + { + + # If necessary, read in and process the chunk header, then we know how + # much to read in etc. + + if ($chunk_start) + { + + # Read header, one byte at a time until we have what we need or + # there is an error. + + for ($header = "", $colons = $i = 0; + $colons < 4 && read($this->{mtn_out}, $header, 1, $i); + ++ $i) + { + $char = substr($header, $i, 1); + if ($char eq ":") + { + ++ $colons; + } + elsif ($colons == 2) + { + if ($char ne "m" && $char ne "l") + { + croak("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>)); + } + } + + # Break out the header into its separate fields. + + if ($header =~ m/^\d+:\d+:[lm]:\d+:$/o) + { + ($cmd_nr, $err_code, $last, $size) = + ($header =~ m/^(\d+):(\d+):([lm]):(\d+):$/o); + if ($cmd_nr != $this->{cmd_cnt}) + { + croak("Mtn command count is out of sequence"); + } + if ($err_code != 0) + { + $err_occurred = 1; + } + } + else + { + croak("Corrupt/missing mtn chunk header, mtn gave:\n" + . join("", <$err>)); + } + + $chunk_start = 0; + + } + + # Read in what we require. + + if ($size > 0) + { + if (! defined($bytes_read = read($this->{mtn_out}, + $$buffer, + $size, + $offset))) + { + croak("read failed: $!"); + } + $size -= $bytes_read; + $offset += $bytes_read; + } + if ($size == 0 && $last eq "m") + { + $chunk_start = 1; + } + + } + while ($size > 0 || $last eq "m"); + + ++ $this->{cmd_cnt}; + + # Deal with errors (message is in $$buffer). + + if ($err_occurred) + { + $this->{mtn_err_msg} = $$buffer; + $$buffer = ""; + return; + } + + return 1; + +} +# +############################################################################## +# +# Routine - startup +# +# Description - If necessary start up the mtn subprocess. +# +# Data - $this : The object. +# +############################################################################## + + + +sub startup($) +{ + + my Monotone::AutomateStdio $this = $_[0]; + + my $version; + + 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"); + } + $this->{cmd_cnt} = 0; + interface_version($this, $version); + ($this->{mtn_aif_major}, $this->{mtn_aif_minor}) = + ($version =~ m/^(\d+)\.(\d+)$/o); + } + +} +# +############################################################################## +# +# Routine - get_quoted_value +# +# Description - Get the contents of a quoted value that may span several +# lines and contain escaped quotes. +# +# Data - address@hidden : The reference to the list that is to contain +# the manifest. +# \$index : The id of the revision of the manifest that +# is to be fetched. +# \$buffer : A reference to a buffer that is to contain +# the contents of the quoted string. +# +############################################################################## + + + +sub get_quoted_value(address@hidden) +{ + + my($list, $index, $buffer) = @_; + + # Deal with multiple lines. + + $$buffer = substr($$list[$$index], index($$list[$$index], "\"") + 1); + if ($$list[$$index] !~ m/$closing_quote_re/) + { + do + { + $$buffer .= "\n" . $$list[++ $$index]; + } + while ($$list[$$index] !~ m/$closing_quote_re/); + } + substr($$buffer, -1, 1, ""); + +} +# +############################################################################## +# +# Routine - unescape +# +# Description - Process mtn escape characters to get back the original +# data. +# +# Data - $data : The escaped data. +# Return Value : The unescaped data. +# +############################################################################## + + + +sub unescape($) +{ + + my $data = $_[0]; + + $data =~ s/\\\\/\\/g; + $data =~ s/\\\"/\"/g; + + return $data; + +} + +1; --- Monotone/AutomateStdio.pod +++ Monotone/AutomateStdio.pod @@ -0,0 +1,351 @@ +=pod + +=head1 NAME + +Monotone::automateStdio - Perl interface to Monotone via automate stdio + +=head1 VERSION + +0.1 + +=head1 SYNOPSIS + + use Monotone::AutomateStdio; + my $mtn = Monotone::AutomateStdio->new("/home/fred/venge.mtn"); + my @manifest; + $mtn->get_manifest_of(address@hidden) + or die("mtn: " . $mtn->error_message()); + +=head1 DESCRIPTION + +The Monotone::AutomateStdio class gives the Perl developer access to Monotone's +automate stdio interface; internally dealing command, option and output +formats. For most commands that return structured information, this class also +breaks out the information into lists of records, as anonymous hashes, for ease +of access (detailed below). + +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 +called. + +All automate commands have been implemented in this class except for the +following: + + genkey + packet_for_fdata + packet_for_fdelta + packet_for_rdata + packets_for_certs + put_file + put_revision + stdio + +The `genkey' command is typically done by the user when setting up their +account and so is not likely to be of great use rest of the time, the `packet' +style commands seem to be of little use to a scripting language, the `put' +style commands just seem too scary for words and hopefully you do not have to +ask about the `stdio' command:-). + +=head1 CONSTRUCTOR + +=over 4 + +=item new() + +Creates a new Monotone::AutomateStdio object, using the current workspace's +database. + +=item new($db) + +Creates a new Monotone::AutomateStdio object, using the database named in $db. + +=back + +=head1 METHODS + +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: + + $mtn->get_manifest_of(\$buffer); + +would simply put the output from the `get_manifest_of' command into the +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). + +The remaining arguments are dependent on the mtn command being used. + +The following methods are provided: + +=over 4 + +=item $mtn->ancestors(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 ...]) + +Get a list of ancestors for the specified revision, that are not also +ancestors for the specified old revisions. + +=item $mtn->attributes(\$buffer, $file_name) + +Get the attributes of the specified file. + +=item $mtn->branches(address@hidden) + +Get a list of branches. + +=item $mtn->cert($revision_id, $name, $value) + +Add the specified cert to the specified revision. + +=item $mtn->certs(\$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 address@hidden is passed then the output is returned as a list of anonymous hashes, +each one containing the following fields: + + key - The signer of the cert. + signature - Signer status, i.e. "ok" or "unknown". + name - The cert name. + value - Its value. + trust - Its trust status. + +=item $mtn->children(address@hidden, $revision_id) + +Get a list of children for the specified revision. + +=item $mtn->closedown() + +If started then stop the mtn subprocess. + +=item $mtn->common_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 ...]) + +Get the difference between the two specified revisions, optionally limiting +it to the specified list of files. If the second revision id is undefined +then the workspace's revision is used. If both revision ids are undefined +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) + +Get the value of a database variable. + +=item $mtn->db_set($domain, $name, $value) + +Set the value of a database variable. + +=item $mtn->descendents(address@hidden, $revision_id ...) + +Get a list of descendants for the specified revision(s). + +=item $mtn->erase_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() + +Return the last error message received from the mtn subprocess. + +=item $mtn->get_base_revision_id(\$buffer) + +Get the revision upon which the workspace is based. + +=item $mtn->get_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) + +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) + +Get the revision that would be created if an unrestricted commit was done +in the workspace. + +=item $mtn->get_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]) + +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) + +Get the manifest 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 anonymous hashes, each one containing the following fields: + + type - The type of entry, either "d" or "f" for directory and + file respectively. + name - The name of the directory or file. + file_id - The Monotone id for the file's contents. This field is + only present if type is set to "f". + +=item $mtn->get_option(\$buffer, $option_name) + +Get the value of an option stored in a workspace's _MTN directory. + +=item $mtn->get_revision(\$buffer, $revision_id) + +Get the revision information for the current or specified revision. + +=item $mtn->graph(\$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 +is passed then the output is returned as a list of anonymous hashes, each one +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) + +Get a list of revision ids that are heads on the specified branch. + +=item $mtn->identify(\$buffer, $file_name) + +Get the file id, i.e. hash, of the specified file. + +=item $mtn->interface_version(\$buffer) + +Get the version of the mtn automate interface. + +=item $mtn->inventory(\$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 +is passed then the output is returned as a list of anonymous hashes, each one +containing the following fields: + + status - The three inventory status characters for the file + or directory. + crossref_one - The first cross-referencing number. + crossref_two - The second cross-referencing number. + name - The name of the file or directory. + +=item $mtn->keys(\$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 +passed then the output is returned as a list of anonymous hashes, each one +containing the following fields: + + name - The name of the key. + public_hash - The public hash code. + private_hash - The private has code. + public_locations - A list of locations for the public hash code. + Values can be one of "database" or + "keystore". + private_locations - A list of locations for the private hash + code. Values can be one of "database" or + "keystore". + +=item $mtn->leaves(address@hidden) + +Get a list of leaf revisions. + +=item $mtn->parents(address@hidden, $revision_id) + +Get a list of parents for the specified revision. + +=item $mtn->roots(address@hidden) + +Get a list of root revisions, i.e. revisions with no parents. + +=item $mtn->select(address@hidden, $selector) + +Get a list of revision ids that match the specified selector. + +=item $mtn->tags(\$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 +\$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: + + tag - The name of the tag. + revision_id - The id of a revision that the tag is attached to. + 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 ...]) + +Sort the specified revisions such that the ancestors come out first. + +=back + +=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. + +=head1 NOTES + +The Monotone::AutomateStdio class, with the exception of the $mtn->db_set() +method, provides a read-only interface to a Monotone database. This is a +deliberate safety precaution. + +In order to reliably shutdown the mtn subprocess, the alarm() routine is used +and will consequently reset any SIGALRM timers. In C I would obviously use +setitimer() to set up any timeout timers and then restore their previous state, +however to do this in Perl one has to use the Time::HiRes CPAN module. I felt +that on balance it would be nicer not to introduce this dependency and use +alarm(). Anyway if you want to do something periodically it is usually better +to have a thread do that for you rather than use signals. If you have different +opinions on this then please let me know. + +=head1 SEE ALSO + +http://monotone.ca + +=head1 BUGS + +The parsing of quoted basic stanza escaped output is done using a regular +expression. This is not fool-proof but it is very unlikely that normal data +would come close to exposing this flaw and it is a lot simpler and more +efficient than the alternative. + +Whilst the object does know what version of mtn automate interface it is +dealing with it currently does nothing with that knowledge. However, hopefully +as usage of this library grows then it should not be too difficult to code in +exceptions to cleanly deal with differences. + +No doubt other bugs will crawl out of the wood-work. + +=head1 HISTORY + +An original my Anthony Cooper . + +=cut --- README +++ README @@ -0,0 +1,2 @@ +This is a Perl library module for accessing Monotone's automate stdio interface. +See the POD file for further details. --- TODO +++ TODO @@ -0,0 +1,4 @@ +1) Implement structuring of data for the $mtn->attributes() and $mtn->revision() + methods. +2) Sort out a test database for use with a mtn-tester +3) Do CPAN stuff. --- mtn-tester +++ mtn-tester @@ -0,0 +1,422 @@ +#!/usr/bin/perl -w + +use strict; +use integer; +use Carp; +use File::Basename; +use POSIX qw(strftime); +use Storable; +use Data::Dumper; +use GDBM_File; +use IO::Handle; +use Monotone::AutomateStdio; +use Data::Dumper; + +my($data, + @list, + $mtn); + +$mtn = Monotone::AutomateStdio->new("test.mtn"); +# $mtn = Monotone->new(); +if (0) +{ +if (! $mtn->branches(address@hidden)) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(address@hidden); +} +if (! $mtn->certs(address@hidden, "ae65e53a3beca7841a87eb4525f39e3369107b82")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(address@hidden); +} +if (! $mtn->cert("ae65e53a3beca7841a87eb4525f39e3369107b82", "status", + "EXTERMINATE")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +if (! $mtn->children(address@hidden, "78bfd27c26a0c8ac249f30293e6ef6d5f44e6084")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(address@hidden); + printf("Largest valid index = %d\n", $#list); +} +if (! $mtn->children(address@hidden, "ae65e53a3beca7841a87eb4525f39e3369107b82")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(address@hidden); +} +if (! $mtn->ancestry_difference(address@hidden, + "ed89ce366c3316f189f01229adc863b3285130e2", + "65e51cd2a00b4ee60b9fcc356e8e503d1e690414")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print "DIFF\n"; + print Dumper(address@hidden); +} +if (! $mtn->common_ancestors(address@hidden, + "ae65e53a3beca7841a87eb4525f39e3369107b82", + "78bfd27c26a0c8ac249f30293e6ef6d5f44e6084", + "ff7e085fab7385fbaabc57c1f53a9bbea59bf132")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(address@hidden); +} +if (! $mtn->content_diff(\$data, + "ae65e53a3beca7841a87eb4525f39e3369107b82", + "d612b1ed732ea565085eede32bb2a1fae2ca8804")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(\$data); +} +if (! $mtn->content_diff(\$data, + "ae65e53a3beca7841a87eb4525f39e3369107b82", + "d612b1ed732ea565085eede32bb2a1fae2ca8804", + "Makefile")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(\$data); +} +if (! $mtn->descendents(address@hidden, "d612b1ed732ea565085eede32bb2a1fae2ca8804")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(address@hidden); +} +if (! $mtn->erase_ancestors(address@hidden, + "ae65e53a3beca7841a87eb4525f39e3369107b82", + "d612b1ed732ea565085eede32bb2a1fae2ca8804")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(address@hidden); +} +if (! $mtn->get_base_revision_id(\$data)) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(\$data); +} +if (! $mtn->get_content_changed(address@hidden, + "ae65e53a3beca7841a87eb4525f39e3369107b82", + "Makefile")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(address@hidden); +} +if (! $mtn->get_corresponding_path + (\$data, + "ae65e53a3beca7841a87eb4525f39e3369107b82", + "Makefile", + "d612b1ed732ea565085eede32bb2a1fae2ca8804")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(\$data); +} +if (! $mtn->get_current_revision_id(\$data)) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(\$data); +} +if (! $mtn->get_file(\$data, "f7bec98218953adbb833865ccc52ea74d410b24e")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print $data; +} +if (! $mtn->get_file_of(\$data, "Makefile")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print $data; +} +if (! $mtn->get_option(\$data, "database")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print $data; +} +} + +if (! $mtn->attributes(\$data, "README")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print $data; +} + +if (! $mtn->branches(address@hidden)) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(address@hidden); +} + +if (! $mtn->get_option(\$data, "database")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print $data . "\n"; +} + +if (! $mtn->get_revision(\$data, "d83907887a2a35229ef361a74e98bd296d84e60c")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print $data; +} + +if (! $mtn->get_revision(\$data,)) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print $data; +} + +if (! $mtn->get_manifest_of(address@hidden)) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(address@hidden); +} + +if (! $mtn->get_manifest_of(\$data)) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(\$data); +} + +if (! $mtn->certs(address@hidden, "d83907887a2a35229ef361a74e98bd296d84e60c")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(address@hidden); +} + +if (! $mtn->certs(\$data, "d83907887a2a35229ef361a74e98bd296d84e60c")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(\$data); +} + +if (! $mtn->db_set("database", "default-server", "www.test.com")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} + +if (! $mtn->db_get(\$data, "database", "default-server")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(\$data); +} + +if (! $mtn->graph(address@hidden)) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(address@hidden); +} + +if (! $mtn->graph(\$data)) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(\$data); +} + +if (! $mtn->heads(address@hidden, "net.venge.monotone.www")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(address@hidden); +} + +if (! $mtn->identify(\$data, "Makefile.am")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(\$data); +} + +if (! $mtn->interface_version(\$data)) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(\$data); +} + +if (! $mtn->inventory(\$data)) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(\$data); +} + +if (! $mtn->inventory(address@hidden)) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(address@hidden); +} + +if (! $mtn->keys(\$data)) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(\$data); +} + +if (! $mtn->keys(address@hidden)) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(address@hidden); +} + +if (! $mtn->leaves(address@hidden)) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(address@hidden); +} + +if (! $mtn->parents(address@hidden, "d83907887a2a35229ef361a74e98bd296d84e60c")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(address@hidden); +} + +if (! $mtn->roots(address@hidden)) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(address@hidden); +} + +if (! $mtn->select(address@hidden, "l:2007-01-01/b:net.venge.monotone")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(address@hidden); +} + +if (! $mtn->tags(\$data, "net.venge.monotone")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(\$data); +} + +if (! $mtn->tags(address@hidden, "net.venge.monotone")) +{ + printf("OOPS: %s\n", $mtn->error_message()); +} +else +{ + print Dumper(address@hidden); +} + +printf("Last error message `%s'\n", $mtn->error_message()); +print Dumper (\$mtn); + +printf("Destroying object.\n"); +$mtn = undef; + +exit(0);