/[Frey]/branches/zimbardo/lib/Frey/SVN.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /branches/zimbardo/lib/Frey/SVN.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1081 - (hide annotations)
Fri Jun 5 14:02:55 2009 UTC (14 years, 11 months ago) by dpavlin
Original Path: trunk/lib/Frey/SVN.pm
File size: 8216 byte(s)
display every 100 revisions and length of generated file events in xml
1 dpavlin 769 package Frey::SVN;
2     use Moose;
3    
4     # Convert output from svn log to html page (with some formatting of
5     # commit messages)
6     #
7     # 2004-04-28 Dobrica Pavlinusic <dpavlin@rot13.org>
8    
9     extends 'Frey';
10     with 'Frey::Web';
11 dpavlin 1066 with 'Frey::Storage';
12     with 'Frey::HTML::Diff';
13 dpavlin 769
14     use XML::Simple;
15 dpavlin 807 use DateTimeX::Easy;
16 dpavlin 1066 use Text::Diff::Parser;
17 dpavlin 1068 use File::Path qw/mkpath/;
18 dpavlin 769
19     has repository => (
20     is => 'rw',
21     isa => 'Str',
22     required => 1,
23     default => 'file:///home/dpavlin/private/svn/Frey',
24     );
25    
26 dpavlin 987 has path => (
27     is => 'rw',
28     isa => 'Str'
29     );
30    
31 dpavlin 770 has limit => (
32     is => 'rw',
33     isa => 'Int',
34     default => 50,
35     );
36    
37 dpavlin 1066 has include_diff => (
38     is => 'ro',
39     isa => 'Bool',
40 dpavlin 1068 default => 0,
41 dpavlin 1066 );
42    
43 dpavlin 1067 has file_stats => (
44     is => 'ro',
45     isa => 'Bool',
46     default => 1,
47     );
48    
49 dpavlin 804 sub iterator {
50     my ($self,$coderef) = @_;
51    
52 dpavlin 769 sub sh_regex($$) {
53     my ($cmd,$regex) = @_;
54     open(my $sh, $cmd . ' |') || die "sh_regex failed on $cmd: $!";
55     while(my $l = <$sh>) {
56     chomp($l);
57     if ($l =~ $regex) {
58     if ($1 && $2) {
59     return ($1,$2);
60     } elsif ($1) {
61     return $1;
62     } else {
63     return $l;
64     }
65     }
66     }
67     #warn "can't find $regex in output of $cmd\n";
68     return;
69     }
70    
71 dpavlin 987 my $path = $self->repository . $self->path;
72 dpavlin 769 warn "# path $path\n";
73    
74     my $cmd;
75 dpavlin 1066 my $svn_path = $path;
76    
77 dpavlin 769 if ($path =~ m#file://# || -e "$path/.svn") {
78     $cmd = "svn log -v --xml $path";
79     } else {
80 dpavlin 1066 $svn_path = sh_regex('svk info', qr#Mirrored From:\s+([^,]+)#i);
81 dpavlin 769
82     if (! $svn_path) {
83    
84     my $svk_depot = sh_regex('svk info', qr#Depot Path: (/.+)#i);
85    
86     my $depot = $svk_depot;
87     my $rel_path;
88    
89     my $path = sh_regex('svk depot --list', qr/^$depot\s+(\S+)/i);
90    
91     while (! $path && $depot =~ s{^(/.*/)([^/]+)/?$}{$1} ) {
92     $rel_path = "$2/$rel_path";
93     $path = sh_regex('svk depot --list', qr/^$depot\s+(\S+)/i);
94     }
95    
96     die "can't find depot path '$svk_depot' in svk depot --list\n" unless ($path);
97     $svn_path = "file:///$path/$rel_path";
98     }
99    
100     $cmd = "svn log -v --xml $svn_path";
101     }
102    
103 dpavlin 770 $cmd .= " --limit " . $self->limit if $self->limit;
104    
105 dpavlin 769 warn "# $cmd\n";
106     open(my $fh, $cmd .' |') || die "failed $cmd: $!";
107     my $log;
108     while(<$fh>) {
109     $log .= $_;
110     }
111     close($fh);
112    
113 dpavlin 1078 warn "got ", length($log), " bytes of XML changes\n";
114    
115 dpavlin 769 my $xml = XMLin($log, ForceArray => [ 'logentry', 'path' ]);
116    
117 dpavlin 804 foreach my $e (@{$xml->{'logentry'}}) {
118 dpavlin 875 warn "# e = ",$self->dump( $e ) if $self->debug;
119 dpavlin 1066
120 dpavlin 1067 if ( $self->include_diff || $self->file_stats ) {
121 dpavlin 1066 my $rev = $e->{'revision'};
122 dpavlin 1068
123 dpavlin 1081 warn "# revision $rev\n" if $rev % 100 == 0;
124    
125 dpavlin 1068 $e->{diff_paths}->{rev} = $rev; # XXX debug
126    
127 dpavlin 1070 my $cache = $svn_path;
128     $cache =~ s{^\w+:/+}{};
129     $cache = "var/svn/$cache";
130     mkpath $cache unless -e $cache;
131 dpavlin 1078
132     my $diff_path = "$cache/$rev.diff";
133     $e->{diff} = $self->load( $diff_path ) if $self->include_diff && -e $diff_path;
134    
135     my $diff_yaml = "$cache/$rev.yaml";
136    
137     if ( -e $diff_yaml ) {
138     $e->{diff_paths} = $self->load( $diff_yaml );
139     } else {
140 dpavlin 1068 my $cmd = "svn diff -c $rev $svn_path";
141 dpavlin 1070 my ( $diff_fh, $diff_out );
142     my $diff_file = "$cache/$rev.diff";
143    
144     open($diff_fh, '-|', $cmd) || die "can't open pipe from $cmd: $!";
145     open($diff_out,'>' , $diff_file) || die "can't write $diff_file: $!";
146 dpavlin 1078 #warn "# creating $diff_file from $cmd\n";
147 dpavlin 1067
148 dpavlin 1070 my $diff_path;
149 dpavlin 1078 my $changes;
150     my $diff = '';
151 dpavlin 1067
152 dpavlin 1070 while( <$diff_fh> ) {
153 dpavlin 1078 $diff .= $_;
154 dpavlin 1070 print $diff_out $_;
155 dpavlin 1067
156 dpavlin 1070 if ( m{^\+\+\+ (\S+)} ) {
157     $diff_path = "/$1"; # subversion paths start with /
158     } elsif ( m{^\+} && $diff_path ) {
159 dpavlin 1078 $changes->{$diff_path}->{added}++;
160 dpavlin 1070 } elsif ( m{^-} && $diff_path ) {
161 dpavlin 1078 $changes->{$diff_path}->{removed}++;
162 dpavlin 1070 }
163 dpavlin 1067 }
164 dpavlin 1070
165 dpavlin 1078 $e->{diff} = $diff if $self->include_diff;
166    
167     $self->store( "$cache/$rev.yaml", $changes );
168     $e->{diff_paths} = $changes;
169 dpavlin 1067 }
170 dpavlin 1078
171 dpavlin 1066 }
172    
173 dpavlin 804 $coderef->($e);
174     }
175     }
176    
177     sub as_markup {
178     my ($self) = @_;
179    
180     # extract svk revision: r113@athlon (orig r999): dpavlin | 2005-09-01 20:38:07 +0200
181     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*';
182    
183     sub encode {
184     my $foo = shift;
185     $foo =~ s/$svk_rev_re//gsm;
186     $foo =~ s/</&lt;/g;
187     $foo =~ s/>/&gt;/g;
188     $foo =~ s/"/&quot;/g;
189 dpavlin 909 # $foo =~ s/([\n\r][\n\r]+)/$1<br\/>/gis;
190 dpavlin 804 $foo =~ s/([\n\r]+)([\-\*]\s+)/$1<br\/>$2/gis;
191     $foo =~ s/([\n\r]+)(r\d+:\s+)/$1<br\/>$2/gis;
192     $foo =~ s/([\n\r]+)(\s+r\d+@)/$1<br\/>$2/gis; # svk
193     return $foo;
194     }
195    
196 dpavlin 987 my $repository = $self->repository;
197     my $path = $self->path;
198 dpavlin 769
199 dpavlin 987 our $html = qq|
200     <h1><a href="?repository=$repository">$repository</a></h1>
201     <h2>$path</h2>
202     |;
203    
204 dpavlin 852 $self->add_css(qq|
205 dpavlin 909 .commit {
206     clear: both;
207     padding-top: 1em;
208     padding-bottom: 1em;
209     border-top: 1px dashed #ccc;
210     }
211     .files {
212     color: #888;
213     font-family: monospace;
214     font-size: 80%;
215     float: right;
216     padding-bottom: 1.2em; /* fix 80% back to original 1em */
217     }
218 dpavlin 987 .files a {
219     text-decoration: none;
220     color: #888;
221     }
222 dpavlin 852 .date, .revision { color: #666; }
223 dpavlin 909 .message {
224     padding-top: 0.5em;
225     padding-left: 2em; /* like blockquote */
226     white-space: pre-wrap;
227     }
228 dpavlin 852
229     ins { color: #8c8 }
230     del { color: #c88 }
231     |);
232    
233 dpavlin 1013 my $max_path_len = 0;
234     my $path_count;
235 dpavlin 1073 my $stats;
236 dpavlin 1013
237 dpavlin 804 $self->iterator( sub {
238     my $e = shift;
239    
240 dpavlin 769 my $rev = $e->{'revision'};
241     my $date = $e->{'date'};
242    
243     $date =~ s/T/ /;
244     $date =~ s/\.\d+Z$//;
245    
246 dpavlin 852 my $msg = $e->{'msg'};
247     $msg = '' if ref($msg); # FIXME why do I need this, dammit?
248     if ( $msg ) {
249     $msg = encode( $msg );
250     $msg = qq|<div class="message">$msg</div>|;
251     }
252    
253 dpavlin 769 my @files;
254    
255     foreach my $p (@{$e->{'paths'}->{'path'}}) {
256     my ($action,$path) = ($p->{'action'},$p->{'content'});
257    
258     if ($action eq "A") {
259     push @files, "<ins>$path</ins>";
260     } elsif ($action eq "D") {
261     push @files, "<del>$path</del>";
262 dpavlin 851 } else {
263 dpavlin 769 push @files, $path;
264     }
265 dpavlin 1013
266     $max_path_len = length $path if length $path > $max_path_len;
267     $path_count->{$path}++;
268 dpavlin 1073
269     if ( my $added = $e->{diff_paths}->{$path}->{added} ) {
270     $stats->{total_added} += $added;
271     }
272    
273     if ( my $removed = $e->{diff_paths}->{$path}->{removed} ) {
274     $stats->{total_removed} += $removed;
275     }
276 dpavlin 769 }
277    
278 dpavlin 1066 my $diff = $self->html_diff( $e->{diff} ) if $e->{diff};
279    
280 dpavlin 1072 $self->add_css(qq|
281     .diff-lines {
282     margin-left: 1em;
283     float: right;
284     }
285     |);
286 dpavlin 1067
287 dpavlin 909 $html .= qq|
288     <div class="commit">
289 dpavlin 987 <span class="date">$date</span>
290     <em>$e->{author}</em>
291     <span class="revision">$e->{revision}</span>
292     <div class="files">\n
293     |
294     . join("<br>\n",
295     map {
296 dpavlin 1013 my $path = $_;
297     $path =~ s{<[^>]+>}{}g;
298 dpavlin 1072 my $diff = '';
299     if ( $diff = $e->{diff_paths}->{$path} ) {
300     $diff
301     = qq|<span class="diff-lines">|
302     . join(" ",
303     map {
304     my $v = $diff->{$_};
305     s[added][+$v];
306     s[removed][-$v];
307     $_;
308     } keys %$diff
309     )
310     . qq|</span>|
311     ;
312     warn "DIFF $diff";
313     }
314    
315     qq|$diff<a href="?repository=$repository;path=$path" title="$path ##">$_</a>|
316 dpavlin 987 } @files
317     )
318     . qq|
319     </div>
320     $msg
321 dpavlin 1066 $diff
322 dpavlin 909 </div>
323     |;
324 dpavlin 769
325 dpavlin 804 });
326 dpavlin 769
327 dpavlin 1073 $max_path_len +=
328     length( $stats->{total_added} )
329     + length( $stats->{total_removed} )
330     ;
331    
332     $max_path_len += int( $max_path_len / 10 ); # we are using ex, so we add 10%
333    
334 dpavlin 1013 $self->add_css(qq|
335     .files {
336     width: ${max_path_len}ex;
337     }
338     |);
339    
340     $html =~ s[title="(\S+) ##"]['title="' . $path_count->{$1} . '"']gse;
341    
342 dpavlin 1073 $html .= $self->dump( 'stats', $stats );
343    
344 dpavlin 769 return $html;
345     }
346    
347 dpavlin 805 sub codeswarm_as_markup {
348     my ($self) = @_;
349    
350     $self->content_type('text/xml');
351    
352     my $file_events = '';
353    
354     $self->iterator( sub {
355     my $e = shift;
356    
357     my $rev = $e->{'revision'};
358 dpavlin 807 my $date = DateTimeX::Easy->new( $e->{'date'} )->epoch . '000'; # ms
359 dpavlin 805 my $author = $e->{'author'};
360    
361     foreach my $p (@{$e->{'paths'}->{'path'}}) {
362     my ($action,$path) = ($p->{'action'},$p->{'content'});
363 dpavlin 1067 my $weight = '';
364 dpavlin 1068 if ( my $s = $e->{diff_paths}->{$path} ) {
365 dpavlin 1077 $weight = $s->{removed} || 0;
366     $weight += $s->{added} * 2 if $s->{added};
367 dpavlin 1067 $weight = qq| weight="$weight" |;
368     }
369     $file_events .= qq|\t<event filename="$path" date="$date" author="$author"$weight/>\n|;
370 dpavlin 805 }
371    
372     });
373    
374 dpavlin 1081 warn "generated ",length($file_events)," bytes of file events\n";
375    
376 dpavlin 805 return qq|<?xml version="1.0"?>
377     <!-- One commit per day for one month by a documenter and programmer. -->
378     <file_events>
379     $file_events
380     </file_events>
381     |;
382    
383     }
384    
385 dpavlin 769 1;

  ViewVC Help
Powered by ViewVC 1.1.26