#!/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 annotate"
# 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: rann path/in/repository
# 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
# $ARGV[0] to ensure that it doesn'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, "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 "annotate" and if it doesn't, there isn't anything to be done.
print Writer "UseUnchanged\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 . "/" . $_;
    }
}
# And the last "Directory" before "annotate" is the top level.
print Writer "Directory .\n";
print Writer $ENV{"CVSROOT"}, "\n";

print Writer "annotate\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 annotate (not
	# that cvsclient.texi tries to specify this).
	warn "unrecognized response: $_";
    }
}
close (Reader) || warn "cannot close: $!";