--- 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/([\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/([\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| +

$repository

+

$path

+ |; + + $self->add_css(qq| + .commit { + clear: both; + padding-top: 1em; + padding-bottom: 1em; + border-top: 1px dashed #ccc; + } + .files { + color: #888; + font-family: monospace; + font-size: 80%; + float: right; + padding-bottom: 1.2em; /* fix 80% back to original 1em */ + } + .files a { + text-decoration: none; + color: #888; + } + .date, .revision { color: #666; } + .message { + padding-top: 0.5em; + padding-left: 2em; /* like blockquote */ + white-space: pre-wrap; + } + + ins { color: #8c8 } + del { color: #c88 } + |); + + my $max_path_len = 0; + my $path_count; + my $stats; + + $self->iterator( sub { + my $e = shift; - foreach my $e (@{$xml->{'logentry'}}) { my $rev = $e->{'revision'}; my $date = $e->{'date'}; $date =~ s/T/ /; $date =~ s/\.\d+Z$//; - html '

'.$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|
$msg
|; + } my @files; @@ -120,16 +257,125 @@ push @files, "$path"; } elsif ($action eq "D") { push @files, "$path"; - } else{ + } else { push @files, $path; } + + $max_path_len = length $path if length $path > $max_path_len; + $path_count->{$path}++; + + if ( my $added = $e->{diff_paths}->{$path}->{added} ) { + $stats->{total_added} += $added; + } + + if ( my $removed = $e->{diff_paths}->{$path}->{removed} ) { + $stats->{total_removed} += $removed; + } } - html '

',join(", ",@files),': ',encode($e->{'msg'}),'

'; + my $diff = $self->html_diff( $e->{diff} ) if $e->{diff}; - } + $self->add_css(qq| + .diff-lines { + margin-left: 1em; + float: right; + } + |); + + $html .= qq| +
+ $date + $e->{author} + $e->{revision} +
\n + | + . join("
\n", + map { + my $path = $_; + $path =~ s{<[^>]+>}{}g; + my $diff = ''; + if ( $diff = $e->{diff_paths}->{$path} ) { + $diff + = qq|| + . join(" ", + map { + my $v = $diff->{$_}; + s[added][+$v]; + s[removed][-$v]; + $_; + } keys %$diff + ) + . qq|| + ; + warn "DIFF $diff"; + } + + qq|$diff$_| + } @files + ) + . qq| +
+ $msg + $diff +
+ |; + + }); + + $max_path_len += + length( $stats->{total_added} ) + + length( $stats->{total_removed} ) + ; + + $max_path_len += int( $max_path_len / 10 ); # we are using ex, so we add 10% + + $self->add_css(qq| + .files { + width: ${max_path_len}ex; + } + |); + + $html =~ s[title="(\S+) ##"]['title="' . $path_count->{$1} . '"']gse; + + $html .= $self->dump( 'stats', $stats ); return $html; } +sub codeswarm_as_markup { + my ($self) = @_; + + $self->content_type('text/xml'); + + my $file_events = ''; + + $self->iterator( sub { + my $e = shift; + + my $rev = $e->{'revision'}; + my $date = DateTimeX::Easy->new( $e->{'date'} )->epoch . '000'; # ms + my $author = $e->{'author'}; + + foreach my $p (@{$e->{'paths'}->{'path'}}) { + my ($action,$path) = ($p->{'action'},$p->{'content'}); + my $weight = ''; + if ( my $s = $e->{diff_paths}->{$path} ) { + $weight = $s->{removed} || 0; + $weight += $s->{added} * 2 if $s->{added}; + $weight = qq| weight="$weight" |; + } + $file_events .= qq|\t\n|; + } + + }); + + return qq| + + + $file_events + + |; + +} + 1;