--- trunk/lib/Frey/SVN.pm 2008/12/09 20:31:31 769 +++ trunk/lib/Frey/SVN.pm 2009/06/04 19:23:32 1078 @@ -8,9 +8,13 @@ extends 'Frey'; with 'Frey::Web'; -#with 'Frey::Storage'; +with 'Frey::Storage'; +with 'Frey::HTML::Diff'; use XML::Simple; +use DateTimeX::Easy; +use Text::Diff::Parser; +use File::Path qw/mkpath/; has repository => ( is => 'rw', @@ -19,25 +23,32 @@ default => 'file:///home/dpavlin/private/svn/Frey', ); -sub as_markup { - my ($self) = @_; +has path => ( + is => 'rw', + isa => 'Str' +); - # 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*'; +has limit => ( + is => 'rw', + isa => 'Int', + default => 50, +); - sub encode { - my $foo = shift; - $foo =~ s/$svk_rev_re//gsm; - $foo =~ s/</g; - $foo =~ s/>/>/g; - $foo =~ s/"/"/g; - $foo =~ s/([\n\r][\n\r]+)/<\/p>$1
/gis;
- $foo =~ s/([\n\r]+)([\-\*]\s+)/$1
$2/gis;
- $foo =~ s/([\n\r]+)(r\d+:\s+)/$1
$2/gis;
- $foo =~ s/([\n\r]+)(\s+r\d+@)/$1
$2/gis; # svk
- return $foo;
- }
+has include_diff => (
+ is => 'ro',
+ isa => 'Bool',
+ default => 0,
+);
+has file_stats => (
+ is => 'ro',
+ isa => 'Bool',
+ default => 1,
+);
+
+sub iterator {
+ my ($self,$coderef) = @_;
+
sub sh_regex($$) {
my ($cmd,$regex) = @_;
open(my $sh, $cmd . ' |') || die "sh_regex failed on $cmd: $!";
@@ -57,14 +68,16 @@
return;
}
- my $path = $self->repository;
+ my $path = $self->repository . $self->path;
warn "# path $path\n";
my $cmd;
+ my $svn_path = $path;
+
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);
+ $svn_path = sh_regex('svk info', qr#Mirrored From:\s+([^,]+)#i);
if (! $svn_path) {
@@ -87,6 +100,8 @@
$cmd = "svn log -v --xml $svn_path";
}
+ $cmd .= " --limit " . $self->limit if $self->limit;
+
warn "# $cmd\n";
open(my $fh, $cmd .' |') || die "failed $cmd: $!";
my $log;
@@ -95,21 +110,143 @@
}
close($fh);
+ warn "got ", length($log), " bytes of XML changes\n";
+
my $xml = XMLin($log, ForceArray => [ 'logentry', 'path' ]);
- our $html = '';
- sub html {
- $html .= join("\n", @_);
+ foreach my $e (@{$xml->{'logentry'}}) {
+ warn "# e = ",$self->dump( $e ) if $self->debug;
+
+ if ( $self->include_diff || $self->file_stats ) {
+ my $rev = $e->{'revision'};
+
+ $e->{diff_paths}->{rev} = $rev; # XXX debug
+
+ my $cache = $svn_path;
+ $cache =~ s{^\w+:/+}{};
+ $cache = "var/svn/$cache";
+ mkpath $cache unless -e $cache;
+
+ my $diff_path = "$cache/$rev.diff";
+ $e->{diff} = $self->load( $diff_path ) if $self->include_diff && -e $diff_path;
+
+ my $diff_yaml = "$cache/$rev.yaml";
+
+ if ( -e $diff_yaml ) {
+ $e->{diff_paths} = $self->load( $diff_yaml );
+ } else {
+ my $cmd = "svn diff -c $rev $svn_path";
+ my ( $diff_fh, $diff_out );
+ my $diff_file = "$cache/$rev.diff";
+
+ open($diff_fh, '-|', $cmd) || die "can't open pipe from $cmd: $!";
+ open($diff_out,'>' , $diff_file) || die "can't write $diff_file: $!";
+ #warn "# creating $diff_file from $cmd\n";
+
+ my $diff_path;
+ my $changes;
+ my $diff = '';
+
+ while( <$diff_fh> ) {
+ $diff .= $_;
+ print $diff_out $_;
+
+ if ( m{^\+\+\+ (\S+)} ) {
+ $diff_path = "/$1"; # subversion paths start with /
+ } elsif ( m{^\+} && $diff_path ) {
+ $changes->{$diff_path}->{added}++;
+ } elsif ( m{^-} && $diff_path ) {
+ $changes->{$diff_path}->{removed}++;
+ }
+ }
+
+ $e->{diff} = $diff if $self->include_diff;
+
+ $self->store( "$cache/$rev.yaml", $changes );
+ $e->{diff_paths} = $changes;
+ }
+
+ }
+
+ $coderef->($e);
}
+}
+
+sub as_markup {
+ my ($self) = @_;
+
+ # extract svk revision: r113@athlon (orig r999): dpavlin | 2005-09-01 20:38:07 +0200
+ our $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/</g;
+ $foo =~ s/>/>/g;
+ $foo =~ s/"/"/g;
+# $foo =~ s/([\n\r][\n\r]+)/$1
/gis;
+ $foo =~ s/([\n\r]+)([\-\*]\s+)/$1
$2/gis;
+ $foo =~ s/([\n\r]+)(r\d+:\s+)/$1
$2/gis;
+ $foo =~ s/([\n\r]+)(\s+r\d+@)/$1
$2/gis; # svk
+ return $foo;
+ }
+
+ my $repository = $self->repository;
+ my $path = $self->path;
+
+ our $html = qq|
+
'.$date.' ',$e->{'author'},' r',$e->{'revision'},'
'; + my $msg = $e->{'msg'}; + $msg = '' if ref($msg); # FIXME why do I need this, dammit? + if ( $msg ) { + $msg = encode( $msg ); + $msg = qq| |; + } my @files; @@ -120,16 +257,125 @@ push @files, "$path"; } elsif ($action eq "D") { push @files, "'; + my $diff = $self->html_diff( $e->{diff} ) if $e->{diff}; - } + $self->add_css(qq| + .diff-lines { + margin-left: 1em; + float: right; + } + |); + + $html .= qq| +',join(", ",@files),': ',encode($e->{'msg'}),'