Cvsloginfo2mail.pl

Sends diff emails whenever someone checks in a change. It can be installed by adding the following line to your CVSROOT loginfo file:

DEFAULT /usr/local/bin/cvsloginfo2mail.pl -d /var/cvs -w cvsweb -L en %{sVv} ADDRESS@HOST.COM

#!/usr/bin/perl -w
#
# CVS loginfo 2 mail
# Copyright (c) 2001 SATOH Fumiyasu. All rights reserved.
#
# Date: 2001-11-26, since 2001-10-29
# License: GNU General Public License ver.2
#
# Required external commands:
#	sendmail
#	rcsdiff
#
# $Id: cvsloginfo2mail.pl.txt,v 1.1 2004/04/16 22:12:43 enigma Exp $

# FIXME: Support to customize URL for CVS web interface
# FIXME: Support to customize sender address
# FIXME: Support diff(1) options for rcsdiff(1)
# FIXME: Support chroot(2)-ed environment

use strict;
use English;
use Getopt::Std;
use IO::File;

$ENV{'PATH'} = "/usr/bin:/usr/sbin:/usr/lib:$ENV{'PATH'}";

my $NAME ="cvsloginfo2mail.pl";
my $VERSION = "0.1.5";

# Options
# ======================================================================

# CVS root
my $cvs_root = $ENV{'CVSROOT'};

# CVS Web interface by cvsweb or ViewCVS
my $cvsweb_url = 'http://oscar/cvsweb/index';
# CVS Web interface Type: 'cvsweb' or 'viewcvs'
my $cvsweb_type = 'cvsweb';

# Content language
my $lang = 'NONE';

my $usage = <<EOF_USAGE;
Usage: in \$CVSROOT/CVSROOT/loginfo
    ^module \$CVSROOT/CVSROOT/$NAME [options] %{sVv} address ...

Options:
    -d cvsroot	CVS root directory [\$CVSROOT]
    -w webtype	Type of web interface [$cvsweb_type]
    -f address	Envelope sender address (not implemented yet)
    -D		Suppress rcsdiff(1) output
    -L language	Content language [$lang]

    %{sVv}	CVS loginfo
    address	Mail CVS loginfo to this address(es)

Type of web interface:
    viewcvs	ViewCVS - http://viewcvs.sourceforge.net/
    cvsweb	cvsweb - http://stud.fh-heilbronn.de/~zeller/cgi/cvsweb.cgi/

Content Language:
    ja		Japanese (ISO-2022-JP)
EOF_USAGE

# Command-line options
# ----------------------------------------------------------------------

use vars qw($opt_d $opt_w $opt_f $opt_D $opt_L);
if (!getopts('d:w:f:DL:') || @ARGV < 2) {
    print($usage);
    exit(1);
}

$cvs_root = $opt_d if (defined($opt_d));
$cvsweb_type = $opt_w if (defined($opt_w));
$lang = $opt_L if (defined($opt_L));

my $cvs_info = shift(@ARGV);
my @recip = @ARGV;

# Language specific?
# ======================================================================

my $ja_convert = undef;
if ($lang eq 'ja') {
    eval('use Jcode');
    if ($@) {
	eval('require "jcode.pl"');
	if ($@) {
	    die "Jcode.pm or jcode.pl required to process Japanese.\n";
	}
	$ja_convert = \&jcode::convert;
    } else {
	$ja_convert = \&Jcode::convert;
    }
}

# Parse %{sVv}
# ======================================================================

$cvs_info =~ s/ - (New directory|Imported sources)//g;
my ($cvs_module, @cvs_fileinfo) = split(/ /, $cvs_info);

my @cvs_file = my %cvs_rev_old = my %cvs_rev_new = ();
foreach my $cvs_fileinfo (@cvs_fileinfo) {
    my ($file, $rev_old, $rev_new) = split(/,/, $cvs_fileinfo);
    push(@cvs_file, $file);
    $cvs_rev_old{$file} = $rev_old;
    $cvs_rev_new{$file} = $rev_new;
}

# Get CVS username
# ======================================================================

my $cvs_user = $ENV{'CVS_USER'};
$cvs_user = getpwuid($EUID) if (!defined($cvs_user));
$cvs_user = $EUID if (!defined($cvs_user));

# Make mail header
# ======================================================================

my $header = <<EOF_HEADER;
Subject: $cvs_module committed by $cvs_user
X-CVS-LogInfo: $NAME/$VERSION
X-CVS-Root: $cvs_root
X-CVS-User: $cvs_user
EOF_HEADER

$header .= "To: ";
$header .= join(",\n ", @recip) . "\n";
$header .= 'Content-Type: text/plain';
$header .= '; charset=ISO-2022-JP' if ($opt_L eq 'ja');
$header .= "\n";

foreach my $cvs_file (@cvs_file) {
    my $file = "$cvs_module/$cvs_file";
    my $rev_old = $cvs_rev_old{$cvs_file} || '';
    my $rev_new = $cvs_rev_new{$cvs_file} || '';

    if ($rev_old eq 'NONE') {
	$header .= "X-CVS-Added";
    } elsif ($rev_new eq 'NONE') {
	$header .= "X-CVS-Removed";
    } else {
	$header .= "X-CVS-Modified";
    }
    $header .= ": $file $rev_old->$rev_new\n";
}

# Send mail
# ======================================================================

my $fh_sendmail = new IO::File;
my $pid_sendmail = $fh_sendmail->open('|-');
if (!defined($pid_sendmail)) {   # fork failed
    print "Cannot fork child or open pipe: $!\n";
    exit(1);
} elsif ($pid_sendmail == 0) {   # child process
    if (!exec('sendmail', '-t', '-oi')) {
        print "Cannot exec sendmail: $!\n";
        exit(1);
    }
}

# Print header fields and log from cvs command
# ----------------------------------------------------------------------

$fh_sendmail->print($header);
$fh_sendmail->print("\n");
while (defined(my $line = STDIN->getline())) {
    if ($opt_L eq 'ja') {
	&$ja_convert(\$line, 'jis');
    }
    $fh_sendmail->print($line);
}
$fh_sendmail->print("\n");

# Print commitment type and URL for web interface
# ----------------------------------------------------------------------

foreach my $cvs_file (@cvs_file) {
    my $file = "$cvs_module/$cvs_file";
    my $rev_old = $cvs_rev_old{$cvs_file} || '';
    my $rev_new = $cvs_rev_new{$cvs_file} || '';

    $fh_sendmail->print("$file $rev_old -> $rev_new (");
    if ($rev_old eq 'NONE') {
	$fh_sendmail->print('added');
    } elsif ($rev_new eq 'NONE') {
	$fh_sendmail->print('removed');
    } else {
	$fh_sendmail->print('modified');
    }
    $fh_sendmail->print(")\n");
    $fh_sendmail->print("$cvsweb_url/$file");

    if ($rev_old eq 'NONE' || $rev_new eq 'NONE') {
	$fh_sendmail->print("?rev=");
	$fh_sendmail->print($rev_old eq 'NONE' ? $rev_new : $rev_old);
	$fh_sendmail->print('&content-type=text/');
	if ($cvsweb_type eq 'cvsweb') {
	    $fh_sendmail->print('x-cvsweb-markup');
	} else {
	    $fh_sendmail->print('vnd.viewcvs-markup');
	}
	$fh_sendmail->print("\n");
    } else {
	$fh_sendmail->print(".diff?r1=$rev_old&r2=$rev_new\n");
    }
}

# Print diff by rcsdiff
# ----------------------------------------------------------------------

if ($opt_D) {
    exit(0);
}

chdir($cvs_root) || die "Cannot change working directory: $!\n";
foreach my $cvs_file (@cvs_file) {
    my $file = "$cvs_module/$cvs_file,v";
    my $rev_old = $cvs_rev_old{$cvs_file} || '';
    my $rev_new = $cvs_rev_new{$cvs_file} || '';

    next if ($rev_new eq 'NONE' || $rev_old eq 'NONE');

    $fh_sendmail->print("\n");

    my $fh_rcsdiff = new IO::File;
    my $pid_rcsdiff = $fh_rcsdiff->open('-|');
    if (!defined($pid_rcsdiff)) {   # fork failed
	print "Cannot fork child or open pipe: $!\n";
	exit(1);
    } elsif ($pid_rcsdiff == 0) {   # child process
	open(STDERR, '>&STDOUT') || warn "Cannot duplicate stdout: $!\n";
	#if (!exec('rcsdiff', '-u', '-kk', "-r$rev_old", "-r$rev_new", $file)) {
	if (!exec('rcsdiff', '-b', '-u', '-kk', "-r$rev_old", "-r$rev_new", $file)) {
	    print "Cannot exec rcsdiff: $!\n";
	    exit(1);
	}
    }

    while (defined(my $line = $fh_rcsdiff->getline())) {
	if ($opt_L eq 'ja') {
	    &$ja_convert(\$line, 'jis');
	}
	$fh_sendmail->print($line);
    }
    # FIXME: Need close and wait child?
}

# FIXME: Check sendmail exit code.

# Done
# ======================================================================

exit(0);