#!/usr/bin/perl

# This is a demo script which illustrates how to write a
# special-purpose CVS client.  It allows you to run the "cvs admin -t"
# command without having to check out a CVS working directory first.
# It was written by Cyclic Software, http://www.cyclic.com/, and is in
# the public domain.

# Usage: admint path/in/repository new-message
# CVSROOT should be set to the pathname of the repository (no access methods).

use FileHandle;
use IPC::Open2;

# If this were more than a demo, we'd do more syntax checking on the
# arguments to ensure that they don't cause protocol violations or the
# like.

# For demo purposes, we just run the "cvs server" command as a subprocess.
# This might be sometimes useful in Real Life(TM) but it would be
# also relatively easy to use perl sockets to open a pserver/rsh/etc
# connection.  Alternately, just change "cvs server" to "rsh foo cvs server".
$pid = open2( \*Reader, \*Writer, "tee log | cvs server" ) || die "cannot open2: $!";
Writer->autoflush(); # default here, actually

# OK, first send the request to the server.  A simplified example is:
#     Root /home/kingdon/zwork/cvsroot
#     Argument foo/xx
#     Directory foo
#     /home/kingdon/zwork/cvsroot/foo
#     Directory .
#     /home/kingdon/zwork/cvsroot
#     annotate
# although as you can see there are a few more details.

print Writer "Root ", $ENV{"CVSROOT"}, "\n";
print Writer "Valid-responses ok error Valid-requests Checked-in Updated Merged Removed M E\n";
# Don't worry about sending valid-requests, the server just needs to
# support "admin" and if it doesn't, there isn't anything to be done.
print Writer "UseUnchanged\n";

# FIXME: this breaks if ARGV[1] contains a newline.  We could fix
# that by using the Argumentx request.
print Writer "Argument -t-", $ARGV[1], "\n";

print Writer "Argument ", $ARGV[0], "\n";
# The protocol requires us to fully fake a working directory (at
# least to the point of including the directories down to the one
# containing the file in question).
# So if $ARGV[0] is "dir/sdir/file", then @dirs will be ("dir","sdir","file")
@dirs = split (/\//, $ARGV[0]);
$path = "";
foreach (@dirs) {
    if ($path eq "") {
	# In our example, $_ is "dir".
	$path = $_;
    } else {
	print Writer "Directory ", $path, "\n";
	print Writer $ENV{"CVSROOT"}, "/", $path, "\n";
	# In our example, $_ is "sdir" and $path becomes "dir/sdir"
	# And the next time, "file" and "dir/sdir/file" (which then gets
	# ignored, because we don't need to send Directory for the file).
	$path = $path . "/" . $_;
	$file = $_;
    }
}

# "admin" seems to require us to send "Entry".  I don't think it matters
# what the contents of the Entry are; perhaps it is a bug in "admin"
# that it requires it in the first place.
print Writer "Entry /", $file, "/1.1///\n";

# And the last "Directory" before "annotate" is the top level.
print Writer "Directory .\n";
print Writer $ENV{"CVSROOT"}, "\n";

print Writer "admin\n";
# OK, we've sent our command to the server.  Thing to do is to
# close the writer side and get all the responses.  If "cvs server"
# were nicer about buffering, then we could just leave it open, I think.
close (Writer) || die "cannot close: $!";

# Ready to get the responses from the server.
# For example:
#     E Annotations for foo/xx
#     E ***************
#     M 1.3          (kingdon  06-Sep-97): hello 
#     ok
while (<Reader>) {
    @words = split;
    # Adding one is for the (single) space which follows $words[0].
    $rest = substr ($_, length ($words[0]) + 1);
    if ($words[0] eq "E") {
	print STDERR $rest;
    } elsif ($words[0] eq "M") {
	print $rest;
    } elsif ($words[0] eq "ok") {
	# We could complain about any text received after this, like the
	# CVS command line client.  But for simplicity, we don't.
    } elsif ($words[0] eq "error") {
	die $rest;
    } else {
	# This covers Checked-in, Updated, etc., which I don't think
	# the server should be sending in response to admin -t (not
	# that cvsclient.texi tries to specify this).
	warn "unrecognized response: $_";
    }
}
close (Reader) || warn "cannot close: $!";