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

11 messages from 2006-06-25 to 2006-06-25. Participants: Petr Baudis, Junio C Hamano, Ryan Anderson.
Thread: https://gitlist.dev/t/4662

## Petr Baudis, 2006-06-25 01:54

Subject: [PATCH 1/7] Git.pm: Introduce ident() and ident_person() methods
Message-ID: <20060625015421.29906.50002.stgit@machine.or.cz>
URL: https://gitlist.dev/e/20060625015421.29906.50002.stgit%40machine.or.cz

```
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(-)

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, 2006-06-25 01:54

Subject: [PATCH 2/7] Git.pm: Try to support ActiveState output pipe
Message-ID: <20060625015423.29906.86666.stgit@machine.or.cz>
URL: https://gitlist.dev/e/20060625015423.29906.86666.stgit%40machine.or.cz
In-Reply-To: <20060625015421.29906.50002.stgit@machine.or.cz>

```
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(-)

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, 2006-06-25 01:54

Subject: [PATCH 3/7] Git.pm: Swap hash_object() parameters
Message-ID: <20060625015426.29906.54971.stgit@machine.or.cz>
URL: https://gitlist.dev/e/20060625015426.29906.54971.stgit%40machine.or.cz
In-Reply-To: <20060625015421.29906.50002.stgit@machine.or.cz>

```
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(-)

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, 2006-06-25 01:54

Subject: [PATCH 4/7] Git.pm: Fix Git->repository("/somewhere/totally/elsewhere")
Message-ID: <20060625015428.29906.66270.stgit@machine.or.cz>
URL: https://gitlist.dev/e/20060625015428.29906.66270.stgit%40machine.or.cz
In-Reply-To: <20060625015421.29906.50002.stgit@machine.or.cz>

```
Signed-off-by: Petr Baudis <pasky@suse.cz>
---

 perl/Git.pm |    3 ++-
 1 files changed, 2 insertions(+), 1 deletions(-)

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, 2006-06-25 01:54

Subject: [PATCH 5/7] Make it possible to set up libgit directly (instead of from the environment)
Message-ID: <20060625015430.29906.5569.stgit@machine.or.cz>
URL: https://gitlist.dev/e/20060625015430.29906.5569.stgit%40machine.or.cz
In-Reply-To: <20060625015421.29906.50002.stgit@machine.or.cz>

```
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(-)

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, 2006-06-25 01:54

Subject: [PATCH 6/7] Git.pm: Introduce fast get_object() method
Message-ID: <20060625015432.29906.31058.stgit@machine.or.cz>
URL: https://gitlist.dev/e/20060625015432.29906.31058.stgit%40machine.or.cz
In-Reply-To: <20060625015421.29906.50002.stgit@machine.or.cz>

```
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(-)

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, 2006-06-25 01:54

Subject: [PATCH 7/7] Convert git-annotate to use Git.pm
Message-ID: <20060625015434.29906.23422.stgit@machine.or.cz>
URL: https://gitlist.dev/e/20060625015434.29906.23422.stgit%40machine.or.cz
In-Reply-To: <20060625015421.29906.50002.stgit@machine.or.cz>

```
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(-)

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}});
-}

```

## Petr Baudis, 2006-06-25 01:57

Subject: Re: [PATCH 1/7] Git.pm: Introduce ident() and ident_person() methods
Message-ID: <20060625015751.GB21864@pasky.or.cz>
URL: https://gitlist.dev/e/20060625015751.GB21864%40pasky.or.cz
In-Reply-To: <20060625015421.29906.50002.stgit@machine.or.cz>

```
> 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, 2006-06-25 05:25

Subject: Re: [PATCH 1/7] Git.pm: Introduce ident() and ident_person() methods
Message-ID: <7vhd29zu0j.fsf@assigned-by-dhcp.cox.net>
URL: https://gitlist.dev/e/7vhd29zu0j.fsf%40assigned-by-dhcp.cox.net
In-Reply-To: <20060625015751.GB21864@pasky.or.cz>

```
Petr Baudis <pasky@suse.cz> writes:

>> 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.

```

## Ryan Anderson, 2006-06-25 09:27

Subject: Re: [PATCH 7/7] Convert git-annotate to use Git.pm
Message-ID: <20060625092719.GH3154@h4x0r5.com>
URL: https://gitlist.dev/e/20060625092719.GH3154%40h4x0r5.com
In-Reply-To: <20060625015434.29906.23422.stgit@machine.or.cz>

```
On Sun, Jun 25, 2006 at 03:54:34AM +0200, Petr Baudis wrote:
> -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, 2006-06-25 09:36

Subject: Re: [PATCH 7/7] Convert git-annotate to use Git.pm
Message-ID: <20060625093618.GE21864@pasky.or.cz>
URL: https://gitlist.dev/e/20060625093618.GE21864%40pasky.or.cz
In-Reply-To: <20060625092719.GH3154@h4x0r5.com>

```
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.

```