#!/usr/athena/bin/perl -w
# $Header: /afs/athena.mit.edu/user/f/o/foley/src/perl/RCS/logfilter.pl,v 1.9 2004/12/22 00:56:51 foley Exp $

sub usage {
    my $error = shift || "";
    print "$error\n\n".'$Header: /afs/athena.mit.edu/user/f/o/foley/src/perl/RCS/logfilter.pl,v 1.9 2004/12/22 00:56:51 foley Exp $ '."
Generic Zephyr/Mail Logger System For CVS/Subversion
Maintained by Joe Foley<foley\@mit.edu>
-----------------------------------------------------
You may only use either a CVS or Subversion repository

Usage:
    $0 [options]
      -c <commit-address>   Send commit updates to this email address
      -d <diff-address>     Send diffs of commits to this email address
      -h                    This help screen
      -l <ZLINES>           Restrict zephyr commit message to ZLINES of message
      -z <zephyr-class>     Send commit message to zephyr class

CVS Options:
      -r <repository>       Use CVS <repository> instead of the ENV var

Subversion Options:
      -m <regexp>           If regexp matches project, run.  Else just exit.
      -v <version>          Version to look at in subversion changelog
      -S <repository>       Use Subversion repository
      -A <db>               Automatic option setting based on db

Common Usage:".'
 CVS (loginfo)
   RandomGame* $CVSROOT/CVSROOT/logfilter.pl -z RandomGameList %{sVv}
 Subversion (post-commit)
   $REPOS/hooks/logfilter.pl -S "$REPOS" -m "RandomGame" -v "$REV" -z "RandomGameList"

NOTE: Subversion operation is a work in progress.  Things may change at any time!
'."$!
";
    exit(2);

}

# To install under CVS:
# 1. Check out a copy of your CVSROOT module in the CVS repository
# 2. Add a line like this to your "loginfo":
#    RandomGame* $CVSROOT/CVSROOT/logfilter.pl -z RandomGameList %{sVv}
# 3. Copy logfilter.pl itself directly into $CVSROOT/CVSROOT
#    athena% cp logfilter.pl $CVSROOT/CVSROOT/.
# 4. Check in your copy of "loginfo"
# 5. Test it out to make sure it works when you mess with the RandomGame modules

# To install under Subversion (which gives no ENV):
# 1.  Enable the appropriate hook filter in $REPOS/hooks
#      (I prefer using post-commit)
# 2.  Place this line in the hook filer script file
#      $REPOS/hooks/logfilter.pl -S "$REPOS" -p "RandomGame" -v "$REV" -z "RandomGameList"

# These examples zephyr the commit log to zephyr class RandomGameList.
# Also mails the commit log to diff-address, followed by context diffs
# of the modified files.

# This script is not specific to any particular repository, but it is
# specific to the Athena environment in that it assumes the existence
# of /usr/athena/bin/perl and other programs.  Obviously you should
# change this to wherever you have perl installed.

# This script is a merging of tibbetts@mit.edu and woods@web.apc.org
#  CVS logger scripts.
# In addition, breser's commit-email.pl script has been integrated from
#  the subversion example scripts.
# Contact Joe Foley<foley@mit.edu> with bugs and suggestions

use Getopt::Std;
use strict;
use Carp;
use Data::Dumper; # for debugging
# shut off setgid
$) = $(;

# Config options
# By default, when a file is deleted from the repository, svnlook diff
# prints the entire contents of the file.  If you want to save space
# in the log and email messages by not printing the file, then set
# $no_diff_deleted to 1.  This is generally a good idea!
my $no_diff_deleted = 1;
# actually, we generally don't want diffs of big files either.  Fix this later!

# Useful environment settings/paths
my $sendmail = ( -x "/usr/sbin/sendmail") ? "/usr/sbin/sendmail"
    : "/usr/lib/sendmail";
# we probably don't want huge zephyrs
my $zwrite = "/usr/athena/bin/zwrite";
my $head = "/usr/bin/head";
my $svnlook = "/afs/athena.mit.edu/astaff/project/svn/bin/svnlook";
my $gdiff = "/afs/athena.mit.edu/project/gnu/bin/gdiff";
my $rcsdiff = "/afs/athena.mit.edu/project/gnu/bin/rcsdiff";
&checkprogs($sendmail,$zwrite,$svnlook,$head,$gdiff,$rcsdiff);

my %ARGS;
getopts('A:c:d:hl:m:r:v:S:z:',\%ARGS) or &usage("Error: Invalid/nonexistant command line options.");
$ARGS{h} and &usage("Help requested.");
my $Z_CLASS = $ARGS{z};
my $Z_INST = "COMMIT";
my $C_MAIL = $ARGS{c};
my $D_MAIL = $ARGS{d};
if (!($ARGS{c} || $ARGS{d} || $ARGS{z} ||$ARGS{A})) {
    &usage("Error: No output method specified.");
}
# check which mode we're in
my $MODE;
if($ARGS{S}||$ARGS{A}) {$MODE = "SVN";}
else { $MODE = "CVS"; }
 
($ARGS{r} && $ARGS{S}) and &usage("Error: Can't be in CVS and Subversion mode simultaneously!");
my $cvsroot = $ARGS{r} || $ENV{'CVSROOT'};
$ARGS{l} and $zwrite = "$head -n $ARGS{l} | $zwrite";

my $diffblob; my $commblob;
my $subjfiles = "";
my @project_settings_list = (&new_project);
if($MODE eq "CVS") {
    # Create subject line (derive %s from %{sVv}).  $ARGV[0] is of the
    # form "dir filename,oldrev,newrev ..."; what we want is
    #  "dir filename ..."    

    #print "arg: ".$ARGV[0]."\n";
    if($ARGV[0]) {
	my @files = split(/ /, $ARGV[0]);
	if(@files) {
	    my $dir = shift @files;
	    map { s/,.*// } @files;
	    my $file;
	    foreach $file (@files) {
		$subjfiles .= "$dir/$file ";
	    }
	}
    }

    # for consistency, construct a project struct with the appropriate fields
    my $current_project = $project_settings_list[0];
    $current_project->{match_regex} = $ARGS{m} || ".";
    $current_project->{modes} = ($ARGS{z} ? "z" : "")
	.($ARGS{c} ? "c" : "")
	.($ARGS{d} ? "d" : "");
    $current_project->{zephyr_class} = $ARGS{z};
    $current_project->{zephyr_instance} = $Z_INST;
    $current_project->{email_addresses} = [$ARGS{c},$ARGS{d}];
    $current_project->{subject_prefix} = "CVS";
    
    
    # Display the commit log as proffered by CVS.  Remember the repository
    # directory.
    my $commblob = "";
    my $repdir;
    
    while (<STDIN>) {
	if (/^Update of (.*)$/) {
	    $repdir = $1;
	}
	$commblob .= $_;	
    }
    $current_project->{commblob} = $commblob;    
    # Display diffs.  $ARGV[0] is of the form "dir filename,oldrev,newrev ...".
    my @files = split(/ /, $ARGV[0]);
    #$dir = shift @files;
    my $cmd;
    if($D_MAIL) {
	my $diffblob = "";
	foreach (@files) {
	    my ($file, $old, $new) = split(/,/);
	    if (!$new or ($new eq "NONE")) {
		next;
	    }
	    $diffblob .= "\n";
	    $diffblob .="==================================================\n";
	    if ($old eq "NONE") {
		$diffblob .= "Initial contents of new file $file\n";
		$cmd = "$gdiff -u /dev/null $file";
	    } else {
		$diffblob .= "Differences for $file ";
		$diffblob .= "(revision $old -> $new)\n";
		my $rcsfile = "$repdir/$file";
		$cmd ="$rcsdiff -u -kk -r$old -r$new $rcsfile 2>/dev/null";
	    }
	    $diffblob .= "==================================================\n";
	    open(DIFF, "$cmd|");
	    $diffblob .= $_ while (<DIFF>);
	    close DIFF;
	}
	$current_project->{diffblob} = $diffblob;
    }
    

}
# Now for Subversion equivalent
elsif($MODE eq "SVN") {
    my $current_project = $project_settings_list[0];
    # load the setting 

    
    my $repos = $ARGS{S};
    my $rev = $ARGS{v};


    # If the revision number is undefined, then there were not enough
    # command line arguments.
    &usage("$0: too few arguments.") unless defined $rev;

    # Check the validity of the command line arguments.  Check that the
    # revision is an integer greater than 0 and that the repository
    # directory exists.
    unless ($rev =~ /^\d+/ and $rev > 0) {
	&usage("$0: revision number `$rev' must be an integer > 0.");
    }
    unless (-e $repos) {
	&usage("$0: repos directory `$repos' does not exist.");
    }
    unless (-d _) {
	&usage("$0: repos directory `$repos' is not a directory.");
    }

    # Check the regular expression can be compiled and
    # compile them.

    my $match_regex = $ARGS{m};
    if($ARGS{m}) {
    
	# To help users that automatically write regular expressions
	# that match the root directory using ^/, remove the / character
	# because subversion paths, while they start at the root level,
	# do not begin with a /.
	$match_regex =~ s#^\^/#^#;
	{
	    my $match_re;
	    eval { $match_re = qr/$match_regex/ };
	    if ($@)
	    {
		warn "$0: -m regex `$match_regex' does not compile:\n$@\n";
		exit(1);
	    }
	}
    }
    $current_project->{match_regex} = $match_regex || ".";
    $current_project->{modes} = ($ARGS{z} ? "z" : "")
	.($ARGS{c} ? "c" : "")
	.($ARGS{d} ? "d" : "");
    $current_project->{zephyr_class} = $ARGS{z};
    $current_project->{zephyr_instance} = $Z_INST;
    $current_project->{email_addresses} = [$ARGS{c},$ARGS{d}];
    $current_project->{subject_prefix} = "Subversion: ";
    
    if($ARGS{A}) {
	my @project_settings_append;
	# load the db/configfile
	open(DB, "$ARGS{A}") or die "Can't open $ARGS{A} for reading: $!\n";
	my $dbblob;
	$dbblob .= $_ while (<DB>);
	close DB;
	eval $dbblob;
	push(@project_settings_list,@project_settings_append);
    }
#    print Dumper(@project_settings_list);

    
    ######################################################################
    # Harvest data using svnlook.

    # Change into /tmp so that svnlook diff can create its .svnlook
    # directory.
    my $tmp_dir = '/tmp';
    chdir($tmp_dir)
	or die "$0: cannot chdir `$tmp_dir': $!\n";

    # Get the author, date, and log from svnlook.
    my @svnlooklines = &read_from_process($svnlook, 'info', $repos, '-r', $rev);
    my $author = shift @svnlooklines;
    my $date = shift @svnlooklines;
    shift @svnlooklines;
    my @log = map { "$_\n" } @svnlooklines;
    
    # Figure out what directories have changed using svnlook.
    my @dirschanged = &read_from_process($svnlook, 'dirs-changed', $repos, 
					 '-r', $rev);
    
    # Lose the trailing slash in the directory names if one exists, except
    # in the case of '/'.
    my $rootchanged = 0;
    for (my $i=0; $i<@dirschanged; ++$i)
    {
	if ($dirschanged[$i] eq '/')
	{
	    $rootchanged = 1;
	}
	else
	{
	    $dirschanged[$i] =~ s#^(.+)[/\\]$#$1#;
	}
    }
    
    # Figure out what files have changed using svnlook.
    @svnlooklines = &read_from_process($svnlook, 'changed', $repos, '-r', $rev);

    # Parse the changed nodes.
    my @adds;
    my @dels;
    my @mods;
    foreach my $line (@svnlooklines)
    {
	my $path = '';
	my $code = '';
	
	# Split the line up into the modification code and path, ignoring
	# property modifications.
	if ($line =~ /^(.).  (.*)$/)
	{
	    $code = $1;
	    $path = $2;
	}
	
	if ($code eq 'A')
	{
	    push(@adds, $path);
	}
	elsif ($code eq 'D')
	{
	    push(@dels, $path);
	}
	else
	{
	    push(@mods, $path);
	}
    }
    $subjfiles = join(" ",@adds, @dels, @mods);

    # Get the diff from svnlook. If we need to bother
    my @difflines;
    if($D_MAIL) {
	my @no_diff_deleted = $no_diff_deleted ? ('--no-diff-deleted') : ();
	@difflines = &read_from_process($svnlook, 'diff', $repos,
					   '-r', $rev, @no_diff_deleted);
    }

    ######################################################################
    # Modified directory name collapsing.

    # Collapse the list of changed directories only if the root directory
    # was not modified, because otherwise everything is under root and
    # there's no point in collapsing the directories, and only if more
    # than one directory was modified.
    my $commondir = '';
    if (!$rootchanged and @dirschanged > 1)
    {
	my $firstline    = shift @dirschanged;
	my @commonpieces = split('/', $firstline);
	foreach my $line (@dirschanged)
	{
	    my @pieces = split('/', $line);
	    my $i = 0;
	    while ($i < @pieces and $i < @commonpieces)
	    {
		if ($pieces[$i] ne $commonpieces[$i])
		{
		    splice(@commonpieces, $i, @commonpieces - $i);
		    last;
		}
		$i++;
	    }
	}
	unshift(@dirschanged, $firstline);

	if (@commonpieces)
	{
	    $commondir = join('/', @commonpieces);
	    my @new_dirschanged;
	    foreach my $dir (@dirschanged)
	    {
		if ($dir eq $commondir)
		{
		    $dir = '.';
		}
		else
		{
		    $dir =~ s#^$commondir/##;
		}
		push(@new_dirschanged, $dir);
	    }
	    @dirschanged = @new_dirschanged;
	}
    }
    my $dirlist = join(' ', @dirschanged);
    
    ######################################################################
    # Assembly of log message.

    # Put together the body of the log message.
    my @body;
    push(@body, "Author: $author\n");
    push(@body, "Date: $date\n");
    push(@body, "New Revision: $rev\n");
    push(@body, "\n");
    if (@adds)
    {
	@adds = sort @adds;
	push(@body, "Added:\n");
	push(@body, map { "   $_\n" } @adds);
    }
    if (@dels)
    {
	@dels = sort @dels;
	push(@body, "Removed:\n");
	push(@body, map { "   $_\n" } @dels);
    }
    if (@mods)
    {
	@mods = sort @mods;
	push(@body, "Modified:\n");
	push(@body, map { "   $_\n" } @mods);
    }
    push(@body, "Log:\n");
    push(@body, @log);
    push(@body, "\n");
    @difflines =  map { /[\r\n]+$/ ? $_ : "$_\n" } @difflines;

    #check for matches and build match array.  There's probably a better way to do this.
    foreach my $project (@project_settings_list)
    {
	my $match_re = $project->{match_regex};
	my $match    = 0;
	foreach my $path (@dirschanged, @adds, @dels, @mods)
	{
	    if ($path =~ $match_re)
	    {
		#$match = 1;
		#last;
		$project->{commblob} = join("",@body);
		$project->{diffblob} = join("",@difflines);

	    }
	}
	# Mod: allow multiple matches
	#     next unless $match;	
    }
}

foreach my $project (@project_settings_list) {
    if(($project->{modes} =~ /d/)&&($project->{commblob}||$project->{diffblob})) {
#    if($D_MAIL) {
	my $ADDR = join(",",$project->{email});
	open(DIFFMAIL, "|$sendmail $ADDR") or warn "Unable to open sendmail: $!.\n";
	print DIFFMAIL "To: $ADDR\n";
	print DIFFMAIL "Subject: $project->{subject_prefix} DIFF: $project->{subjfiles}\n\n";
	print DIFFMAIL "$project->{commblob}\n";
	print DIFFMAIL "$project->{diffblob}\n";
	close DIFFMAIL;
    }
    if(($project->{modes} =~ /c/)&&($project->{commblob})) {
#    if($C_MAIL) {
	my $ADDR = join(",",$project->{email});
	open(DIFFMAIL, "|$sendmail $ADDR") or warn "Unable to open sendmail: $!.\n";
	print DIFFMAIL "To: $ADDR\n";
	print DIFFMAIL "Subject: $project->{subject_prefix} DIFF: $project->{subjfiles}\n\n";
	print DIFFMAIL "$project->{commblob}\n";
	close DIFFMAIL;
    }
    if(($project->{modes} =~ /z/)&&($project->{commblob})) {
#    if($Z_CLASS) {
	# construct our command
	my $cmd = "|$zwrite -d -c $project->{zephyr_class}";
	$project->{zephyr_instance} and $cmd .= " -i $project->{zephyr_instance}";
	$project->{zephyr_opcode} and $cmd .= " -O $project->{zephyr_opcode}";
#	print "cmd: $cmd\n";
	open (ZWRITE, "$cmd") or warn "Unable to open zwrite: $!\n";
	print ZWRITE $project->{commblob};
	close(ZWRITE);
    }
}

exit(0);


### HELPER SUBROUTINES

sub checkprogs {
    my $ok = 1;
    foreach my $program (@_) {	
	if (-e $program) {
	    unless (-x $program) {		
		warn "$0: required program `$program' is not executable, ",
		"edit $0.\n";
		$ok = 0;
	    }
	}
	else {	    
	    warn "$0: required program `$program' does not exist, edit $0.\n";
	    $ok = 0;
	}
    }
    exit 1 unless $ok;
}    

# Return a new hash data structure for a new empty project that
# matches any modifications to the repository.
sub new_project
{
  return {email_addresses => [],
          from_address    => '',
          hostname        => '',
          log_file        => '',
          match_regex     => '.',
          reply_to        => '',
	  modes           => '',
          subject_prefix  => '',
	  zephyr_class    => '',
          zephyr_instance => '',
#          zephyr_opcode   => '',
	  subjfiles       => '',
	  commblob        => '',
	  diffblob        => '',
	  
      };
}

# Start a child process safely without using /bin/sh.
sub safe_read_from_pipe {
    unless (@_) {	
	croak "$0: safe_read_from_pipe passed no arguments.\n";
    }

    my $pid = open(SAFE_READ, '-|');
    unless (defined $pid) {    
	die "$0: cannot fork: $!\n";
    }
    unless ($pid) {
	open(STDERR, ">&STDOUT")
	    or die "$0: cannot dup STDOUT: $!\n";
	exec(@_)
	    or die "$0: cannot exec `@_': $!\n";
    }
    my @output;
    while (<SAFE_READ>) {	
	s/[\r\n]+$//;
	push(@output, $_);
    }
    close(SAFE_READ);
    my $result = $?;
    my $exit   = $result >> 8;
    my $signal = $result & 127;
    my $cd     = $result & 128 ? "with core dump" : "";
    if ($signal or $cd) {	
	warn "$0: pipe from `@_' failed $cd: exit=$exit signal=$signal\n";
    }
    if (wantarray) {	
	return ($result, @output);
    }
    else {
	return $result;
    }
}

# Use safe_read_from_pipe to start a child process safely and return
# the output if it succeeded or an error message followed by the output
# if it failed.
sub read_from_process {
    unless (@_) {
	croak "$0: read_from_process passed no arguments.\n";
    }
    my ($status, @output) = &safe_read_from_pipe(@_);
    if ($status) {
	return ("$0: `@_' failed with this output:", @output);
    } 
    else {
	return @output;
    }
}
