#
#
# add_file "contrib/Monotone.pm"
#  content [f5f3409243b6968cee5e3fb0ae885285a1bf4e45]
# 
# patch "contrib/README"
#  from [09b6c73ef5570ed07e37365bfc355b508053e5b2]
#    to [e483bdeb345de70d635d31bed0c9ec390caba3b0]
#
============================================================
--- contrib/Monotone.pm	f5f3409243b6968cee5e3fb0ae885285a1bf4e45
+++ contrib/Monotone.pm	f5f3409243b6968cee5e3fb0ae885285a1bf4e45
@@ -0,0 +1,130 @@
+# This is a simple Perl module to start a monotone automate sub-process and then pass commands to it.
+# Written by Will Uther, but I'm not a PERL hacker and I'm hoping someone will come along and fix it
+# to make it right.
+
+package Monotone;
+
+use warnings;
+use strict;
+use FileHandle;
+use IPC::Open2;
+
+#constructor
+sub new {
+    my $class = shift;
+    my $self = {
+        In => undef,
+        Out  => undef,
+        PID => undef,
+        CmdNum => undef,
+    };
+    bless ($self, $class);
+    return $self;
+}
+
+sub open ($$) {
+    my ( $self, $db, $workspace ) = @_;
+    if (defined($db) && defined($workspace)) {
+        local (*READ, *WRITE);
+        $self->{PID} = open2(\*READ, \*WRITE, "mtn --db=$db --root=$workspace automate stdio" );
+        $self->{In} = *READ;
+        $self->{Out} = *WRITE;
+        $self->{CmdNum} = 0;
+    }
+}
+
+sub call {
+    my $self = shift;
+    
+    return if !defined($self->{PID});
+    
+    my $read = $self->{In};
+    my $write = $self->{Out};
+        
+    print $write "l";
+    
+    my $arg;    
+    while (defined($arg = shift)) {
+        my $arglen = length $arg;
+        # print "Arg: " . $arg . " with len: " . $arglen . "\n";
+        print $write $arglen;
+        print $write ":";
+        print $write $arg;
+    }
+    print $write "e";
+    my $count=0;
+    my @ret;
+    my $last;
+    
+    do {
+        my $numString = "";
+        my $ch;
+        while (($ch = getc($read)) ne ':') {
+            $numString = $numString . $ch;
+        }
+        die("Got wrong command number from monotone: ". $numString . ".") if ($numString != $self->{CmdNum});
+        my $err = getc($read);
+        die("Parser confused.") if ($err ne '0' && $err ne '1' && $err ne '2');
+        die("Parser confused.") if (getc($read) ne ':');
+        $last = getc($read);
+        die("Parser confused.") if ($last ne 'l' && $last ne 'm');
+        die("Parser confused.") if (getc($read) ne ':');
+        $numString = "";
+        while (($ch = getc($read)) ne ':') {
+            $numString = $numString . $ch;
+        }
+        my $input = "";
+        while ($numString > 0) {
+            $input = $input . getc($read);
+            $numString--;
+        }
+        if ($err ne '0') {
+            die("Got error: " . $err);
+        }
+        push @ret, $input;
+    } while ($last eq 'm');
+    
+    die("Parser confused.") if ($last ne 'l');
+    
+    $self->{CmdNum} += 1;
+    return @ret;
+}
+
+sub close {
+    my $self = shift;
+    
+    close $self->{Out} if defined($self->{Out});
+    $self->{Out} = undef;
+    close $self->{In} if defined($self->{In});
+    $self->{In} = undef;
+    waitpid($self->{PID}, 0);
+    $self->{PID} = undef;
+}
+
+# print "starting tests\n";
+# 
+# my $test = Monotone->new();
+# $test->open("/Users/willu/src/monotone/mt.db","/Users/willu/src/monotone/monotone-source");
+# 
+# my @revs = $test->call("get_base_revision_id");
+# my $rev;
+# 
+# foreach $rev (@revs) {
+#     print "got revision: " . $rev . "\n";
+# }
+# 
+# $rev = $revs[0];
+# chomp $rev; # remove the trailing \n that monotone leaves there... tsk tsk.
+# 
+# my @certs = $test->call("certs", $rev);
+# my $cert;
+# 
+# print "Got " . @certs . " certs:\n\n";
+# 
+# foreach $cert (@certs) {
+#     print "Next cert:\n" . $cert . "\n";
+# }
+# 
+# $test->close();
+# 
+# print "done\n";
============================================================
--- contrib/README	09b6c73ef5570ed07e37365bfc355b508053e5b2
+++ contrib/README	e483bdeb345de70d635d31bed0c9ec390caba3b0
@@ -21,6 +21,8 @@ licenses.
      For a manual, do `perl Notify.pl --man'.
      To get a help text, do `perl Notify.pl --help'.
 
+  -- Monotone.pm: A Perl module to access a 'mtn automate stdio' subprocess.
+
   -- monoprof.sh: A simple monotone profiling script.
 
   -- Log2Gxl.java: Removed. Now in branch net.venge.monotone.contrib.monotree