[PATCH 0/6] The residual Git.pm patches

[PATCH 0/6] The residual Git.pm patches

[Petr Baudis]

  Hi,

  this series is not so much meant for immediate application but
rather so that you can leave it lingering on top of pu, if you wish,
and especially of fear of it being lost in all the turmoil around
Git.pm - this is what was left in my StGIT series after weeding out
what ended up in next, neatly stacked in a single mail thread.

				Petr Baudis

-- 
And on the eigth day, God started debugging.

[PATCH 1/6] Git.pm: Add config() method

[Petr Baudis]

This accessor will retrieve value(s) of the given configuration variable.

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

 Documentation/git-repo-config.txt |    3 ++-
 perl/Git.pm                       |   37 ++++++++++++++++++++++++++++++++++++-
 repo-config.c                     |    2 +-
 3 files changed, 39 insertions(+), 3 deletions(-)

diff --git a/Documentation/git-repo-config.txt b/Documentation/git-repo-config.txt
index 803c0d5..cc72fa9 100644
--- a/Documentation/git-repo-config.txt
+++ b/Documentation/git-repo-config.txt
@@ -54,7 +54,8 @@ OPTIONS
 
 --get::
 	Get the value for a given key (optionally filtered by a regex
-	matching the value).
+	matching the value). Returns error code 1 if the key was not
+	found and error code 2 if multiple key values were found.
 
 --get-all::
 	Like get, but does not fail if the number of values for the key
diff --git a/perl/Git.pm b/perl/Git.pm
index b4ee88b..24fd7ce 100644
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -473,7 +473,6 @@ and the directory must exist.
 
 sub wc_chdir {
 	my ($self, $subdir) = @_;
-
 	$self->wc_path()
 		or throw Error::Simple("bare repository");
 
@@ -486,6 +485,42 @@ sub wc_chdir {
 }
 
 
+=item config ( VARIABLE )
+
+Retrieve the configuration C<VARIABLE> in the same manner as C<repo-config>
+does. In scalar context requires the variable to be set only one time
+(exception is thrown otherwise), in array context returns allows the
+variable to be set multiple times and returns all the values.
+
+Must be called on a repository instance.
+
+This currently wraps command('repo-config') so it is not so fast.
+
+=cut
+
+sub config {
+	my ($self, $var) = @_;
+	$self->repo_path()
+		or throw Error::Simple("not a repository");
+
+	try {
+		if (wantarray) {
+			return $self->command('repo-config', '--get-all', $var);
+		} else {
+			return $self->command_oneline('repo-config', '--get', $var);
+		}
+	} catch Git::Error::Command with {
+		my $E = shift;
+		if ($E->value() == 1) {
+			# Key not found.
+			return undef;
+		} else {
+			throw $E;
+		}
+	};
+}
+
+
 =item hash_object ( TYPE, FILENAME )
 
 =item hash_object ( TYPE, FILEHANDLE )
diff --git a/repo-config.c b/repo-config.c
index 743f02b..c7ed0ac 100644
--- a/repo-config.c
+++ b/repo-config.c
@@ -118,7 +118,7 @@ static int get_value(const char* key_, c
 	if (do_all)
 		ret = !seen;
 	else
-		ret =  (seen == 1) ? 0 : 1;
+		ret = (seen == 1) ? 0 : seen > 1 ? 2 : 1;
 
 free_strings:
 	if (repo_config)

[PATCH 2/6] Convert git-send-email to use Git.pm

[Petr Baudis]

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

 git-send-email.perl |   30 ++++++++----------------------
 1 files changed, 8 insertions(+), 22 deletions(-)

diff --git a/git-send-email.perl b/git-send-email.perl
index c5d9e73..e794e44 100755
--- a/git-send-email.perl
+++ b/git-send-email.perl
@@ -21,6 +21,7 @@ use warnings;
 use Term::ReadLine;
 use Getopt::Long;
 use Data::Dumper;
+use Git;
 
 # most mail servers generate the Date: header, but not all...
 $ENV{LC_ALL} = 'C';
@@ -46,6 +47,8 @@ my $smtp_server;
 # Example reply to:
 #$initial_reply_to = ''; #<20050203173208.GA23964@foobar.com>';
 
+my $repo = Git->repository();
+
 my $term = new Term::ReadLine 'git-send-email';
 
 # Begin by accumulating all the variables (defined above), that we will end up
@@ -81,23 +84,9 @@ foreach my $entry (@bcclist) {
 
 # Now, let's fill any that aren't set in with defaults:
 
-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_ident {
     my ($name) = @_;
-    my $val = gitvar($name);
+    my $val = $repo->command('var', $name);
     my @field = split(/\s+/, $val);
     return join(' ', @field[0...(@field-3)]);
 }
@@ -106,8 +95,8 @@ my ($author) = gitvar_ident('GIT_AUTHOR_
 my ($committer) = gitvar_ident('GIT_COMMITTER_IDENT');
 
 my %aliases;
-chomp(my @alias_files = `git-repo-config --get-all sendemail.aliasesfile`);
-chomp(my $aliasfiletype = `git-repo-config sendemail.aliasfiletype`);
+my @alias_files = $repo->config('sendemail.aliasesfile');
+my $aliasfiletype = $repo->config('sendemail.aliasfiletype');
 my %parse_alias = (
 	# multiline formats can be supported in the future
 	mutt => sub { my $fh = shift; while (<$fh>) {
@@ -132,7 +121,7 @@ my %parse_alias = (
 		}}}
 );
 
-if (@alias_files && defined $parse_alias{$aliasfiletype}) {
+if (@alias_files and $aliasfiletype and defined $parse_alias{$aliasfiletype}) {
 	foreach my $file (@alias_files) {
 		open my $fh, '<', $file or die "opening $file: $!\n";
 		$parse_alias{$aliasfiletype}->($fh);
@@ -374,10 +363,7 @@ sub send_message
 	my $date = strftime('%a, %d %b %Y %H:%M:%S %z', localtime($time++));
 	my $gitversion = '@@GIT_VERSION@@';
 	if ($gitversion =~ m/..GIT_VERSION../) {
-	    $gitversion = `git --version`;
-	    chomp $gitversion;
-	    # keep only what's after the last space
-	    $gitversion =~ s/^.* //;
+	    $gitversion = Git::version();
 	}
 
 	my $header = "From: $from

[PATCH 3/6] Git.pm: Introduce ident() and ident_person() methods

[Petr Baudis]

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         |   49 +++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 51 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 24fd7ce..9ce9fcd 100644
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -521,6 +521,55 @@ 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 ( TYPE, FILENAME )
 
 =item hash_object ( TYPE, FILEHANDLE )

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

[Petr Baudis]

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 8719939..962f2fc 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 a608faf..91f97c1 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 9ce9fcd..895a939 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);
@@ -833,11 +834,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 2bbec43..6ed26a2 100644
--- a/perl/Git.xs
+++ b/perl/Git.xs
@@ -52,7 +52,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;
+	}
+}
 
 
 char *
diff --git a/sha1_file.c b/sha1_file.c
index 8179630..ab64543 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 f2cbafa..c698c1b 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;
 

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

[Petr Baudis]

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 |   18 ++++++++++++++++++
 perl/Git.xs |   24 ++++++++++++++++++++++++
 2 files changed, 42 insertions(+), 0 deletions(-)

diff --git a/perl/Git.pm b/perl/Git.pm
index 895a939..65acaa7 100644
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -571,6 +571,24 @@ 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 )
 
 =item hash_object ( TYPE, FILEHANDLE )
diff --git a/perl/Git.xs b/perl/Git.xs
index 6ed26a2..226dd4f 100644
--- a/perl/Git.xs
+++ b/perl/Git.xs
@@ -111,6 +111,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_pipe(type, fd)
 	char *type;

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

[Petr Baudis]

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

Re: [PATCH 4/6] Make it possible to set up libgit directly (instead of from the environment)

[Petr Baudis]

Dear diary, on Mon, Jul 03, 2006 at 10:48:03PM CEST, I got a letter
where Petr Baudis <pasky@suse.cz> said that...
> 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>

To further clarify, this only invalidates the path cache and grafts
list, not alternates (it assumes the environment variable stays the
same for now; that is to be fixed when we extend Git.pm further)
and not pack list - we will automagically extend the list of packs when
we meet more repositories, but we will never remove old packs from the
list. (For no special reason other than this does no harm other than
possibly finding objects that should be missing, and the patch smells
bad enough enough as it is now. ;-)

-- 
				Petr "Pasky" Baudis
Stuff: http://pasky.or.cz/
Snow falling on Perl. White noise covering line noise.
Hides all the bugs too. -- J. Putnam

[PATCH] Eliminate Scalar::Util for something simpler

[Petr Baudis]

Dear diary, on Mon, Jul 03, 2006 at 10:48:03PM CEST, I got a letter
where Petr Baudis <pasky@suse.cz> said that...
> +		xs__call_gate(Scalar::Util::refaddr($self), $self->repo_path());

This was silly and requires Scalar::Util.

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

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

diff --git a/perl/Git.pm b/perl/Git.pm
index 65acaa7..f2467bd 100644
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -92,13 +92,14 @@ 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);
 
 }
 
+my $instance_id = 0;
+
 
 =head1 CONSTRUCTORS
 
@@ -216,7 +217,7 @@ sub repository {
 		delete $opts{Directory};
 	}
 
-	$self = { opts => \%opts };
+	$self = { opts => \%opts, id => $instance_id++ };
 	bless $self, $class;
 }
 
@@ -855,7 +856,7 @@ sub _call_gate {
 		# For now, when we will need to do it we could temporarily
 		# chdir() there and then chdir() back after the call is done.
 
-		xs__call_gate(Scalar::Util::refaddr($self), $self->repo_path());
+		xs__call_gate($self->{id}, $self->repo_path());
 	}
 
 	# Having to call throw from the C code is a sure path to insanity.

-- 
				Petr "Pasky" Baudis
Stuff: http://pasky.or.cz/
Snow falling on Perl. White noise covering line noise.
Hides all the bugs too. -- J. Putnam