[thirdparty/git.git] / git-annotate.perl

#!/usr/bin/perl
# Copyright 2006, Ryan Anderson <ryan@michonline.com>
#
# GPL v2 (See COPYING)
#
# This file is licensed under the GPL v2, or a later version
# at the discretion of Linus Torvalds.

use warnings;
use strict;
use Getopt::Long;
use POSIX qw(strftime gmtime);

sub usage() {
	print STDERR 'Usage: ${\basename $0} [-s] [-S revs-file] file [ revision ]
	-l, --long
			Show long rev (Defaults off)
	-t, --time
			Show raw timestamp (Defaults off)
	-r, --rename
			Follow renames (Defaults on).
	-S, --rev-file revs-file
			Use revs from revs-file instead of calling git-rev-list
	-h, --help
			This message.
';

	exit(1);
}

our ($help, $longrev, $rename, $rawtime, $starting_rev, $rev_file) = (0, 0, 1);

my $rc = GetOptions(	"long|l" => \$longrev,
			"time|t" => \$rawtime,
			"help|h" => \$help,
			"rename|r" => \$rename,
			"rev-file|S=s" => \$rev_file);
if (!$rc or $help) {
	usage();
}

my $filename = shift @ARGV;
if (@ARGV) {
	$starting_rev = shift @ARGV;
}

my @stack = (
	{
		'rev' => defined $starting_rev ? $starting_rev : "HEAD",
		'filename' => $filename,
	},
);

our @filelines = ();

if (defined $starting_rev) {
	@filelines = git_cat_file($starting_rev, $filename);
} else {
	open(F,"<",$filename)
		or die "Failed to open filename: $!";

	while(<F>) {
		chomp;
		push @filelines, $_;
	}
	close(F);

}

our %revs;
our @revqueue;
our $head;

my $revsprocessed = 0;
while (my $bound = pop @stack) {
	my @revisions = git_rev_list($bound->{'rev'}, $bound->{'filename'});
	foreach my $revinst (@revisions) {
		my ($rev, @parents) = @$revinst;
		$head ||= $rev;

		if (!defined($rev)) {
			$rev = "";
		}
		$revs{$rev}{'filename'} = $bound->{'filename'};
		if (scalar @parents > 0) {
			$revs{$rev}{'parents'} = \@parents;
			next;
		}

		if (!$rename) {
			next;
		}

		my $newbound = find_parent_renames($rev, $bound->{'filename'});
		if ( exists $newbound->{'filename'} && $newbound->{'filename'} ne $bound->{'filename'}) {
			push @stack, $newbound;
			$revs{$rev}{'parents'} = [$newbound->{'rev'}];
		}
	}
}
push @revqueue, $head;
init_claim( defined $starting_rev ? $head : 'dirty');
unless (defined $starting_rev) {
	my $diff = open_pipe("git","diff","-R", "HEAD", "--",$filename)
		or die "Failed to call git diff to check for dirty state: $!";

	_git_diff_parse($diff, $head, "dirty", (
				'author' => gitvar_name("GIT_AUTHOR_IDENT"),
				'author_date' => sprintf("%s +0000",time()),
				)
			);
	close($diff);
}
handle_rev();


my $i = 0;
foreach my $l (@filelines) {
	my ($output, $rev, $committer, $date);
	if (ref $l eq 'ARRAY') {
		($output, $rev, $committer, $date) = @$l;
		if (!$longrev && length($rev) > 8) {
			$rev = substr($rev,0,8);
		}
	} else {
		$output = $l;
		($rev, $committer, $date) = ('unknown', 'unknown', 'unknown');
	}

	printf("%s\t(%10s\t%10s\t%d)%s\n", $rev, $committer,
		format_date($date), ++$i, $output);
}

sub init_claim {
	my ($rev) = @_;
	for (my $i = 0; $i < @filelines; $i++) {
		$filelines[$i] = [ $filelines[$i], '', '', '', 1];
			# line,
			# rev,
			# author,
			# date,
			# 1 <-- belongs to the original file.
	}
	$revs{$rev}{'lines'} = \@filelines;
}


sub handle_rev {
	my $i = 0;
	my %seen;
	while (my $rev = shift @revqueue) {
		next if $seen{$rev}++;

		my %revinfo = git_commit_info($rev);

		foreach my $p (@{$revs{$rev}{'parents'}}) {

			git_diff_parse($p, $rev, %revinfo);
			push @revqueue, $p;
		}


		if (scalar @{$revs{$rev}{parents}} == 0) {
			# We must be at the initial rev here, so claim everything that is left.
			for (my $i = 0; $i < @{$revs{$rev}{lines}}; $i++) {
				if (ref ${$revs{$rev}{lines}}[$i] eq '' || ${$revs{$rev}{lines}}[$i][1] eq '') {
					claim_line($i, $rev, $revs{$rev}{lines}, %revinfo);
				}
			}
		}
	}
}


sub git_rev_list {
	my ($rev, $file) = @_;

	my $revlist;
	if ($rev_file) {
		open($revlist, '<' . $rev_file)
		    or die "Failed to open $rev_file : $!";
	} else {
		$revlist = open_pipe("git-rev-list","--parents","--remove-empty",$rev,"--",$file)
			or die "Failed to exec git-rev-list: $!";
	}

	my @revs;
	while(my $line = <$revlist>) {
		chomp $line;
		my ($rev, @parents) = split /\s+/, $line;
		push @revs, [ $rev, @parents ];
	}
	close($revlist);

	printf("0 revs found for rev %s (%s)\n", $rev, $file) if (@revs == 0);
	return @revs;
}

sub find_parent_renames {
	my ($rev, $file) = @_;

	my $patch = open_pipe("git-diff-tree", "-M50", "-r","--name-status", "-z","$rev")
		or die "Failed to exec git-diff: $!";

	local $/ = "\0";
	my %bound;
	my $junk = <$patch>;
	while (my $change = <$patch>) {
		chomp $change;
		my $filename = <$patch>;
		chomp $filename;

		if ($change =~ m/^[AMD]$/ ) {
			next;
		} elsif ($change =~ m/^R/ ) {
			my $oldfilename = $filename;
			$filename = <$patch>;
			chomp $filename;
			if ( $file eq $filename ) {
				my $parent = git_find_parent($rev, $oldfilename);
				@bound{'rev','filename'} = ($parent, $oldfilename);
				last;
			}
		}
	}
	close($patch);

	return \%bound;
}


sub git_find_parent {
	my ($rev, $filename) = @_;

	my $revparent = open_pipe("git-rev-list","--remove-empty", "--parents","--max-count=1","$rev","--",$filename)
		or die "Failed to open git-rev-list to find a single parent: $!";

	my $parentline = <$revparent>;
	chomp $parentline;
	my ($revfound,$parent) = split m/\s+/, $parentline;

	close($revparent);

	return $parent;
}


# Get a diff between the current revision and a parent.
# Record the commit information that results.
sub git_diff_parse {
	my ($parent, $rev, %revinfo) = @_;

	my $diff = open_pipe("git-diff-tree","-M","-p",$rev,$parent,"--",
			$revs{$rev}{'filename'}, $revs{$parent}{'filename'})
		or die "Failed to call git-diff for annotation: $!";

	_git_diff_parse($diff, $parent, $rev, %revinfo);

	close($diff);
}

sub _git_diff_parse {
	my ($diff, $parent, $rev, %revinfo) = @_;

	my ($ri, $pi) = (0,0);
	my $slines = $revs{$rev}{'lines'};
	my @plines;

	my $gotheader = 0;
	my ($remstart);
	my ($hunk_start, $hunk_index);
	while(<$diff>) {
		chomp;
		if (m/^@@ -(\d+),(\d+) \+(\d+),(\d+)/) {
			$remstart = $1;
			# Adjust for 0-based arrays
			$remstart--;
			# Reinit hunk tracking.
			$hunk_start = $remstart;
			$hunk_index = 0;
			$gotheader = 1;

			for (my $i = $ri; $i < $remstart; $i++) {
				$plines[$pi++] = $slines->[$i];
				$ri++;
			}
			next;
		} elsif (!$gotheader) {
			next;
		}

		if (m/^\+(.*)$/) {
			my $line = $1;
			$plines[$pi++] = [ $line, '', '', '', 0 ];
			next;

		} elsif (m/^-(.*)$/) {
			my $line = $1;
			if (get_line($slines, $ri) eq $line) {
				# Found a match, claim
				claim_line($ri, $rev, $slines, %revinfo);
			} else {
				die sprintf("Sync error: %d/%d\n|%s\n|%s\n%s => %s\n",
						$ri, $hunk_start + $hunk_index,
						$line,
						get_line($slines, $ri),
						$rev, $parent);
			}
			$ri++;

		} elsif (m/^\\/) {
			;
			# Skip \No newline at end of file.
			# But this can be internationalized, so only look
			# for an initial \

		} else {
			if (substr($_,1) ne get_line($slines,$ri) ) {
				die sprintf("Line %d (%d) does not match:\n|%s\n|%s\n%s => %s\n",
						$hunk_start + $hunk_index, $ri,
						substr($_,1),
						get_line($slines,$ri),
						$rev, $parent);
			}
			$plines[$pi++] = $slines->[$ri++];
		}
		$hunk_index++;
	}
	for (my $i = $ri; $i < @{$slines} ; $i++) {
		push @plines, $slines->[$ri++];
	}

	$revs{$parent}{lines} = \@plines;
	return;
}

sub get_line {
	my ($lines, $index) = @_;

	return ref $lines->[$index] ne '' ? $lines->[$index][0] : $lines->[$index];
}

sub git_cat_file {
	my ($rev, $filename) = @_;
	return () unless defined $rev && defined $filename;

	my $blob = git_ls_tree($rev, $filename);
	die "Failed to find a blob for $filename in rev $rev\n" if !defined $blob;

	my $catfile = open_pipe("git","cat-file", "blob", $blob)
		or die "Failed to git-cat-file blob $blob (rev $rev, file $filename): " . $!;

	my @lines;
	while(<$catfile>) {
		chomp;
		push @lines, $_;
	}
	close($catfile);

	return @lines;
}

sub git_ls_tree {
	my ($rev, $filename) = @_;

	my $lstree = open_pipe("git","ls-tree",$rev,$filename)
		or die "Failed to call git ls-tree: $!";

	my ($mode, $type, $blob, $tfilename);
	while(<$lstree>) {
		chomp;
		($mode, $type, $blob, $tfilename) = split(/\s+/, $_, 4);
		last if ($tfilename eq $filename);
	}
	close($lstree);

	return $blob if ($tfilename eq $filename);
	die "git-ls-tree failed to find blob for $filename";

}


sub claim_line {
	my ($floffset, $rev, $lines, %revinfo) = @_;
	my $oline = get_line($lines, $floffset);
	@{$lines->[$floffset]} = ( $oline, $rev,
		$revinfo{'author'}, $revinfo{'author_date'} );
	#printf("Claiming line %d with rev %s: '%s'\n",
	#		$floffset, $rev, $oline) if 1;
}

sub git_commit_info {
	my ($rev) = @_;
	my $commit = open_pipe("git-cat-file", "commit", $rev)
		or die "Failed to call git-cat-file: $!";

	my %info;
	while(<$commit>) {
		chomp;
		last if (length $_ == 0);

		if (m/^author (.*) <(.*)> (.*)$/) {
			$info{'author'} = $1;
			$info{'author_email'} = $2;
			$info{'author_date'} = $3;
		} elsif (m/^committer (.*) <(.*)> (.*)$/) {
			$info{'committer'} = $1;
			$info{'committer_email'} = $2;
			$info{'committer_date'} = $3;
		}
	}
	close($commit);

	return %info;
}

sub format_date {
	if ($rawtime) {
		return $_[0];
	}
	my ($timestamp, $timezone) = split(' ', $_[0]);
	my $minutes = abs($timezone);
	$minutes = int($minutes / 100) * 60 + ($minutes % 100);
	if ($timezone < 0) {
	    $minutes = -$minutes;
	}
	my $t = $timestamp + $minutes * 60;
	return strftime("%Y-%m-%d %H:%M:%S " . $timezone, gmtime($t));
}

# Copied from git-send-email.perl - We need a Git.pm module..
sub gitvar {
    my ($var) = @_;
    my $fh;
    my $pid = open($fh, '-|');
    die "$!" unless defined $pid;
    if (!$pid) {
	exec('git-var', $var) or die "$!";
    }
    my ($val) = <$fh>;
    close $fh or die "$!";
    chomp($val);
    return $val;
}

sub gitvar_name {
    my ($name) = @_;
    my $val = gitvar($name);
    my @field = split(/\s+/, $val);
    return join(' ', @field[0...(@field-4)]);
}

sub open_pipe {
	if ($^O eq '##INSERT_ACTIVESTATE_STRING_HERE##') {
		return open_pipe_activestate(@_);
	} else {
		return open_pipe_normal(@_);
	}
}

sub open_pipe_activestate {
	tie *fh, "Git::ActiveStatePipe", @_;
	return *fh;
}

sub open_pipe_normal {
	my (@execlist) = @_;

	my $pid = open my $kid, "-|";
	defined $pid or die "Cannot fork: $!";

	unless ($pid) {
		exec @execlist;
		die "Cannot exec @execlist: $!";
	}

	return $kid;
}

package Git::ActiveStatePipe;
use strict;

sub TIEHANDLE {
	my ($class, @params) = @_;
	my $cmdline = join " ", @params;
	my  @data = qx{$cmdline};
	bless { i => 0, data => \@data }, $class;
}

sub READLINE {
	my $self = shift;
	if ($self->{i} >= scalar @{$self->{data}}) {
		return undef;
	}
	return $self->{'data'}->[ $self->{i}++ ];
}

sub CLOSE {
	my $self = shift;
	delete $self->{data};
	delete $self->{i};
}

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