use strict;
use Carp;
use Getopt::Long;
my $sendmail = "/usr/sbin/sendmail";
my $svnlook = "/usr/bin/svnlook";
my $logfile = '';
my $hostname = '';
my $reply_to = '';
my $subject_prefix = '';
GetOptions('hostname=s' => \$hostname,
'logfile=s' => \$logfile,
'reply_to=s' => \$reply_to,
'subject=s' => \$subject_prefix)
or &usage;
&usage("$0: too few arguments") unless @ARGV > 2;
my $repos = shift @ARGV;
my @temp = split "/", $repos;
my $repos_name = $temp[3];
my $rev = shift @ARGV;
my @email_addrs = @ARGV;
my $tmp_dir = '/tmp';
chdir($tmp_dir)
or die "$0: cannot chdir `$tmp_dir': $!\n";
my @svnlooklines = &read_from_process($svnlook, 'info', '-r', $rev, $repos);
my $author = shift @svnlooklines;
my $date = shift @svnlooklines;
shift @svnlooklines;
my @log = map { "$_\n" } @svnlooklines;
my @dirschanged = &read_from_process($svnlook, 'dirs-changed', '-r', $rev, $repos);
my $rootchanged = 0;
grep
{
$rootchanged = 1 if ($_ eq '/');
$_ =~ s/(.+)[\/\\]$/$1/;
}
@dirschanged;
@svnlooklines = &read_from_process($svnlook, 'changed', '-r', $rev, $repos);
my @adds = ();
my @dels = ();
my @mods = ();
foreach my $line (@svnlooklines)
{
my $path = '';
my $code = '';
if ($line =~ /^(.). (.*)$/)
{
$code = $1;
$path = $2;
}
if ($code eq 'A') {
push (@adds, " $path\n");
}
elsif ($code eq 'D') {
push (@dels, " $path\n");
}
else {
push (@mods, " $path\n");
}
}
my @difflines = &read_from_process($svnlook, 'diff', '-r', $rev, $repos);
my @commonpieces = ();
my $commondir = '';
if (($rootchanged == 0) and (scalar @commonpieces > 1))
{
my $firstline = shift (@dirschanged);
push (@commonpieces, split ('/', $firstline));
foreach my $line (@dirschanged)
{
my @pieces = ();
my $i = 0;
push (@pieces, split ('/', $line));
while (($i < scalar @pieces) and ($i < scalar @commonpieces))
{
if ($pieces[$i] ne $commonpieces[$i])
{
splice (@commonpieces, $i, (scalar @commonpieces - $i));
last;
}
$i++;
}
}
unshift (@dirschanged, $firstline);
if (scalar @commonpieces)
{
$commondir = join ('/', @commonpieces);
grep
{
s/^$commondir\/(.*)/$1/eg;
}
@dirschanged;
}
}
my $dirlist = join (' ', @dirschanged);
my $userlist = join (' ', @email_addrs);
my $subject = '';
if ($commondir ne '')
{
$subject = "rev $rev - in $commondir: $dirlist";
}
else
{
$subject = "$author r$rev\@$repos_name - $dirlist";
}
if ($subject_prefix =~ /\w/)
{
$subject = "$subject_prefix $subject";
}
my $mail_from = $author;
if ($hostname =~ /\w/)
{
$mail_from = "$mail_from\@$hostname";
}
my @output;
push (@output, "To: $userlist\n");
push (@output, "From: $mail_from\n");
push (@output, "Subject: $subject\n");
push (@output, "Reply-to: $reply_to\n") if $reply_to;
push (@output, "\n");
push (@output, "Author: <b>$author</b>\n");
push (@output, "Date: <b>$date</b>\n");
push (@output, "Repos: <b>$repos</b>\n");
push (@output, "New Revision: <b>$rev</b>\n");
push (@output, "\n");
push (@output, "###################################\n");
push (@output, "Log:\n");
push (@output, @log);
push (@output, "\n");
push (@output, "\n###################################\n");
if (scalar @adds)
{
@adds = sort @adds;
push (@output, "Added:\n");
push (@output, @adds);
}
if (scalar @dels)
{
@dels = sort @dels;
push (@output, "Removed:\n");
push (@output, @dels);
}
if (scalar @mods)
{
@mods = sort @mods;
push (@output, "Modified:\n");
push (@output, @mods);
}
push (@output, "\n###################################\n");
push (@output, map { "$_\n" } @difflines);
if ($logfile =~ /\w/)
{
open (LOGFILE, ">> $logfile")
or die ("Error opening '$logfile' for append");
print LOGFILE @output;
close LOGFILE;
}
if (($sendmail =~ /\w/) and ($userlist =~ /\w/))
{
open (SENDMAIL, "| $sendmail $userlist")
or die ("Error opening a pipe to sendmail");
print SENDMAIL @output;
close SENDMAIL;
}
exit 0;
sub usage {
warn "@_\n" if @_;
die "usage: $0 [options] REPOS REVNUM email_address1 [email_address2 ... ]]\n",
"options are\n",
" -h hostname Hostname to append to author for 'From:'\n",
" -l logfile File to which mail contents should be appended\n",
" -r email_address Set email Reply-To header to this email address\n",
" -s subject_prefix Subject line prefix\n";
}
sub safe_read_from_pipe {
unless (@_) {
croak "$0: safe_read_from_pipe passed no arguments.\n";
}
print "Running @_\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>) {
chomp;
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;
}
}
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;
}
}