Repository List / perl / trunk / svn2html.pl @ HEAD

#!/usr/bin/perl -w

# Convert output from svn log to html page (with some formatting of
# commit messages)
#
# 2004-04-28 Dobrica Pavlinusic <dpavlin@rot13.org>

use strict;
use XML::Simple;

my $path = shift || '.';

# extract svk revision: r113@athlon (orig r999): dpavlin | 2005-09-01 20:38:07 +0200
my $svk_rev_re = '\s+(r\d+@\w+(\s+\(orig\s+r\d+\))*:\s+\w+\s+\|\s+\d{4}-\d{2}-\d{2}\s+\d{2}:\d{2}:\d{2}\s+\+\d+)\s*';


sub encode {
	my $foo = shift;
	$foo =~ s/$svk_rev_re//gsm;
	$foo =~ s/</&lt;/g;
	$foo =~ s/>/&gt;/g;
	$foo =~ s/"/&quot;/g;
	$foo =~ s/([\n\r][\n\r]+)/<\/p>$1<p>/gis;
	$foo =~ s/([\n\r]+)([\-\*]\s+)/$1<br\/>$2/gis;
	$foo =~ s/([\n\r]+)(r\d+:\s+)/$1<br\/>$2/gis;
	$foo =~ s/([\n\r]+)(\s+r\d+@)/$1<br\/>$2/gis;		# svk
	return $foo;
}

sub sh_regex($$) {
	my ($cmd,$regex) = @_;
	open(my $sh, $cmd . ' |') || die "sh_regex failed on $cmd: $!";
	while(my $l = <$sh>) {
		chomp($l);
		if ($l =~ $regex) {
			if ($1 && $2) {
				return ($1,$2);
			} elsif ($1) {
				return $1;
			} else {
				return $l;
			}
		}
	}
	#warn "can't find $regex in output of $cmd\n";
	return;
}

my $cmd;
if ($path =~ m#file://# || -e "$path/.svn") {
	$cmd = "svn log -v --xml $path";
} else {
	my $svn_path = sh_regex('svk info', qr#Mirrored From:\s+([^,]+)#i);

	if (! $svn_path) {

		my $svk_depot = sh_regex('svk info', qr#Depot Path: (/.+)#i);

		my $depot = $svk_depot;
		my $rel_path;

		my $path = sh_regex('svk depot --list', qr/^$depot\s+(\S+)/i);

		while (! $path && $depot =~ s!^(/.*/)([^/]+)/?$!$1! ) {
			$rel_path = "$2/$rel_path";
			$path = sh_regex('svk depot --list', qr/^$depot\s+(\S+)/i);
		}

		die "can't find depot path '$svk_depot' in svk depot --list\n" unless ($path);
		$svn_path = "file:///$path/$rel_path";
	}

	$cmd = "svn log -v --xml $svn_path";
}

warn "# $cmd\n";
open(my $fh, $cmd .' |') || die "failed $cmd: $!";
my $log;
while(<$fh>) {
	$log .= $_;
}
close($fh);

my $xml = XMLin($log, ForceArray => [ 'logentry', 'path' ]);

foreach my $e (@{$xml->{'logentry'}}) {
	my $rev = $e->{'revision'};
	my $date = $e->{'date'};

	$date =~ s/T/ /;
	$date =~ s/\.\d+Z$//;

	print '<p><tt>'.$date.'</tt> <em>',$e->{'author'},'</em> <tt style="color:#808080">r',$e->{'revision'},'</tt></p>';

	my @files;

	foreach my $p (@{$e->{'paths'}->{'path'}}) {
		my ($action,$path) = ($p->{'action'},$p->{'content'});

		if ($action eq "A") {
			push @files, "<ins>$path</ins>";
		} elsif ($action eq "D") {
			push @files, "<del>$path</del>";
		} else{
			push @files, $path;
		}
	}

	print '<blockquote><p><tt style="color:#808080">',join(", ",@files),':</tt> ',encode($e->{'msg'}),'</p></blockquote>';

}