]>
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); |
fe77bb1a | 13 | use File::Basename qw(basename dirname); |
c65e8987 | 14 | |
4788d11a | 15 | sub usage() { |
fe77bb1a | 16 | print STDERR "Usage: ${\basename $0} [-s] [-S revs-file] file [ revision ] |
87475f4d RA |
17 | -l, --long |
18 | Show long rev (Defaults off) | |
d920e18f JH |
19 | -t, --time |
20 | Show raw timestamp (Defaults off) | |
87475f4d RA |
21 | -r, --rename |
22 | Follow renames (Defaults on). | |
23 | -S, --rev-file revs-file | |
be767c91 | 24 | Use revs from revs-file instead of calling git-rev-list |
87475f4d RA |
25 | -h, --help |
26 | This message. | |
fe77bb1a | 27 | "; |
4788d11a JS |
28 | |
29 | exit(1); | |
30 | } | |
c65e8987 | 31 | |
d920e18f | 32 | our ($help, $longrev, $rename, $rawtime, $starting_rev, $rev_file) = (0, 0, 1); |
87475f4d RA |
33 | |
34 | my $rc = GetOptions( "long|l" => \$longrev, | |
d920e18f | 35 | "time|t" => \$rawtime, |
87475f4d RA |
36 | "help|h" => \$help, |
37 | "rename|r" => \$rename, | |
00931549 | 38 | "rev-file|S=s" => \$rev_file); |
fe77bb1a | 39 | if (!$rc or $help or !@ARGV) { |
87475f4d RA |
40 | usage(); |
41 | } | |
4788d11a JS |
42 | |
43 | my $filename = shift @ARGV; | |
87475f4d RA |
44 | if (@ARGV) { |
45 | $starting_rev = shift @ARGV; | |
46 | } | |
c65e8987 RA |
47 | |
48 | my @stack = ( | |
49 | { | |
87475f4d | 50 | 'rev' => defined $starting_rev ? $starting_rev : "HEAD", |
c65e8987 RA |
51 | 'filename' => $filename, |
52 | }, | |
53 | ); | |
54 | ||
c65e8987 | 55 | our @filelines = (); |
c65e8987 | 56 | |
87475f4d RA |
57 | if (defined $starting_rev) { |
58 | @filelines = git_cat_file($starting_rev, $filename); | |
59 | } else { | |
60 | open(F,"<",$filename) | |
61 | or die "Failed to open filename: $!"; | |
62 | ||
63 | while(<F>) { | |
64 | chomp; | |
65 | push @filelines, $_; | |
66 | } | |
67 | close(F); | |
68 | ||
c65e8987 | 69 | } |
87475f4d | 70 | |
c65e8987 RA |
71 | our %revs; |
72 | our @revqueue; | |
73 | our $head; | |
74 | ||
75 | my $revsprocessed = 0; | |
76 | while (my $bound = pop @stack) { | |
77 | my @revisions = git_rev_list($bound->{'rev'}, $bound->{'filename'}); | |
78 | foreach my $revinst (@revisions) { | |
79 | my ($rev, @parents) = @$revinst; | |
80 | $head ||= $rev; | |
81 | ||
4788d11a JS |
82 | if (!defined($rev)) { |
83 | $rev = ""; | |
84 | } | |
c65e8987 RA |
85 | $revs{$rev}{'filename'} = $bound->{'filename'}; |
86 | if (scalar @parents > 0) { | |
87 | $revs{$rev}{'parents'} = \@parents; | |
88 | next; | |
89 | } | |
90 | ||
87475f4d | 91 | if (!$rename) { |
4788d11a JS |
92 | next; |
93 | } | |
94 | ||
c65e8987 RA |
95 | my $newbound = find_parent_renames($rev, $bound->{'filename'}); |
96 | if ( exists $newbound->{'filename'} && $newbound->{'filename'} ne $bound->{'filename'}) { | |
97 | push @stack, $newbound; | |
98 | $revs{$rev}{'parents'} = [$newbound->{'rev'}]; | |
99 | } | |
100 | } | |
101 | } | |
102 | push @revqueue, $head; | |
5fcab3d7 | 103 | init_claim( defined $starting_rev ? $head : 'dirty'); |
87475f4d | 104 | unless (defined $starting_rev) { |
3f492ba1 | 105 | my $diff = open_pipe("git","diff","HEAD", "--",$filename) |
87475f4d RA |
106 | or die "Failed to call git diff to check for dirty state: $!"; |
107 | ||
3f492ba1 | 108 | _git_diff_parse($diff, [$head], "dirty", ( |
87475f4d RA |
109 | 'author' => gitvar_name("GIT_AUTHOR_IDENT"), |
110 | 'author_date' => sprintf("%s +0000",time()), | |
111 | ) | |
112 | ); | |
6b3e21d6 | 113 | close($diff); |
87475f4d | 114 | } |
c65e8987 RA |
115 | handle_rev(); |
116 | ||
117 | ||
118 | my $i = 0; | |
119 | foreach my $l (@filelines) { | |
120 | my ($output, $rev, $committer, $date); | |
121 | if (ref $l eq 'ARRAY') { | |
122 | ($output, $rev, $committer, $date) = @$l; | |
87475f4d | 123 | if (!$longrev && length($rev) > 8) { |
c65e8987 RA |
124 | $rev = substr($rev,0,8); |
125 | } | |
126 | } else { | |
127 | $output = $l; | |
128 | ($rev, $committer, $date) = ('unknown', 'unknown', 'unknown'); | |
129 | } | |
130 | ||
4788d11a | 131 | printf("%s\t(%10s\t%10s\t%d)%s\n", $rev, $committer, |
c6d4217e | 132 | format_date($date), ++$i, $output); |
c65e8987 RA |
133 | } |
134 | ||
135 | sub init_claim { | |
136 | my ($rev) = @_; | |
c65e8987 RA |
137 | for (my $i = 0; $i < @filelines; $i++) { |
138 | $filelines[$i] = [ $filelines[$i], '', '', '', 1]; | |
139 | # line, | |
140 | # rev, | |
141 | # author, | |
142 | # date, | |
143 | # 1 <-- belongs to the original file. | |
144 | } | |
145 | $revs{$rev}{'lines'} = \@filelines; | |
146 | } | |
147 | ||
148 | ||
149 | sub handle_rev { | |
7c49cb28 | 150 | my $revseen = 0; |
87475f4d | 151 | my %seen; |
c65e8987 | 152 | while (my $rev = shift @revqueue) { |
87475f4d | 153 | next if $seen{$rev}++; |
c65e8987 RA |
154 | |
155 | my %revinfo = git_commit_info($rev); | |
156 | ||
3f492ba1 RA |
157 | if (exists $revs{$rev}{parents} && |
158 | scalar @{$revs{$rev}{parents}} != 0) { | |
c65e8987 | 159 | |
3f492ba1 RA |
160 | git_diff_parse($revs{$rev}{'parents'}, $rev, %revinfo); |
161 | push @revqueue, @{$revs{$rev}{'parents'}}; | |
c65e8987 | 162 | |
3f492ba1 | 163 | } else { |
c65e8987 RA |
164 | # We must be at the initial rev here, so claim everything that is left. |
165 | for (my $i = 0; $i < @{$revs{$rev}{lines}}; $i++) { | |
166 | if (ref ${$revs{$rev}{lines}}[$i] eq '' || ${$revs{$rev}{lines}}[$i][1] eq '') { | |
167 | claim_line($i, $rev, $revs{$rev}{lines}, %revinfo); | |
168 | } | |
169 | } | |
170 | } | |
171 | } | |
172 | } | |
173 | ||
174 | ||
175 | sub git_rev_list { | |
176 | my ($rev, $file) = @_; | |
177 | ||
6b3e21d6 | 178 | my $revlist; |
87475f4d | 179 | if ($rev_file) { |
00931549 ML |
180 | open($revlist, '<' . $rev_file) |
181 | or die "Failed to open $rev_file : $!"; | |
4788d11a | 182 | } else { |
6b3e21d6 | 183 | $revlist = open_pipe("git-rev-list","--parents","--remove-empty",$rev,"--",$file) |
4788d11a JS |
184 | or die "Failed to exec git-rev-list: $!"; |
185 | } | |
c65e8987 RA |
186 | |
187 | my @revs; | |
6b3e21d6 | 188 | while(my $line = <$revlist>) { |
c65e8987 RA |
189 | chomp $line; |
190 | my ($rev, @parents) = split /\s+/, $line; | |
191 | push @revs, [ $rev, @parents ]; | |
192 | } | |
6b3e21d6 | 193 | close($revlist); |
c65e8987 RA |
194 | |
195 | printf("0 revs found for rev %s (%s)\n", $rev, $file) if (@revs == 0); | |
196 | return @revs; | |
197 | } | |
198 | ||
199 | sub find_parent_renames { | |
200 | my ($rev, $file) = @_; | |
201 | ||
6b3e21d6 | 202 | my $patch = open_pipe("git-diff-tree", "-M50", "-r","--name-status", "-z","$rev") |
c65e8987 RA |
203 | or die "Failed to exec git-diff: $!"; |
204 | ||
205 | local $/ = "\0"; | |
206 | my %bound; | |
6b3e21d6 RA |
207 | my $junk = <$patch>; |
208 | while (my $change = <$patch>) { | |
c65e8987 | 209 | chomp $change; |
6b3e21d6 | 210 | my $filename = <$patch>; |
d0ad1653 MK |
211 | if (!defined $filename) { |
212 | next; | |
213 | } | |
c65e8987 RA |
214 | chomp $filename; |
215 | ||
216 | if ($change =~ m/^[AMD]$/ ) { | |
217 | next; | |
218 | } elsif ($change =~ m/^R/ ) { | |
219 | my $oldfilename = $filename; | |
6b3e21d6 | 220 | $filename = <$patch>; |
c65e8987 RA |
221 | chomp $filename; |
222 | if ( $file eq $filename ) { | |
223 | my $parent = git_find_parent($rev, $oldfilename); | |
224 | @bound{'rev','filename'} = ($parent, $oldfilename); | |
225 | last; | |
226 | } | |
227 | } | |
228 | } | |
6b3e21d6 | 229 | close($patch); |
c65e8987 RA |
230 | |
231 | return \%bound; | |
232 | } | |
233 | ||
234 | ||
235 | sub git_find_parent { | |
236 | my ($rev, $filename) = @_; | |
237 | ||
6b3e21d6 | 238 | my $revparent = open_pipe("git-rev-list","--remove-empty", "--parents","--max-count=1","$rev","--",$filename) |
c65e8987 RA |
239 | or die "Failed to open git-rev-list to find a single parent: $!"; |
240 | ||
6b3e21d6 | 241 | my $parentline = <$revparent>; |
c65e8987 RA |
242 | chomp $parentline; |
243 | my ($revfound,$parent) = split m/\s+/, $parentline; | |
244 | ||
6b3e21d6 | 245 | close($revparent); |
c65e8987 RA |
246 | |
247 | return $parent; | |
248 | } | |
249 | ||
7c49cb28 RA |
250 | sub git_find_all_parents { |
251 | my ($rev) = @_; | |
252 | ||
253 | my $revparent = open_pipe("git-rev-list","--remove-empty", "--parents","--max-count=1","$rev") | |
254 | or die "Failed to open git-rev-list to find a single parent: $!"; | |
255 | ||
256 | my $parentline = <$revparent>; | |
257 | chomp $parentline; | |
258 | my ($origrev, @parents) = split m/\s+/, $parentline; | |
259 | ||
260 | close($revparent); | |
261 | ||
262 | return @parents; | |
263 | } | |
264 | ||
265 | sub git_merge_base { | |
266 | my ($rev1, $rev2) = @_; | |
267 | ||
268 | my $mb = open_pipe("git-merge-base", $rev1, $rev2) | |
269 | or die "Failed to open git-merge-base: $!"; | |
270 | ||
271 | my $base = <$mb>; | |
272 | chomp $base; | |
273 | ||
274 | close($mb); | |
275 | ||
276 | return $base; | |
277 | } | |
278 | ||
279 | # Construct a set of pseudo parents that are in the same order, | |
280 | # and the same quantity as the real parents, | |
281 | # but whose SHA1s are as similar to the logical parents | |
282 | # as possible. | |
283 | sub get_pseudo_parents { | |
284 | my ($all, $fake) = @_; | |
285 | ||
286 | my @all = @$all; | |
287 | my @fake = @$fake; | |
288 | ||
289 | my @pseudo; | |
290 | ||
291 | my %fake = map {$_ => 1} @fake; | |
292 | my %seenfake; | |
293 | ||
294 | my $fakeidx = 0; | |
295 | foreach my $p (@all) { | |
296 | if (exists $fake{$p}) { | |
297 | if ($fake[$fakeidx] ne $p) { | |
298 | die sprintf("parent mismatch: %s != %s\nall:%s\nfake:%s\n", | |
299 | $fake[$fakeidx], $p, | |
300 | join(", ", @all), | |
301 | join(", ", @fake), | |
302 | ); | |
303 | } | |
304 | ||
305 | push @pseudo, $p; | |
306 | $fakeidx++; | |
307 | $seenfake{$p}++; | |
308 | ||
309 | } else { | |
310 | my $base = git_merge_base($fake[$fakeidx], $p); | |
311 | if ($base ne $fake[$fakeidx]) { | |
312 | die sprintf("Result of merge-base doesn't match fake: %s,%s != %s\n", | |
313 | $fake[$fakeidx], $p, $base); | |
314 | } | |
315 | ||
316 | # The details of how we parse the diffs | |
317 | # mean that we cannot have a duplicate | |
318 | # revision in the list, so if we've already | |
319 | # seen the revision we would normally add, just use | |
320 | # the actual revision. | |
321 | if ($seenfake{$base}) { | |
322 | push @pseudo, $p; | |
323 | } else { | |
324 | push @pseudo, $base; | |
325 | $seenfake{$base}++; | |
326 | } | |
327 | } | |
328 | } | |
329 | ||
330 | return @pseudo; | |
331 | } | |
332 | ||
c65e8987 RA |
333 | |
334 | # Get a diff between the current revision and a parent. | |
335 | # Record the commit information that results. | |
336 | sub git_diff_parse { | |
3f492ba1 | 337 | my ($parents, $rev, %revinfo) = @_; |
c65e8987 | 338 | |
7c49cb28 RA |
339 | my @pseudo_parents; |
340 | my @command = ("git-diff-tree"); | |
341 | my $revision_spec; | |
342 | ||
343 | if (scalar @$parents == 1) { | |
344 | ||
345 | $revision_spec = join("..", $parents->[0], $rev); | |
346 | @pseudo_parents = @$parents; | |
347 | } else { | |
348 | my @all_parents = git_find_all_parents($rev); | |
349 | ||
350 | if (@all_parents != @$parents) { | |
351 | @pseudo_parents = get_pseudo_parents(\@all_parents, $parents); | |
352 | } else { | |
353 | @pseudo_parents = @$parents; | |
354 | } | |
355 | ||
356 | $revision_spec = $rev; | |
357 | push @command, "-c"; | |
358 | } | |
359 | ||
3f492ba1 | 360 | my @filenames = ( $revs{$rev}{'filename'} ); |
7c49cb28 | 361 | |
3f492ba1 RA |
362 | foreach my $parent (@$parents) { |
363 | push @filenames, $revs{$parent}{'filename'}; | |
364 | } | |
365 | ||
7c49cb28 RA |
366 | push @command, "-p", "-M", $revision_spec, "--", @filenames; |
367 | ||
368 | ||
369 | my $diff = open_pipe( @command ) | |
c65e8987 RA |
370 | or die "Failed to call git-diff for annotation: $!"; |
371 | ||
7c49cb28 | 372 | _git_diff_parse($diff, \@pseudo_parents, $rev, %revinfo); |
87475f4d | 373 | |
6b3e21d6 | 374 | close($diff); |
87475f4d RA |
375 | } |
376 | ||
377 | sub _git_diff_parse { | |
3f492ba1 RA |
378 | my ($diff, $parents, $rev, %revinfo) = @_; |
379 | ||
380 | my $ri = 0; | |
87475f4d | 381 | |
c65e8987 | 382 | my $slines = $revs{$rev}{'lines'}; |
3f492ba1 | 383 | my (%plines, %pi); |
c65e8987 RA |
384 | |
385 | my $gotheader = 0; | |
87475f4d | 386 | my ($remstart); |
3f492ba1 RA |
387 | my $parent_count = @$parents; |
388 | ||
389 | my $diff_header_regexp = "^@"; | |
390 | $diff_header_regexp .= "@" x @$parents; | |
391 | $diff_header_regexp .= ' -\d+,\d+' x @$parents; | |
392 | $diff_header_regexp .= ' \+(\d+),\d+'; | |
7c49cb28 | 393 | $diff_header_regexp .= " " . ("@" x @$parents); |
3f492ba1 RA |
394 | |
395 | my %claim_regexps; | |
396 | my $allparentplus = '^' . '\\+' x @$parents . '(.*)$'; | |
397 | ||
398 | { | |
399 | my $i = 0; | |
400 | foreach my $parent (@$parents) { | |
401 | ||
402 | $pi{$parent} = 0; | |
403 | my $r = '^' . '.' x @$parents . '(.*)$'; | |
404 | my $p = $r; | |
405 | substr($p,$i+1, 1) = '\\+'; | |
406 | ||
407 | my $m = $r; | |
408 | substr($m,$i+1, 1) = '-'; | |
409 | ||
410 | $claim_regexps{$parent}{plus} = $p; | |
411 | $claim_regexps{$parent}{minus} = $m; | |
412 | ||
413 | $plines{$parent} = []; | |
414 | ||
415 | $i++; | |
416 | } | |
417 | } | |
418 | ||
419 | DIFF: | |
6b3e21d6 | 420 | while(<$diff>) { |
c65e8987 | 421 | chomp; |
7c49cb28 | 422 | #printf("%d:%s:\n", $gotheader, $_); |
3f492ba1 RA |
423 | if (m/$diff_header_regexp/) { |
424 | $remstart = $1 - 1; | |
425 | # (0-based arrays) | |
426 | ||
c65e8987 RA |
427 | $gotheader = 1; |
428 | ||
3f492ba1 RA |
429 | foreach my $parent (@$parents) { |
430 | for (my $i = $ri; $i < $remstart; $i++) { | |
431 | $plines{$parent}[$pi{$parent}++] = $slines->[$i]; | |
432 | } | |
c65e8987 | 433 | } |
3f492ba1 | 434 | $ri = $remstart; |
c65e8987 | 435 | |
3f492ba1 | 436 | next DIFF; |
c65e8987 | 437 | |
3f492ba1 RA |
438 | } elsif (!$gotheader) { |
439 | # Skip over the leadin. | |
440 | next DIFF; | |
441 | } | |
c65e8987 | 442 | |
3f492ba1 | 443 | if (m/^\\/) { |
e5971d7d RA |
444 | ; |
445 | # Skip \No newline at end of file. | |
446 | # But this can be internationalized, so only look | |
447 | # for an initial \ | |
448 | ||
c65e8987 | 449 | } else { |
3f492ba1 RA |
450 | my %claims = (); |
451 | my $negclaim = 0; | |
452 | my $allclaimed = 0; | |
453 | my $line; | |
454 | ||
455 | if (m/$allparentplus/) { | |
456 | claim_line($ri, $rev, $slines, %revinfo); | |
457 | $allclaimed = 1; | |
458 | ||
459 | } | |
460 | ||
461 | PARENT: | |
462 | foreach my $parent (keys %claim_regexps) { | |
463 | my $m = $claim_regexps{$parent}{minus}; | |
464 | my $p = $claim_regexps{$parent}{plus}; | |
465 | ||
466 | if (m/$m/) { | |
467 | $line = $1; | |
468 | $plines{$parent}[$pi{$parent}++] = [ $line, '', '', '', 0 ]; | |
469 | $negclaim++; | |
470 | ||
471 | } elsif (m/$p/) { | |
472 | $line = $1; | |
473 | if (get_line($slines, $ri) eq $line) { | |
474 | # Found a match, claim | |
475 | $claims{$parent}++; | |
476 | ||
477 | } else { | |
478 | die sprintf("Sync error: %d\n|%s\n|%s\n%s => %s\n", | |
479 | $ri, $line, | |
480 | get_line($slines, $ri), | |
481 | $rev, $parent); | |
482 | } | |
483 | } | |
484 | } | |
485 | ||
486 | if (%claims) { | |
487 | foreach my $parent (@$parents) { | |
488 | next if $claims{$parent} || $allclaimed; | |
489 | $plines{$parent}[$pi{$parent}++] = $slines->[$ri]; | |
490 | #[ $line, '', '', '', 0 ]; | |
491 | } | |
492 | $ri++; | |
493 | ||
494 | } elsif ($negclaim) { | |
495 | next DIFF; | |
496 | ||
497 | } else { | |
498 | if (substr($_,scalar @$parents) ne get_line($slines,$ri) ) { | |
499 | foreach my $parent (@$parents) { | |
500 | printf("parent %s is on line %d\n", $parent, $pi{$parent}); | |
501 | } | |
502 | ||
7c49cb28 RA |
503 | my @context; |
504 | for (my $i = -2; $i < 2; $i++) { | |
505 | push @context, get_line($slines, $ri + $i); | |
506 | } | |
507 | my $context = join("\n", @context); | |
508 | ||
509 | my $justline = substr($_, scalar @$parents); | |
3f492ba1 RA |
510 | die sprintf("Line %d, does not match:\n|%s|\n|%s|\n%s\n", |
511 | $ri, | |
7c49cb28 RA |
512 | $justline, |
513 | $context); | |
3f492ba1 RA |
514 | } |
515 | foreach my $parent (@$parents) { | |
516 | $plines{$parent}[$pi{$parent}++] = $slines->[$ri]; | |
517 | } | |
518 | $ri++; | |
c65e8987 | 519 | } |
c65e8987 | 520 | } |
c65e8987 | 521 | } |
3f492ba1 | 522 | |
c65e8987 | 523 | for (my $i = $ri; $i < @{$slines} ; $i++) { |
3f492ba1 RA |
524 | foreach my $parent (@$parents) { |
525 | push @{$plines{$parent}}, $slines->[$ri]; | |
526 | } | |
527 | $ri++; | |
528 | } | |
529 | ||
530 | foreach my $parent (@$parents) { | |
531 | $revs{$parent}{lines} = $plines{$parent}; | |
c65e8987 RA |
532 | } |
533 | ||
c65e8987 RA |
534 | return; |
535 | } | |
536 | ||
537 | sub get_line { | |
538 | my ($lines, $index) = @_; | |
539 | ||
540 | return ref $lines->[$index] ne '' ? $lines->[$index][0] : $lines->[$index]; | |
541 | } | |
542 | ||
543 | sub git_cat_file { | |
87475f4d RA |
544 | my ($rev, $filename) = @_; |
545 | return () unless defined $rev && defined $filename; | |
c65e8987 | 546 | |
87475f4d | 547 | my $blob = git_ls_tree($rev, $filename); |
5fcab3d7 | 548 | die "Failed to find a blob for $filename in rev $rev\n" if !defined $blob; |
87475f4d | 549 | |
6b3e21d6 | 550 | my $catfile = open_pipe("git","cat-file", "blob", $blob) |
87475f4d | 551 | or die "Failed to git-cat-file blob $blob (rev $rev, file $filename): " . $!; |
c65e8987 RA |
552 | |
553 | my @lines; | |
6b3e21d6 | 554 | while(<$catfile>) { |
c65e8987 RA |
555 | chomp; |
556 | push @lines, $_; | |
557 | } | |
6b3e21d6 | 558 | close($catfile); |
c65e8987 RA |
559 | |
560 | return @lines; | |
561 | } | |
562 | ||
87475f4d RA |
563 | sub git_ls_tree { |
564 | my ($rev, $filename) = @_; | |
565 | ||
6b3e21d6 | 566 | my $lstree = open_pipe("git","ls-tree",$rev,$filename) |
87475f4d RA |
567 | or die "Failed to call git ls-tree: $!"; |
568 | ||
569 | my ($mode, $type, $blob, $tfilename); | |
6b3e21d6 | 570 | while(<$lstree>) { |
5fcab3d7 | 571 | chomp; |
87475f4d RA |
572 | ($mode, $type, $blob, $tfilename) = split(/\s+/, $_, 4); |
573 | last if ($tfilename eq $filename); | |
574 | } | |
6b3e21d6 | 575 | close($lstree); |
87475f4d | 576 | |
5fcab3d7 | 577 | return $blob if ($tfilename eq $filename); |
87475f4d RA |
578 | die "git-ls-tree failed to find blob for $filename"; |
579 | ||
580 | } | |
581 | ||
582 | ||
c65e8987 RA |
583 | |
584 | sub claim_line { | |
585 | my ($floffset, $rev, $lines, %revinfo) = @_; | |
586 | my $oline = get_line($lines, $floffset); | |
587 | @{$lines->[$floffset]} = ( $oline, $rev, | |
588 | $revinfo{'author'}, $revinfo{'author_date'} ); | |
589 | #printf("Claiming line %d with rev %s: '%s'\n", | |
590 | # $floffset, $rev, $oline) if 1; | |
591 | } | |
592 | ||
593 | sub git_commit_info { | |
594 | my ($rev) = @_; | |
6b3e21d6 | 595 | my $commit = open_pipe("git-cat-file", "commit", $rev) |
c65e8987 RA |
596 | or die "Failed to call git-cat-file: $!"; |
597 | ||
598 | my %info; | |
6b3e21d6 | 599 | while(<$commit>) { |
c65e8987 RA |
600 | chomp; |
601 | last if (length $_ == 0); | |
602 | ||
603 | if (m/^author (.*) <(.*)> (.*)$/) { | |
604 | $info{'author'} = $1; | |
605 | $info{'author_email'} = $2; | |
606 | $info{'author_date'} = $3; | |
607 | } elsif (m/^committer (.*) <(.*)> (.*)$/) { | |
608 | $info{'committer'} = $1; | |
609 | $info{'committer_email'} = $2; | |
610 | $info{'committer_date'} = $3; | |
611 | } | |
612 | } | |
6b3e21d6 | 613 | close($commit); |
c65e8987 RA |
614 | |
615 | return %info; | |
616 | } | |
4788d11a JS |
617 | |
618 | sub format_date { | |
d920e18f JH |
619 | if ($rawtime) { |
620 | return $_[0]; | |
621 | } | |
4788d11a | 622 | my ($timestamp, $timezone) = split(' ', $_[0]); |
cfea8e07 JH |
623 | my $minutes = abs($timezone); |
624 | $minutes = int($minutes / 100) * 60 + ($minutes % 100); | |
625 | if ($timezone < 0) { | |
626 | $minutes = -$minutes; | |
627 | } | |
628 | my $t = $timestamp + $minutes * 60; | |
629 | return strftime("%Y-%m-%d %H:%M:%S " . $timezone, gmtime($t)); | |
4788d11a JS |
630 | } |
631 | ||
87475f4d RA |
632 | # Copied from git-send-email.perl - We need a Git.pm module.. |
633 | sub gitvar { | |
634 | my ($var) = @_; | |
635 | my $fh; | |
636 | my $pid = open($fh, '-|'); | |
637 | die "$!" unless defined $pid; | |
638 | if (!$pid) { | |
639 | exec('git-var', $var) or die "$!"; | |
640 | } | |
641 | my ($val) = <$fh>; | |
642 | close $fh or die "$!"; | |
643 | chomp($val); | |
644 | return $val; | |
645 | } | |
646 | ||
647 | sub gitvar_name { | |
648 | my ($name) = @_; | |
649 | my $val = gitvar($name); | |
650 | my @field = split(/\s+/, $val); | |
651 | return join(' ', @field[0...(@field-4)]); | |
652 | } | |
653 | ||
6b3e21d6 | 654 | sub open_pipe { |
f60d4691 RA |
655 | if ($^O eq '##INSERT_ACTIVESTATE_STRING_HERE##') { |
656 | return open_pipe_activestate(@_); | |
657 | } else { | |
658 | return open_pipe_normal(@_); | |
659 | } | |
660 | } | |
661 | ||
662 | sub open_pipe_activestate { | |
663 | tie *fh, "Git::ActiveStatePipe", @_; | |
664 | return *fh; | |
665 | } | |
666 | ||
667 | sub open_pipe_normal { | |
6b3e21d6 RA |
668 | my (@execlist) = @_; |
669 | ||
670 | my $pid = open my $kid, "-|"; | |
671 | defined $pid or die "Cannot fork: $!"; | |
672 | ||
673 | unless ($pid) { | |
674 | exec @execlist; | |
675 | die "Cannot exec @execlist: $!"; | |
676 | } | |
677 | ||
678 | return $kid; | |
679 | } | |
f60d4691 RA |
680 | |
681 | package Git::ActiveStatePipe; | |
682 | use strict; | |
683 | ||
684 | sub TIEHANDLE { | |
685 | my ($class, @params) = @_; | |
686 | my $cmdline = join " ", @params; | |
687 | my @data = qx{$cmdline}; | |
688 | bless { i => 0, data => \@data }, $class; | |
689 | } | |
690 | ||
691 | sub READLINE { | |
692 | my $self = shift; | |
693 | if ($self->{i} >= scalar @{$self->{data}}) { | |
694 | return undef; | |
695 | } | |
696 | return $self->{'data'}->[ $self->{i}++ ]; | |
697 | } | |
698 | ||
699 | sub CLOSE { | |
700 | my $self = shift; | |
701 | delete $self->{data}; | |
702 | delete $self->{i}; | |
703 | } | |
704 | ||
705 | sub EOF { | |
706 | my $self = shift; | |
707 | return ($self->{i} >= scalar @{$self->{data}}); | |
708 | } |