#!/usr/bin/perl -w

# Script intended to be run by svn's post-commit hook
# 
# Updates a TWiki page with log information from commits,
# similar to svn's commit-email script except with TWiki
#
# syntax:
#   ./commit-twiki.pl [options] <repository> <rev> <web> <topic>
#   
# ex:
#   ./commit-twiki.pl -m clinicalsultan /usr/local/svn 301 Main ClinicalSultan
#
# IMPORTANT:
#   For this script to work, the topic file in twiki/data
#   must be writable to the person commiting stuff.
#
# This script should probably live where the other subversion
# hook scripts live (/usr/lib/subversion/hook-scripts/).

use strict;
use lib '/home/www/html/twiki/lib';
use Data::Dumper;
use POSIX qw(strftime);
use TWiki;
use TWiki::Store::RcsWrap;  # for saveTopicText

use vars qw($startTag $endTag $syntax $svnlook $repos $rev 
            $regex $append $web $topicName $dry $limit $replace
            $aliasFile %aliases);

# Configuration:
#   This script will prepend log information by default just after the 
#   $startTag in a TWiki page, so make sure $startTag is unique enough 
#   so that it doesn't appear anywhere unintended.  If you specify
#   the -a tag, log entries will be appended just before the $endTag
#   instead.
#   
my $startTag  = "<!-- svn log start -->\n";
my $endTag    = "<!-- svn log end -->";
my $syntax    = <<EOF
syntax:
  commit-twiki.pl [options] <repository> <rev> <web> <topic>
  
  options:
    -m <regex>  only display files that match
    -n <num>    only show the last num log entries
    -l <file>   use an aliases file to convert usernames
    -a          append instead of prepend
    -d          dry run

  notes:
    here's what an aliases file should look like:
      stephej1 => JeremyStephens
      dupontct => CharlesDupont

EOF
;
my $svnlook   = "/usr/bin/svnlook";

# grab the arguments
$append  = 0;    # prepend by default
$dry     = 0;
$limit   = 0;
$replace = 0;
$aliasFile = "";

while (@ARGV) {
    my $arg = shift @ARGV;
    if ($arg =~ /^-/) {
        if ($arg eq '-m') {
            my $value = shift @ARGV;
            die "$0: -m requires a regular expression." if (! defined $value);

            $regex = $value;
        }
        elsif ($arg eq '-a') {
            $append = 1;
        }
        elsif ($arg eq '-d') {
            $dry = 1;
        }
        elsif ($arg eq '-n') {
            my $value = shift @ARGV;
            die "$0: -n requires a number." if (! defined $value);
            $limit = $value;
            $replace = 1;
        }
        elsif ($arg eq '-l') {
            my $value = shift @ARGV;
            die "$0: -l requires a filename." if (! defined $value);
            die "$0: $value doesn't exists."  if (! -e $value);
            $aliasFile = $value;
        }
        else {
            die "$0: command line option `$arg' is not recognized.\n";
        }
    }
    else {
        if (! defined $repos) {
            $repos = $arg;
        }
        elsif (! defined $rev) {
            $rev = $arg;
        }
        elsif (! defined $web) {
            $web = $arg;
        }
        elsif (! defined $topicName) {
            $topicName = $arg;
        }
        else {
            # here is where other arguments might go, but for now, this shouldn't happen
            warn "$0: ignored argument: $arg";
        }
    }
}
if (!defined $repos || !defined $rev || !defined $web || !defined $topicName) {
    die "syntax error: missing arguments\n$syntax\n";
}

if ($aliasFile ne "") {
    open(ALIAS, "< $aliasFile");
    while (my $line = <ALIAS>) {
        $line =~ /^\s*([a-zA-Z0-9_]+)\s*=>\s*(.+)\s*$/;
        $aliases{$1} = $2;
    }
    close(ALIAS);
}

my @svnInfos;
$limit = 1      if ($limit == 0);
for (my $i = 0; $i < $limit && ($rev-$i) > 0; $i++) {
    my $info = getInfo($svnlook, $repos, $rev-$i, $regex);
    push(@svnInfos, $info)    if ($info ne "");
    $limit++    if ($info eq "");
}

# get text
my $svnInfo = join("\n\n", @svnInfos);
$svnInfo =  TWiki::Render::decodeSpecialChars( $svnInfo );
$svnInfo =~ s/ {3}/\t/go;

# update TWiki page, only if there's a match
if ($dry) {
    # print out what I would have done
    print "I would have replaced the log in $web.$topicName to this:\n\n"   if ($replace);
    print "I would have added this to $web.$topicName:\n\n"                 unless ($replace);
    print $svnInfo;
}
else {
    # prepend info to TWiki page
    my $topicText = TWiki::Func::readTopicText( $web, $topicName );

    # should I append or prepend or replace?
    if ($replace) {
        # replace it!
        my $before = $topicText;
        $topicText =~ s/$startTag.*$endTag/$startTag$svnInfo$endTag/s;
        if ($before eq $topicText) {
            print "===== Nothing changed! =====\n";
            print $topicText."\n";
        }
    }
    elsif ($append) {
        # put the log info at the end of the current log
        $topicText =~ s/$endTag/$svnInfo$endTag/;
    }
    else {
        # put the log info at the beginning of the current log
        $topicText =~ s/$startTag/$startTag$svnInfo/;
    }

    $TWiki::userName = "SubversionUser";
    TWiki::Func::saveTopicText( $web, $topicName, $topicText, "0", "0" );

    # unlock the topic
    TWiki::Store::lockTopicNew( $web, $topicName, 1 );
}


sub getInfo {
    my ($svnlook, $repos, $rev, $regex) = @_;
    
    # grab info from svnlook; shamelessly ganked from commit-email.pl (mostly)
    my @svnlooklines = &read_from_process($svnlook, 'info', $repos, '-r', $rev);
    
    # get alias if available
    my $author = shift(@svnlooklines);
    $author = $aliases{$author}       if (defined %aliases && exists $aliases{$author});
    
    my $date = shift @svnlooklines;
    
    shift @svnlooklines;
    my @log = map { "$_\n" } @svnlooklines;
    my $logtext = join( "", @log );
    
    # 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);
        }
    }
    
    # format adds/mods/dels
    my @changes;
    push(@changes, "\%GREEN\% A \%ENDCOLOR\% $_")  foreach (@adds);
    push(@changes, "\%BLUE\% M \%ENDCOLOR\% $_")  foreach (@mods);
    push(@changes, "\%RED\% D \%ENDCOLOR\% $_")  foreach (@dels);
    
    # grep out matching files
    @changes = grep(/$regex/, @changes)     if (defined $regex);

    return ""   if (scalar(@changes) == 0);

    my $svnInfo = <<EOF
<div style="border-bottom: 1px dotted black; display: inline"><b>r$rev</b> [$date] by <i> $author </i></div><br>
<div style="padding-left: 15px">
<b><span style="color: navy">Log</span></b>
<div style="padding-left: 25px">
<noautolink>
$logtext
</noautolink>
</div>
<b><span style="color: red">Files</span></b>
EOF
;
    $svnInfo .= "\t* $_\n"  foreach (@changes);
    $svnInfo .= "</div>\n";

    return $svnInfo;
}

###
# functions I snagged from svn's commit-email script
### 
sub safe_read_from_pipe
{
    unless (@_)
    {
        warn "$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 (@_)
    {
        warn "$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;
    }
}

##