threads / patch / 4662

patch, 7 partsGit.pm: Introduce ident() and ident_person() methods

Subject: [PATCH 1/7] Git.pm: Introduce ident() and ident_person() methods

## tl;dr

11 messages between Jun 25, 2006 and Jun 25, 2006. Diffs are folded; open one to read it.

replies: 10people: 3as markdown or json

Petr Baudis· Jun 25, 2006, 01:54 UTC · lore
These methods can retrieve/parse the author/committer ident.
Signed-off-by: Petr Baudis <pasky@suse.cz>
---
 git-send-email.perl |   11 ++---------
 perl/Git.pm         |   50 ++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 52 insertions(+), 9 deletions(-)
Show changes to 2 files +52 −9

git-send-email.perl, perl/Git.pm

diff --git a/git-send-email.perl b/git-send-email.perl
index e794e44..79e82f5 100755
--- a/git-send-email.perl
+++ b/git-send-email.perl
@@ -84,15 +84,8 @@ foreach my $entry (@bcclist) {
 
 # Now, let's fill any that aren't set in with defaults:
 
-sub gitvar_ident {
-    my ($name) = @_;
-    my $val = $repo->command('var', $name);
-    my @field = split(/\s+/, $val);
-    return join(' ', @field[0...(@field-3)]);
-}
-
-my ($author) = gitvar_ident('GIT_AUTHOR_IDENT');
-my ($committer) = gitvar_ident('GIT_COMMITTER_IDENT');
+my ($author) = $repo->ident_person('author');
+my ($committer) = $repo->ident_person('committer');
 
 my %aliases;
 my @alias_files = $repo->config('sendemail.aliasesfile');
diff --git a/perl/Git.pm b/perl/Git.pm
index 2e1241b..08f56c0 100644
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -520,6 +520,56 @@ sub config {
 }
 
 
+=item ident ( TYPE | IDENTSTR )
+
+=item ident_person ( TYPE | IDENTSTR | IDENTARRAY )
+
+This suite of functions retrieves and parses ident information, as stored
+in the commit and tag objects or produced by C<var GIT_type_IDENT> (thus
+C<TYPE> can be either I<author> or I<committer>; case is insignificant).
+
+The C<ident> method retrieves the ident information from C<git-var>
+and either returns it as a scalar string or as an array with the fields parsed.
+Alternatively, it can take a prepared ident string (e.g. from the commit
+object) and just parse it.
+
+C<ident_person> returns the person part of the ident - name and email;
+it can take the same arguments as C<ident> or the array returned by C<ident>.
+
+The synopsis is like:
+
+	my ($name, $email, $time_tz) = ident('author');
+	"$name <$email>" eq ident_person('author');
+	"$name <$email>" eq ident_person($name);
+	$time_tz =~ /^\d+ [+-]\d{4}$/;
+
+Both methods must be called on a repository instance.
+
+=cut
+
+sub ident {
+	my ($self, $type) = @_;
+	my $identstr;
+	if (lc $type eq lc 'committer' or lc $type eq lc 'author') {
+		$identstr = $self->command_oneline('var', 'GIT_'.uc($type).'_IDENT');
+	} else {
+		$identstr = $type;
+	}
+	if (wantarray) {
+		return $identstr =~ /^(.*) <(.*)> (\d+ [+-]\d{4})$/;
+	} else {
+		return $identstr;
+	}
+}
+
+sub ident_person {
+	my ($self, @ident) = @_;
+	$#ident == 0 and @ident = $self->ident($ident[0]);
+	return "$ident[0] <$ident[1]>";
+}
+
+
+
 =item hash_object ( FILENAME [, TYPE ] )
 
 =item hash_object ( FILEHANDLE [, TYPE ] )
Petr Baudis· Jun 25, 2006, 01:54 UTC · re: Petr Baudis · lore

[PATCH 2/7] Git.pm: Try to support ActiveState output pipe

The code is stolen from git-annotate and completely untested since I don't have access to any Microsoft operating system now. Someone ActiveState-savvy should look at it anyway and try to implement the input pipe as well, if it is possible at all; also, the implementation seems to be horribly whitespace-unsafe.

Signed-off-by: Petr Baudis <pasky@suse.cz>
---
 perl/Git.pm |   68 +++++++++++++++++++++++++++++++++++++++++++++++++----------
 1 files changed, 57 insertions(+), 11 deletions(-)
Show changes to perl/Git.pm +57 −11
diff --git a/perl/Git.pm b/perl/Git.pm
index 08f56c0..6da11a6 100644
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -748,18 +748,29 @@ sub _command_common_pipe {
 	}
 	_check_valid_cmd($cmd);
 
-	my $pid = open(my $fh, $direction);
-	if (not defined $pid) {
-		throw Error::Simple("open failed: $!");
-	} elsif ($pid == 0) {
-		if (defined $opts{STDERR}) {
-			close STDERR;
-		}
-		if ($opts{STDERR}) {
-			open (STDERR, '>&', $opts{STDERR})
-				or die "dup failed: $!";
+	my $fh;
+	if ($^O eq '##INSERT_ACTIVESTATE_STRING_HERE##') {
+		# ActiveState Perl
+		#defined $opts{STDERR} and
+		#	warn 'ignoring STDERR option - running w/ ActiveState';
+		$direction eq '-|' or
+			die 'input pipe for ActiveState not implemented';
+		tie ($fh, 'Git::activestate_pipe', $cmd, @args);
+
+	} else {
+		my $pid = open($fh, $direction);
+		if (not defined $pid) {
+			throw Error::Simple("open failed: $!");
+		} elsif ($pid == 0) {
+			if (defined $opts{STDERR}) {
+				close STDERR;
+			}
+			if ($opts{STDERR}) {
+				open (STDERR, '>&', $opts{STDERR})
+					or die "dup failed: $!";
+			}
+			_cmd_exec($self, $cmd, @args);
 		}
-		_cmd_exec($self, $cmd, @args);
 	}
 	return wantarray ? ($fh, join(' ', $cmd, @args)) : $fh;
 }
@@ -834,4 +845,39 @@ sub AUTOLOAD {
 sub DESTROY { }
 
 
+# Pipe implementation for ActiveState Perl.
+
+package Git::activestate_pipe;
+use strict;
+
+sub TIEHANDLE {
+	my ($class, @params) = @_;
+	# FIXME: This is probably horrible idea and the thing will explode
+	# at the moment you give it arguments that require some quoting,
+	# but I have no ActiveState clue... --pasky
+	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}});
+}
+
+
 1; # Famous last words
Petr Baudis· Jun 25, 2006, 01:54 UTC · re: Petr Baudis · lore

[PATCH 3/7] Git.pm: Swap hash_object() parameters

I'm about to introduce get_object() and it will be better for consistency if the object type always goes first. And writing 'blob' there explicitly is not much bother.

Signed-off-by: Petr Baudis <pasky@suse.cz>
---
 perl/Git.pm |    8 ++++----
 perl/Git.xs |    4 ++--
 2 files changed, 6 insertions(+), 6 deletions(-)
Show changes to 2 files +6 −6

perl/Git.pm, perl/Git.xs

diff --git a/perl/Git.pm b/perl/Git.pm
index 6da11a6..eea6c07 100644
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -570,13 +570,13 @@ sub ident_person {
 
 
 
-=item hash_object ( FILENAME [, TYPE ] )
+=item hash_object ( TYPE, FILENAME )
 
-=item hash_object ( FILEHANDLE [, TYPE ] )
+=item hash_object ( TYPE, FILEHANDLE )
 
 Compute the SHA1 object id of the given C<FILENAME> (or data waiting in
-C<FILEHANDLE>) considering it is of the C<TYPE> object type (C<blob>
-(default), C<commit>, C<tree>).
+C<FILEHANDLE>) considering it is of the C<TYPE> object type (C<blob>,
+C<commit>, C<tree>).
 
 In case of C<FILEHANDLE> passed instead of file name, all the data
 available are read and hashed, and the filehandle is automatically
diff --git a/perl/Git.xs b/perl/Git.xs
index ebaac4b..2fd1c67 100644
--- a/perl/Git.xs
+++ b/perl/Git.xs
@@ -105,9 +105,9 @@ CODE:
 }
 
 char *
-xs_hash_object(file, type = "blob")
-	SV *file;
+xs_hash_object(type, file)
 	char *type;
+	SV *file;
 CODE:
 {
 	unsigned char sha1[20];
Petr Baudis· Jun 25, 2006, 01:54 UTC · re: Petr Baudis · lore

[PATCH 4/7] Git.pm: Fix Git->repository("/somewhere/totally/elsewhere")

Signed-off-by: Petr Baudis <pasky@suse.cz>
---
 perl/Git.pm |    3 ++-
 1 files changed, 2 insertions(+), 1 deletions(-)
Show changes to perl/Git.pm +2 −1
diff --git a/perl/Git.pm b/perl/Git.pm
index eea6c07..1c3a2ec 100644
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -178,7 +178,8 @@ sub repository {
 		};
 
 		if ($dir) {
-			$opts{Repository} = abs_path($dir);
+			$dir =~ m#^/# or $dir = $opts{Directory} . '/' . $dir;
+			$opts{Repository} = $dir;
 
 			# If --git-dir went ok, this shouldn't die either.
 			my $prefix = $search->command_oneline('rev-parse', '--show-prefix');
Petr Baudis· Jun 25, 2006, 01:54 UTC · re: Petr Baudis · lore

[PATCH 5/7] Make it possible to set up libgit directly (instead of from the environment)

This introduces a setup_git() function which is essentialy a (public) backend for setup_git_env() which lets anyone specify custom sources for the various paths instead of environment variables. Since the repositories may get switched on the fly, this also updates code that caches paths to invalidate them properly; I hope neither of those is a sweet spot.

It is used by Git.xs' xs__call_gate() to set up per-repository data for libgit's consumption. No code actually takes advantage of it yet but get_object() will in the next patches.

Signed-off-by: Petr Baudis <pasky@suse.cz>
---
 cache.h       |    3 +++
 commit.c      |   23 +++++++++++++++++++----
 environment.c |   45 +++++++++++++++++++++++++++++++++++++++------
 perl/Git.pm   |    8 ++++----
 perl/Git.xs   |   16 +++++++++++++++-
 sha1_file.c   |   30 ++++++++++++++++++++++++------
 sha1_name.c   |   10 ++++++++--
 7 files changed, 112 insertions(+), 23 deletions(-)
Show changes to 7 files +112 −23

cache.h, commit.c, environment.c, perl/Git.pm, perl/Git.xs, sha1_file.c, sha1_name.c

diff --git a/cache.h b/cache.h
index efeafea..9844e88 100644
--- a/cache.h
+++ b/cache.h
@@ -116,6 +116,9 @@ extern struct cache_entry **active_cache
 extern unsigned int active_nr, active_alloc, active_cache_changed;
 extern struct cache_tree *active_cache_tree;
 
+extern void setup_git(char *new_git_dir, char *new_git_object_dir,
+                      char *new_git_index_file, char *new_git_graft_file);
+
 #define GIT_DIR_ENVIRONMENT "GIT_DIR"
 #define DEFAULT_GIT_DIR_ENVIRONMENT ".git"
 #define DB_ENVIRONMENT "GIT_OBJECT_DIRECTORY"
diff --git a/commit.c b/commit.c
index 946615d..6c4acc2 100644
--- a/commit.c
+++ b/commit.c
@@ -163,6 +163,14 @@ int register_commit_graft(struct commit_
 	return 0;
 }
 
+void free_commit_grafts(void)
+{
+	int pos = commit_graft_nr;
+	while (pos >= 0)
+		free(commit_graft[pos--]);
+	commit_graft_nr = 0;
+}
+
 struct commit_graft *read_graft_line(char *buf, int len)
 {
 	/* The format is just "Commit Parent1 Parent2 ...\n" */
@@ -215,11 +223,18 @@ int read_graft_file(const char *graft_fi
 static void prepare_commit_graft(void)
 {
 	static int commit_graft_prepared;
-	char *graft_file;
+	static char *last_graft_file;
+	char *graft_file = get_graft_file();
+
+	if (last_graft_file) {
+		if (!strcmp(graft_file, last_graft_file))
+			return;
+		free_commit_grafts();
+	}
+	if (last_graft_file)
+		free(last_graft_file);
+	last_graft_file = strdup(graft_file);
 
-	if (commit_graft_prepared)
-		return;
-	graft_file = get_graft_file();
 	read_graft_file(graft_file);
 	commit_graft_prepared = 1;
 }
diff --git a/environment.c b/environment.c
index 3de8eb3..6b64d11 100644
--- a/environment.c
+++ b/environment.c
@@ -21,28 +21,61 @@ char git_commit_encoding[MAX_ENCODING_LE
 int shared_repository = PERM_UMASK;
 const char *apply_default_whitespace = NULL;
 
+static int dyn_git_object_dir, dyn_git_index_file, dyn_git_graft_file;
 static char *git_dir, *git_object_dir, *git_index_file, *git_refs_dir,
 	*git_graft_file;
-static void setup_git_env(void)
+
+void setup_git(char *new_git_dir, char *new_git_object_dir,
+               char *new_git_index_file, char *new_git_graft_file)
 {
-	git_dir = getenv(GIT_DIR_ENVIRONMENT);
+	git_dir = new_git_dir;
 	if (!git_dir)
 		git_dir = DEFAULT_GIT_DIR_ENVIRONMENT;
-	git_object_dir = getenv(DB_ENVIRONMENT);
+
+	if (dyn_git_object_dir)
+		free(git_object_dir);
+	git_object_dir = new_git_object_dir;
 	if (!git_object_dir) {
 		git_object_dir = xmalloc(strlen(git_dir) + 9);
 		sprintf(git_object_dir, "%s/objects", git_dir);
+		dyn_git_object_dir = 1;
+	} else {
+		dyn_git_object_dir = 0;
 	}
+
+	if (git_refs_dir)
+		free(git_refs_dir);
 	git_refs_dir = xmalloc(strlen(git_dir) + 6);
 	sprintf(git_refs_dir, "%s/refs", git_dir);
-	git_index_file = getenv(INDEX_ENVIRONMENT);
+
+	if (dyn_git_index_file)
+		free(git_index_file);
+	git_index_file = new_git_index_file;
 	if (!git_index_file) {
 		git_index_file = xmalloc(strlen(git_dir) + 7);
 		sprintf(git_index_file, "%s/index", git_dir);
+		dyn_git_index_file = 1;
+	} else {
+		dyn_git_index_file = 0;
 	}
-	git_graft_file = getenv(GRAFT_ENVIRONMENT);
-	if (!git_graft_file)
+
+	if (dyn_git_graft_file)
+		free(git_graft_file);
+	git_graft_file = new_git_graft_file;
+	if (!git_graft_file) {
 		git_graft_file = strdup(git_path("info/grafts"));
+		dyn_git_graft_file = 1;
+	} else {
+		dyn_git_graft_file = 0;
+	}
+}
+
+static void setup_git_env(void)
+{
+	setup_git(getenv(GIT_DIR_ENVIRONMENT),
+	          getenv(DB_ENVIRONMENT),
+	          getenv(INDEX_ENVIRONMENT),
+	          getenv(GRAFT_ENVIRONMENT));
 }
 
 char *get_git_dir(void)
diff --git a/perl/Git.pm b/perl/Git.pm
index 1c3a2ec..c490e0c 100644
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -92,6 +92,7 @@ increate nonwithstanding).
 use Carp qw(carp croak); # but croak is bad - throw instead
 use Error qw(:try);
 use Cwd qw(abs_path);
+use Scalar::Util;
 
 require XSLoader;
 XSLoader::load('Git', $VERSION);
@@ -822,11 +823,10 @@ sub _call_gate {
 	if (defined $self) {
 		# XXX: We ignore the WorkingCopy! To properly support
 		# that will require heavy changes in libgit.
+		# For now, when we will need to do it we could temporarily
+		# chdir() there and then chdir() back after the call is done.
 
-		# XXX: And we ignore everything else as well. libgit
-		# at least needs to be extended to let us specify
-		# the $GIT_DIR instead of looking it up in environment.
-		#xs_call_gate($self->{opts}->{Repository});
+		xs__call_gate(Scalar::Util::refaddr($self), $self->repo_path());
 	}
 
 	# Having to call throw from the C code is a sure path to insanity.
diff --git a/perl/Git.xs b/perl/Git.xs
index 2fd1c67..4e85d69 100644
--- a/perl/Git.xs
+++ b/perl/Git.xs
@@ -59,7 +59,21 @@ BOOT:
 }
 
 
-# /* TODO: xs_call_gate(). See Git.pm. */
+void
+xs__call_gate(repoid, git_dir)
+	long repoid;
+	char *git_dir;
+CODE:
+{
+	static long last_repoid;
+	if (repoid != last_repoid) {
+		setup_git(git_dir,
+		          getenv(DB_ENVIRONMENT),
+		          getenv(INDEX_ENVIRONMENT),
+		          getenv(GRAFT_ENVIRONMENT));
+		last_repoid = repoid;
+	}
+}
 
 
 const char *
diff --git a/sha1_file.c b/sha1_file.c
index c80528b..8d24f50 100644
--- a/sha1_file.c
+++ b/sha1_file.c
@@ -126,16 +126,22 @@ static void fill_sha1_path(char *pathbuf
 char *sha1_file_name(const unsigned char *sha1)
 {
 	static char *name, *base;
+	static const char *last_objdir;
+	const char *sha1_file_directory = get_object_directory();
 
-	if (!base) {
-		const char *sha1_file_directory = get_object_directory();
+	if (!last_objdir || strcmp(last_objdir, sha1_file_directory)) {
 		int len = strlen(sha1_file_directory);
+		if (base)
+			free(base);
 		base = xmalloc(len + 60);
 		memcpy(base, sha1_file_directory, len);
 		memset(base+len, 0, 60);
 		base[len] = '/';
 		base[len+3] = '/';
 		name = base + len + 1;
+		if (last_objdir)
+			free((char *) last_objdir);
+		last_objdir = strdup(sha1_file_directory);
 	}
 	fill_sha1_path(name, sha1);
 	return base;
@@ -145,14 +151,20 @@ char *sha1_pack_name(const unsigned char
 {
 	static const char hex[] = "0123456789abcdef";
 	static char *name, *base, *buf;
+	static const char *last_objdir;
+	const char *sha1_file_directory = get_object_directory();
 	int i;
 
-	if (!base) {
-		const char *sha1_file_directory = get_object_directory();
+	if (!last_objdir || strcmp(last_objdir, sha1_file_directory)) {
 		int len = strlen(sha1_file_directory);
+		if (base)
+			free(base);
 		base = xmalloc(len + 60);
 		sprintf(base, "%s/pack/pack-1234567890123456789012345678901234567890.pack", sha1_file_directory);
 		name = base + len + 11;
+		if (last_objdir)
+			free((char *) last_objdir);
+		last_objdir = strdup(sha1_file_directory);
 	}
 
 	buf = name;
@@ -170,14 +182,20 @@ char *sha1_pack_index_name(const unsigne
 {
 	static const char hex[] = "0123456789abcdef";
 	static char *name, *base, *buf;
+	static const char *last_objdir;
+	const char *sha1_file_directory = get_object_directory();
 	int i;
 
-	if (!base) {
-		const char *sha1_file_directory = get_object_directory();
+	if (!last_objdir || strcmp(last_objdir, sha1_file_directory)) {
 		int len = strlen(sha1_file_directory);
+		if (base)
+			free(base);
 		base = xmalloc(len + 60);
 		sprintf(base, "%s/pack/pack-1234567890123456789012345678901234567890.idx", sha1_file_directory);
 		name = base + len + 11;
+		if (last_objdir)
+			free((char *) last_objdir);
+		last_objdir = strdup(sha1_file_directory);
 	}
 
 	buf = name;
diff --git a/sha1_name.c b/sha1_name.c
index cd85d1f..1451cb6 100644
--- a/sha1_name.c
+++ b/sha1_name.c
@@ -12,15 +12,21 @@ static int find_short_object_filename(in
 	char hex[40];
 	int found = 0;
 	static struct alternate_object_database *fakeent;
+	static const char *last_objdir;
+	const char *objdir = get_object_directory();
 
-	if (!fakeent) {
-		const char *objdir = get_object_directory();
+	if (!last_objdir || strcmp(last_objdir, objdir)) {
 		int objdir_len = strlen(objdir);
 		int entlen = objdir_len + 43;
+		if (fakeent)
+			free(fakeent);
 		fakeent = xmalloc(sizeof(*fakeent) + entlen);
 		memcpy(fakeent->base, objdir, objdir_len);
 		fakeent->name = fakeent->base + objdir_len + 1;
 		fakeent->name[-1] = '/';
+		if (last_objdir)
+			free((char *) last_objdir);
+		last_objdir = strdup(objdir);
 	}
 	fakeent->next = alt_odb_list;
 
Petr Baudis· Jun 25, 2006, 01:54 UTC · re: Petr Baudis · lore

[PATCH 6/7] Git.pm: Introduce fast get_object() method

Direct .xs routine. Note that it does not work 100% correctly when you juggle multiple repository objects, but it is not that bad either. The trouble is that we might reuse packs information for another Git project; that is not an issue since Git depends on uniqueness of SHA1 ids so if we have found the object somewhere else, it is nevertheless going to be the same object. It merely makes object existence detection through this method unreliable; it is duly noted in the documentation.

At least that's how I see it, I hope I didn't overlook any other potential problem. I tested it for memory leaks and it appears to be doing ok.

Signed-off-by: Petr Baudis <pasky@suse.cz>
---
 perl/Git.pm |   17 +++++++++++++++++
 perl/Git.xs |   24 ++++++++++++++++++++++++
 2 files changed, 41 insertions(+), 0 deletions(-)
Show changes to 2 files +41 −0

perl/Git.pm, perl/Git.xs

diff --git a/perl/Git.pm b/perl/Git.pm
index c490e0c..cdae1fe 100644
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -571,6 +571,23 @@ sub ident_person {
 }
 
 
+=item get_object ( TYPE, SHA1 )
+
+Return contents of the given object in a scalar string. If the object has
+not been found, undef is returned; however, do not rely on this! Currently,
+if you use multiple repositories at once, get_object() on one repository
+_might_ return the object even though it exists only in another repository.
+(But do not rely on this behaviour either.)
+
+The method must be called on a repository instance.
+
+Implementation of this method is very fast; no external command calls
+are involved. That's why it is broken, too. ;-)
+
+=cut
+
+# Implemented in Git.xs.
+
 
 =item hash_object ( TYPE, FILENAME )
 
diff --git a/perl/Git.xs b/perl/Git.xs
index 4e85d69..e841e4a 100644
--- a/perl/Git.xs
+++ b/perl/Git.xs
@@ -118,6 +118,30 @@ CODE:
 	free((char **) argv);
 }
 
+
+SV *
+xs_get_object(type, id)
+	char *type;
+	char *id;
+CODE:
+{
+	unsigned char sha1[20];
+	unsigned long size;
+	void *buf;
+
+	if (strlen(id) != 40 || get_sha1_hex(id, sha1) < 0)
+		XSRETURN_UNDEF;
+
+	buf = read_sha1_file(sha1, type, &size);
+	if (!buf)
+		XSRETURN_UNDEF;
+	RETVAL = newSVpvn(buf, size);
+	free(buf);
+}
+OUTPUT:
+	RETVAL
+
+
 char *
 xs_hash_object(type, file)
 	char *type;
Petr Baudis· Jun 25, 2006, 01:54 UTC · re: Petr Baudis · lore

[PATCH 7/7] Convert git-annotate to use Git.pm

Together with the other converted scripts, this is probably still pu material; it appears to work fine for me, though. The speed gain from get_object() is about 10% (I expected more...).

Signed-off-by: Petr Baudis <pasky@suse.cz>
---
 git-annotate.perl |  167 ++++++++++-------------------------------------------
 1 files changed, 31 insertions(+), 136 deletions(-)
Show changes to git-annotate.perl +31 −136
diff --git a/git-annotate.perl b/git-annotate.perl
index a6a7a48..d924e87 100755
--- a/git-annotate.perl
+++ b/git-annotate.perl
@@ -11,6 +11,7 @@ use strict;
 use Getopt::Long;
 use POSIX qw(strftime gmtime);
 use File::Basename qw(basename dirname);
+use Git;
 
 sub usage() {
 	print STDERR "Usage: ${\basename $0} [-s] [-S revs-file] file [ revision ]
@@ -29,7 +30,7 @@ sub usage() {
 	exit(1);
 }
 
-our ($help, $longrev, $rename, $rawtime, $starting_rev, $rev_file) = (0, 0, 1);
+our ($help, $longrev, $rename, $rawtime, $starting_rev, $rev_file, $repo) = (0, 0, 1);
 
 my $rc = GetOptions(	"long|l" => \$longrev,
 			"time|t" => \$rawtime,
@@ -52,6 +53,8 @@ my @stack = (
 	},
 );
 
+$repo = Git->repository();
+
 our @filelines = ();
 
 if (defined $starting_rev) {
@@ -102,15 +105,11 @@ while (my $bound = pop @stack) {
 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);
+	my %ident;
+	@ident{'author', 'author_email', 'author_date'} = $repo->ident('author');
+	my $diff = $repo->command_output_pipe('diff', '-R', 'HEAD', '--', $filename);
+	_git_diff_parse($diff, $head, "dirty", %ident);
+	$repo->command_close_pipe($diff);
 }
 handle_rev();
 
@@ -181,8 +180,7 @@ sub git_rev_list {
 		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: $!";
+		$revlist = $repo->command_output_pipe('rev-list', '--parents', '--remove-empty', $rev, '--', $file);
 	}
 
 	my @revs;
@@ -191,7 +189,7 @@ sub git_rev_list {
 		my ($rev, @parents) = split /\s+/, $line;
 		push @revs, [ $rev, @parents ];
 	}
-	close($revlist);
+	$repo->command_close_pipe($revlist);
 
 	printf("0 revs found for rev %s (%s)\n", $rev, $file) if (@revs == 0);
 	return @revs;
@@ -200,8 +198,7 @@ sub git_rev_list {
 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: $!";
+	my $patch = $repo->command_output_pipe('diff-tree', '-M50', '-r', '--name-status', '-z', $rev);
 
 	local $/ = "\0";
 	my %bound;
@@ -227,7 +224,7 @@ sub find_parent_renames {
 			}
 		}
 	}
-	close($patch);
+	$repo->command_close_pipe($patch);
 
 	return \%bound;
 }
@@ -236,14 +233,9 @@ sub find_parent_renames {
 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);
+	my $parentline = $repo->command_oneline('rev-list', '--remove-empty',
+			'--parents', '--max-count=1', $rev, '--', $filename);
+	my ($revfound, $parent) = split m/\s+/, $parentline;
 
 	return $parent;
 }
@@ -254,13 +246,13 @@ # Record the commit information that res
 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: $!";
+	my $diff = $repo->command_output_pipe('diff-tree', '-M', '-p',
+			$rev, $parent, '--',
+			$revs{$rev}{'filename'}, $revs{$parent}{'filename'});
 
 	_git_diff_parse($diff, $parent, $rev, %revinfo);
 
-	close($diff);
+	$repo->command_close_pipe($diff);
 }
 
 sub _git_diff_parse {
@@ -351,36 +343,25 @@ sub git_cat_file {
 	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);
-
+	my @lines = split(/\n/, $repo->get_object('blob', $blob));
+	pop @lines unless $lines[$#lines]; # Trailing newline
 	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 $lstree = $repo->command_output_pipe('ls-tree', $rev, $filename);
 	my ($mode, $type, $blob, $tfilename);
 	while(<$lstree>) {
 		chomp;
 		($mode, $type, $blob, $tfilename) = split(/\s+/, $_, 4);
 		last if ($tfilename eq $filename);
 	}
-	close($lstree);
+	$repo->command_close_pipe($lstree);
 
 	return $blob if ($tfilename eq $filename);
 	die "git-ls-tree failed to find blob for $filename";
-
 }
 
 
@@ -396,25 +377,17 @@ sub claim_line {
 
 sub git_commit_info {
 	my ($rev) = @_;
-	my $commit = open_pipe("git-cat-file", "commit", $rev)
-		or die "Failed to call git-cat-file: $!";
+	my $commit = $repo->get_object('commit', $rev);
 
 	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;
+	while ($commit =~ /(.*?)\n/g) {
+		my $line = $1;
+		if ($line =~ s/^author //) {
+			@info{'author', 'author_email', 'author_date'} = $repo->ident($line);
+		} elsif ($line =~ s/^committer//) {
+			@info{'committer', 'committer_email', 'committer_date'} = $repo->ident($line);
 		}
 	}
-	close($commit);
 
 	return %info;
 }
@@ -432,81 +405,3 @@ sub format_date {
 	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}});
-}
Ryan Anderson· Jun 25, 2006, 09:27 UTC · re: Petr Baudis · lore

Re: [PATCH 7/7] Convert git-annotate to use Git.pm

On Sun, Jun 25, 2006 at 03:54:34AM +0200, Petr Baudis wrote:
Show 26 quoted lines
> -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;
> -}

I don't see that Git.pm provides the compatibility functionality we have stubbed out, here.

(It clearly has never been used, because there hasn't been a patch to set the actual ActiveState string there.. 'MSWin32', btw.)

I suspect that the other scripts, that have more users, will see regression complaints when the qx() calls get replaced by calls to open(my $fh, "-|"), indirectly, in Git.pm

-- 
Ryan Anderson
  sometimes Pug Majere
Petr Baudis· Jun 25, 2006, 09:36 UTC · re: Ryan Anderson · lore

Re: [PATCH 7/7] Convert git-annotate to use Git.pm

Dear diary, on Sun, Jun 25, 2006 at 11:27:23AM CEST, I got a letter where Ryan Anderson <ryan@michonline.com> said that...

> I don't see that Git.pm provides the compatibility functionality we have
> stubbed out, here.
Please see [PATCH 2/7] Git.pm: Try to support ActiveState output pipe.
-- 
				Petr "Pasky" Baudis
Stuff: http://pasky.or.cz/
A person is just about as big as the things that make them angry.
Petr Baudis· Jun 25, 2006, 01:57 UTC · re: Petr Baudis · lore

Re: [PATCH 1/7] Git.pm: Introduce ident() and ident_person() methods

> diff --git a/git-send-email.perl b/git-send-email.perl
> index e794e44..79e82f5 100755
> --- a/git-send-email.perl
> +++ b/git-send-email.perl
BTW, please tell me if you want to redo the patches without any script
updates (and how large portion of the patches to resend; my stg stack
now has 28 patches and I'm finally using it for some real workload!)
- given that the plan is to have the converted scripts only in pu
(or entirely outside your tree) but full-fledged Git.pm in tree.
-- 
				Petr "Pasky" Baudis
Stuff: http://pasky.or.cz/
A person is just about as big as the things that make them angry.
Junio C Hamano· Jun 25, 2006, 05:25 UTC · re: Petr Baudis · lore

Re: [PATCH 1/7] Git.pm: Introduce ident() and ident_person() methods

Petr Baudis <pasky@suse.cz> writes:
Show 10 quoted lines
>> diff --git a/git-send-email.perl b/git-send-email.perl
>> index e794e44..79e82f5 100755
>> --- a/git-send-email.perl
>> +++ b/git-send-email.perl
>
> BTW, please tell me if you want to redo the patches without any script
> updates (and how large portion of the patches to resend; my stg stack
> now has 28 patches and I'm finally using it for some real workload!)
> - given that the plan is to have the converted scripts only in pu
> (or entirely outside your tree) but full-fledged Git.pm in tree.

I'd avoid asking you to resend, but give me some time to see how the series looks like first.

← back to recent threads