]>
Commit | Line | Data |
---|---|---|
c65e8987 RA |
1 | #!/usr/bin/perl |
2 | # Copyright 2006, Ryan Anderson <ryan@michonline.com> | |
3 | # | |
4 | # GPL v2 (See COPYING) | |
5 | # | |
6 | # This file is licensed under the GPL v2, or a later version | |
7 | # at the discretion of Linus Torvalds. | |
8 | ||
9 | use warnings; | |
10 | use strict; | |
87475f4d | 11 | use Getopt::Long; |
4788d11a | 12 | use POSIX qw(strftime gmtime); |
c65e8987 | 13 | |
4788d11a | 14 | sub usage() { |
87475f4d RA |
15 | print STDERR 'Usage: ${\basename $0} [-s] [-S revs-file] file [ revision ] |
16 | -l, --long | |
17 | Show long rev (Defaults off) | |
18 | -r, --rename | |
19 | Follow renames (Defaults on). | |
20 | -S, --rev-file revs-file | |
21 | use revs from revs-file instead of calling git-rev-list | |
22 | -h, --help | |
23 | This message. | |
4788d11a JS |
24 | '; |
25 | ||
26 | exit(1); | |
27 | } | |
c65e8987 | 28 | |
87475f4d RA |
29 | our ($help, $longrev, $rename, $starting_rev, $rev_file) = (0, 0, 1); |
30 | ||
31 | my $rc = GetOptions( "long|l" => \$longrev, | |
32 | "help|h" => \$help, | |
33 | "rename|r" => \$rename, | |
00931549 | 34 | "rev-file|S=s" => \$rev_file); |
87475f4d RA |
35 | if (!$rc or $help) { |
36 | usage(); | |
37 | } | |
4788d11a JS |
38 | |
39 | my $filename = shift @ARGV; | |
87475f4d RA |
40 | if (@ARGV) { |
41 | $starting_rev = shift @ARGV; | |
42 | } | |
c65e8987 RA |
43 | |
44 | my @stack = ( | |
45 | { | |
87475f4d | 46 | 'rev' => defined $starting_rev ? $starting_rev : "HEAD", |
c65e8987 RA |
47 | 'filename' => $filename, |
48 | }, | |
49 | ); | |
50 | ||
c65e8987 | 51 | our @filelines = (); |
c65e8987 | 52 | |
87475f4d RA |
53 | if (defined $starting_rev) { |
54 | @filelines = git_cat_file($starting_rev, $filename); | |
55 | } else { | |
56 | open(F,"<",$filename) | |
57 | or die "Failed to open filename: $!"; | |
58 | ||
59 | while(<F>) { | |
60 | chomp; | |
61 | push @filelines, $_; | |
62 | } | |
63 | close(F); | |
64 | ||
c65e8987 | 65 | } |
87475f4d | 66 | |
c65e8987 RA |
67 | our %revs; |
68 | our @revqueue; | |
69 | our $head; | |
70 | ||
71 | my $revsprocessed = 0; | |
72 | while (my $bound = pop @stack) { | |
73 | my @revisions = git_rev_list($bound->{'rev'}, $bound->{'filename'}); | |
74 | foreach my $revinst (@revisions) { | |
75 | my ($rev, @parents) = @$revinst; | |
76 | $head ||= $rev; | |
77 | ||
4788d11a JS |
78 | if (!defined($rev)) { |
79 | $rev = ""; | |
80 | } | |
c65e8987 RA |
81 | $revs{$rev}{'filename'} = $bound->{'filename'}; |
82 | if (scalar @parents > 0) { | |
83 | $revs{$rev}{'parents'} = \@parents; | |
84 | next; | |
85 | } | |
86 | ||
87475f4d | 87 | if (!$rename) { |
4788d11a JS |
88 | next; |
89 | } | |
90 | ||
c65e8987 RA |
91 | my $newbound = find_parent_renames($rev, $bound->{'filename'}); |
92 | if ( exists $newbound->{'filename'} && $newbound->{'filename'} ne $bound->{'filename'}) { | |
93 | push @stack, $newbound; | |
94 | $revs{$rev}{'parents'} = [$newbound->{'rev'}]; | |
95 | } | |
96 | } | |
97 | } | |
98 | push @revqueue, $head; | |
87475f4d RA |
99 | init_claim( defined $starting_rev ? $starting_rev : 'dirty'); |
100 | unless (defined $starting_rev) { | |
6b3e21d6 | 101 | my $diff = open_pipe("git","diff","-R", "HEAD", "--",$filename) |
87475f4d RA |
102 | or die "Failed to call git diff to check for dirty state: $!"; |
103 | ||
6b3e21d6 | 104 | _git_diff_parse($diff, $head, "dirty", ( |
87475f4d RA |
105 | 'author' => gitvar_name("GIT_AUTHOR_IDENT"), |
106 | 'author_date' => sprintf("%s +0000",time()), | |
107 | ) | |
108 | ); | |
6b3e21d6 | 109 | close($diff); |
87475f4d | 110 | } |
c65e8987 RA |
111 | handle_rev(); |
112 | ||
113 | ||
114 | my $i = 0; | |
115 | foreach my $l (@filelines) { | |
116 | my ($output, $rev, $committer, $date); | |
117 | if (ref $l eq 'ARRAY') { | |
118 | ($output, $rev, $committer, $date) = @$l; | |
87475f4d | 119 | if (!$longrev && length($rev) > 8) { |
c65e8987 RA |
120 | $rev = substr($rev,0,8); |
121 | } | |
122 | } else { | |
123 | $output = $l; | |
124 | ($rev, $committer, $date) = ('unknown', 'unknown', 'unknown'); | |
125 | } | |
126 | ||
4788d11a JS |
127 | printf("%s\t(%10s\t%10s\t%d)%s\n", $rev, $committer, |
128 | format_date($date), $i++, $output); | |
c65e8987 RA |
129 | } |
130 | ||
131 | sub init_claim { | |
132 | my ($rev) = @_; | |
c65e8987 RA |
133 | for (my $i = 0; $i < @filelines; $i++) { |
134 | $filelines[$i] = [ $filelines[$i], '', '', '', 1]; | |
135 | # line, | |
136 | # rev, | |
137 | # author, | |
138 | # date, | |
139 | # 1 <-- belongs to the original file. | |
140 | } | |
141 | $revs{$rev}{'lines'} = \@filelines; | |
142 | } | |
143 | ||
144 | ||
145 | sub handle_rev { | |
146 | my $i = 0; | |
87475f4d | 147 | my %seen; |
c65e8987 | 148 | while (my $rev = shift @revqueue) { |
87475f4d | 149 | next if $seen{$rev}++; |
c65e8987 RA |
150 | |
151 | my %revinfo = git_commit_info($rev); | |
152 | ||
153 | foreach my $p (@{$revs{$rev}{'parents'}}) { | |
154 | ||
155 | git_diff_parse($p, $rev, %revinfo); | |
156 | push @revqueue, $p; | |
157 | } | |
158 | ||
159 | ||
160 | if (scalar @{$revs{$rev}{parents}} == 0) { | |
161 | # We must be at the initial rev here, so claim everything that is left. | |
162 | for (my $i = 0; $i < @{$revs{$rev}{lines}}; $i++) { | |
163 | if (ref ${$revs{$rev}{lines}}[$i] eq '' || ${$revs{$rev}{lines}}[$i][1] eq '') { | |
164 | claim_line($i, $rev, $revs{$rev}{lines}, %revinfo); | |
165 | } | |
166 | } | |
167 | } | |
168 | } | |
169 | } | |
170 | ||
171 | ||
172 | sub git_rev_list { | |
173 | my ($rev, $file) = @_; | |
174 | ||
6b3e21d6 | 175 | my $revlist; |
87475f4d | 176 | if ($rev_file) { |
00931549 ML |
177 | open($revlist, '<' . $rev_file) |
178 | or die "Failed to open $rev_file : $!"; | |
4788d11a | 179 | } else { |
6b3e21d6 | 180 | $revlist = open_pipe("git-rev-list","--parents","--remove-empty",$rev,"--",$file) |
4788d11a JS |
181 | or die "Failed to exec git-rev-list: $!"; |
182 | } | |
c65e8987 RA |
183 | |
184 | my @revs; | |
6b3e21d6 | 185 | while(my $line = <$revlist>) { |
c65e8987 RA |
186 | chomp $line; |
187 | my ($rev, @parents) = split /\s+/, $line; | |
188 | push @revs, [ $rev, @parents ]; | |
189 | } | |
6b3e21d6 | 190 | close($revlist); |
c65e8987 RA |
191 | |
192 | printf("0 revs found for rev %s (%s)\n", $rev, $file) if (@revs == 0); | |
193 | return @revs; | |
194 | } | |
195 | ||
196 | sub find_parent_renames { | |
197 | my ($rev, $file) = @_; | |
198 | ||
6b3e21d6 | 199 | my $patch = open_pipe("git-diff-tree", "-M50", "-r","--name-status", "-z","$rev") |
c65e8987 RA |
200 | or die "Failed to exec git-diff: $!"; |
201 | ||
202 | local $/ = "\0"; | |
203 | my %bound; | |
6b3e21d6 RA |
204 | my $junk = <$patch>; |
205 | while (my $change = <$patch>) { | |
c65e8987 | 206 | chomp $change; |
6b3e21d6 | 207 | my $filename = <$patch>; |
c65e8987 RA |
208 | chomp $filename; |
209 | ||
210 | if ($change =~ m/^[AMD]$/ ) { | |
211 | next; | |
212 | } elsif ($change =~ m/^R/ ) { | |
213 | my $oldfilename = $filename; | |
6b3e21d6 | 214 | $filename = <$patch>; |
c65e8987 RA |
215 | chomp $filename; |
216 | if ( $file eq $filename ) { | |
217 | my $parent = git_find_parent($rev, $oldfilename); | |
218 | @bound{'rev','filename'} = ($parent, $oldfilename); | |
219 | last; | |
220 | } | |
221 | } | |
222 | } | |
6b3e21d6 | 223 | close($patch); |
c65e8987 RA |
224 | |
225 | return \%bound; | |
226 | } | |
227 | ||
228 | ||
229 | sub git_find_parent { | |
230 | my ($rev, $filename) = @_; | |
231 | ||
6b3e21d6 | 232 | my $revparent = open_pipe("git-rev-list","--remove-empty", "--parents","--max-count=1","$rev","--",$filename) |
c65e8987 RA |
233 | or die "Failed to open git-rev-list to find a single parent: $!"; |
234 | ||
6b3e21d6 | 235 | my $parentline = <$revparent>; |
c65e8987 RA |
236 | chomp $parentline; |
237 | my ($revfound,$parent) = split m/\s+/, $parentline; | |
238 | ||
6b3e21d6 | 239 | close($revparent); |
c65e8987 RA |
240 | |
241 | return $parent; | |
242 | } | |
243 | ||
244 | ||
245 | # Get a diff between the current revision and a parent. | |
246 | # Record the commit information that results. | |
247 | sub git_diff_parse { | |
248 | my ($parent, $rev, %revinfo) = @_; | |
249 | ||
6b3e21d6 | 250 | my $diff = open_pipe("git-diff-tree","-M","-p",$rev,$parent,"--", |
c65e8987 RA |
251 | $revs{$rev}{'filename'}, $revs{$parent}{'filename'}) |
252 | or die "Failed to call git-diff for annotation: $!"; | |
253 | ||
6b3e21d6 | 254 | _git_diff_parse($diff, $parent, $rev, %revinfo); |
87475f4d | 255 | |
6b3e21d6 | 256 | close($diff); |
87475f4d RA |
257 | } |
258 | ||
259 | sub _git_diff_parse { | |
260 | my ($diff, $parent, $rev, %revinfo) = @_; | |
261 | ||
262 | my ($ri, $pi) = (0,0); | |
c65e8987 RA |
263 | my $slines = $revs{$rev}{'lines'}; |
264 | my @plines; | |
265 | ||
266 | my $gotheader = 0; | |
87475f4d RA |
267 | my ($remstart); |
268 | my ($hunk_start, $hunk_index); | |
6b3e21d6 | 269 | while(<$diff>) { |
c65e8987 RA |
270 | chomp; |
271 | if (m/^@@ -(\d+),(\d+) \+(\d+),(\d+)/) { | |
87475f4d | 272 | $remstart = $1; |
c65e8987 RA |
273 | # Adjust for 0-based arrays |
274 | $remstart--; | |
c65e8987 RA |
275 | # Reinit hunk tracking. |
276 | $hunk_start = $remstart; | |
277 | $hunk_index = 0; | |
278 | $gotheader = 1; | |
279 | ||
280 | for (my $i = $ri; $i < $remstart; $i++) { | |
281 | $plines[$pi++] = $slines->[$i]; | |
282 | $ri++; | |
283 | } | |
284 | next; | |
285 | } elsif (!$gotheader) { | |
286 | next; | |
287 | } | |
288 | ||
289 | if (m/^\+(.*)$/) { | |
290 | my $line = $1; | |
291 | $plines[$pi++] = [ $line, '', '', '', 0 ]; | |
292 | next; | |
293 | ||
294 | } elsif (m/^-(.*)$/) { | |
295 | my $line = $1; | |
296 | if (get_line($slines, $ri) eq $line) { | |
297 | # Found a match, claim | |
298 | claim_line($ri, $rev, $slines, %revinfo); | |
299 | } else { | |
300 | die sprintf("Sync error: %d/%d\n|%s\n|%s\n%s => %s\n", | |
301 | $ri, $hunk_start + $hunk_index, | |
302 | $line, | |
303 | get_line($slines, $ri), | |
304 | $rev, $parent); | |
305 | } | |
306 | $ri++; | |
307 | ||
e5971d7d RA |
308 | } elsif (m/^\\/) { |
309 | ; | |
310 | # Skip \No newline at end of file. | |
311 | # But this can be internationalized, so only look | |
312 | # for an initial \ | |
313 | ||
c65e8987 RA |
314 | } else { |
315 | if (substr($_,1) ne get_line($slines,$ri) ) { | |
316 | die sprintf("Line %d (%d) does not match:\n|%s\n|%s\n%s => %s\n", | |
317 | $hunk_start + $hunk_index, $ri, | |
318 | substr($_,1), | |
319 | get_line($slines,$ri), | |
320 | $rev, $parent); | |
321 | } | |
322 | $plines[$pi++] = $slines->[$ri++]; | |
323 | } | |
324 | $hunk_index++; | |
325 | } | |
c65e8987 RA |
326 | for (my $i = $ri; $i < @{$slines} ; $i++) { |
327 | push @plines, $slines->[$ri++]; | |
328 | } | |
329 | ||
330 | $revs{$parent}{lines} = \@plines; | |
331 | return; | |
332 | } | |
333 | ||
334 | sub get_line { | |
335 | my ($lines, $index) = @_; | |
336 | ||
337 | return ref $lines->[$index] ne '' ? $lines->[$index][0] : $lines->[$index]; | |
338 | } | |
339 | ||
340 | sub git_cat_file { | |
87475f4d RA |
341 | my ($rev, $filename) = @_; |
342 | return () unless defined $rev && defined $filename; | |
c65e8987 | 343 | |
87475f4d RA |
344 | my $blob = git_ls_tree($rev, $filename); |
345 | ||
6b3e21d6 | 346 | my $catfile = open_pipe("git","cat-file", "blob", $blob) |
87475f4d | 347 | or die "Failed to git-cat-file blob $blob (rev $rev, file $filename): " . $!; |
c65e8987 RA |
348 | |
349 | my @lines; | |
6b3e21d6 | 350 | while(<$catfile>) { |
c65e8987 RA |
351 | chomp; |
352 | push @lines, $_; | |
353 | } | |
6b3e21d6 | 354 | close($catfile); |
c65e8987 RA |
355 | |
356 | return @lines; | |
357 | } | |
358 | ||
87475f4d RA |
359 | sub git_ls_tree { |
360 | my ($rev, $filename) = @_; | |
361 | ||
6b3e21d6 | 362 | my $lstree = open_pipe("git","ls-tree",$rev,$filename) |
87475f4d RA |
363 | or die "Failed to call git ls-tree: $!"; |
364 | ||
365 | my ($mode, $type, $blob, $tfilename); | |
6b3e21d6 | 366 | while(<$lstree>) { |
87475f4d RA |
367 | ($mode, $type, $blob, $tfilename) = split(/\s+/, $_, 4); |
368 | last if ($tfilename eq $filename); | |
369 | } | |
6b3e21d6 | 370 | close($lstree); |
87475f4d RA |
371 | |
372 | return $blob if $filename eq $filename; | |
373 | die "git-ls-tree failed to find blob for $filename"; | |
374 | ||
375 | } | |
376 | ||
377 | ||
c65e8987 RA |
378 | |
379 | sub claim_line { | |
380 | my ($floffset, $rev, $lines, %revinfo) = @_; | |
381 | my $oline = get_line($lines, $floffset); | |
382 | @{$lines->[$floffset]} = ( $oline, $rev, | |
383 | $revinfo{'author'}, $revinfo{'author_date'} ); | |
384 | #printf("Claiming line %d with rev %s: '%s'\n", | |
385 | # $floffset, $rev, $oline) if 1; | |
386 | } | |
387 | ||
388 | sub git_commit_info { | |
389 | my ($rev) = @_; | |
6b3e21d6 | 390 | my $commit = open_pipe("git-cat-file", "commit", $rev) |
c65e8987 RA |
391 | or die "Failed to call git-cat-file: $!"; |
392 | ||
393 | my %info; | |
6b3e21d6 | 394 | while(<$commit>) { |
c65e8987 RA |
395 | chomp; |
396 | last if (length $_ == 0); | |
397 | ||
398 | if (m/^author (.*) <(.*)> (.*)$/) { | |
399 | $info{'author'} = $1; | |
400 | $info{'author_email'} = $2; | |
401 | $info{'author_date'} = $3; | |
402 | } elsif (m/^committer (.*) <(.*)> (.*)$/) { | |
403 | $info{'committer'} = $1; | |
404 | $info{'committer_email'} = $2; | |
405 | $info{'committer_date'} = $3; | |
406 | } | |
407 | } | |
6b3e21d6 | 408 | close($commit); |
c65e8987 RA |
409 | |
410 | return %info; | |
411 | } | |
4788d11a JS |
412 | |
413 | sub format_date { | |
414 | my ($timestamp, $timezone) = split(' ', $_[0]); | |
415 | ||
416 | return strftime("%Y-%m-%d %H:%M:%S " . $timezone, gmtime($timestamp)); | |
417 | } | |
418 | ||
87475f4d RA |
419 | # Copied from git-send-email.perl - We need a Git.pm module.. |
420 | sub gitvar { | |
421 | my ($var) = @_; | |
422 | my $fh; | |
423 | my $pid = open($fh, '-|'); | |
424 | die "$!" unless defined $pid; | |
425 | if (!$pid) { | |
426 | exec('git-var', $var) or die "$!"; | |
427 | } | |
428 | my ($val) = <$fh>; | |
429 | close $fh or die "$!"; | |
430 | chomp($val); | |
431 | return $val; | |
432 | } | |
433 | ||
434 | sub gitvar_name { | |
435 | my ($name) = @_; | |
436 | my $val = gitvar($name); | |
437 | my @field = split(/\s+/, $val); | |
438 | return join(' ', @field[0...(@field-4)]); | |
439 | } | |
440 | ||
6b3e21d6 | 441 | sub open_pipe { |
f60d4691 RA |
442 | if ($^O eq '##INSERT_ACTIVESTATE_STRING_HERE##') { |
443 | return open_pipe_activestate(@_); | |
444 | } else { | |
445 | return open_pipe_normal(@_); | |
446 | } | |
447 | } | |
448 | ||
449 | sub open_pipe_activestate { | |
450 | tie *fh, "Git::ActiveStatePipe", @_; | |
451 | return *fh; | |
452 | } | |
453 | ||
454 | sub open_pipe_normal { | |
6b3e21d6 RA |
455 | my (@execlist) = @_; |
456 | ||
457 | my $pid = open my $kid, "-|"; | |
458 | defined $pid or die "Cannot fork: $!"; | |
459 | ||
460 | unless ($pid) { | |
461 | exec @execlist; | |
462 | die "Cannot exec @execlist: $!"; | |
463 | } | |
464 | ||
465 | return $kid; | |
466 | } | |
f60d4691 RA |
467 | |
468 | package Git::ActiveStatePipe; | |
469 | use strict; | |
470 | ||
471 | sub TIEHANDLE { | |
472 | my ($class, @params) = @_; | |
473 | my $cmdline = join " ", @params; | |
474 | my @data = qx{$cmdline}; | |
475 | bless { i => 0, data => \@data }, $class; | |
476 | } | |
477 | ||
478 | sub READLINE { | |
479 | my $self = shift; | |
480 | if ($self->{i} >= scalar @{$self->{data}}) { | |
481 | return undef; | |
482 | } | |
483 | return $self->{'data'}->[ $self->{i}++ ]; | |
484 | } | |
485 | ||
486 | sub CLOSE { | |
487 | my $self = shift; | |
488 | delete $self->{data}; | |
489 | delete $self->{i}; | |
490 | } | |
491 | ||
492 | sub EOF { | |
493 | my $self = shift; | |
494 | return ($self->{i} >= scalar @{$self->{data}}); | |
495 | } |