Add a utility library for convenience methods

Add tests for utils

Update changes

Author: kentfredric

CHANGES

@@ -1,5 +1,8 @@
 Revision history for Perl module Git::PurePerl:
 
+0.49
+     - Add Git::PurePerl::Util with handy current_git_dir() util (Kent Fredric)
+
 0.48 Thu Jul 14 22:53:55 BST 2011
      - Translation from Digest::SHA1 to Digest::SHA (Jonas Genannt)
      - A git object can also be of zero size. (Christian Walde)

lib/Git/PurePerl/Util.pm

@@ -0,0 +1,97 @@
+use strict;
+use warnings;
+
+package Git::PurePerl::Util;
+
+# FILENAME: Util.pm
+# CREATED: 29/05/12 21:46:21 by Kent Fredric (kentnl) <[email protected]>
+# ABSTRACT: Helper tools for Git::PurePerl
+
+use Sub::Exporter -setup => {
+    exports => [qw( current_git_dir find_git_dir is_git_dir )],
+    groups  => { default => [qw( current_git_dir )], },
+};
+use Path::Class qw( dir );
+
+=head1 SYNOPSIS
+
+	use Git::PurePerl::Util;
+	use Git::PurePerl;
+
+	my $repo = Git::PurePerl->new(
+		gitdir => current_git_dir(),
+	);
+
+=cut
+
+=head1 FUNCTIONS
+
+=head2 is_git_dir
+
+Determines if the given C<$dir> has the basic requirements of a Git repository dir.
+
+( ie: either a checkouts C<.git> folder, or a bare repository )
+
+	if ( is_git_dir( $dir ) ) {
+		...
+	}
+
+=cut
+
+sub is_git_dir {
+    my ($dir) = @_;
+    return if not -e $dir->subdir('objects');
+    return if not -e $dir->subdir('refs');
+    return if not -e $dir->file('HEAD');
+    return 1;
+}
+
+=head2 find_git_dir
+
+	my $dir = find_git_dir( $subdir );
+
+Finds the closest C<.git> or bare tree that is either at C<$subdir> or somewhere above C<$subdir>
+
+If C<$subdir> is inside a 'bare' repo, returns the path to that repo.
+
+If C<$subdir> is inside a checkout, returns the path to the checkouts C<.git> dir.
+
+If C<$subdir> is not inside a git repo, returns a false value.
+
+=cut
+
+sub find_git_dir {
+    my $start = shift;
+
+    return $start if is_git_dir($start);
+
+    my $repodir = $start->subdir('.git');
+
+    return $repodir if -e $repodir and is_git_dir($repodir);
+
+    return find_git_dir( $start->parent )
+      if $start->parent->absolute ne $start->absolute;
+
+    return undef;
+}
+
+=head2 current_git_dir
+
+Finds the closest C<.git> or bare tree by walking up parents.
+
+	my $git_dir = current_git_dir();
+
+If C<$CWD> is inside a bare repo somewhere, it will return the path to the bare repo root directory.
+
+If C<$CWD> is inside a git checkout, it will return the path to the C<.git> folder of that checkout.
+
+If C<$CWD> is not inside any recognisable git repo, will return a false value.
+
+=cut
+
+sub current_git_dir {
+    return find_git_dir( dir('.') );
+}
+
+1;
+

t/00_setup.t

@@ -4,7 +4,7 @@ use warnings;
 use Test::More;
 use Archive::Extract;
 
-foreach my $name qw(test-project test-project-packs test-project-packs2 test-encoding) {
+foreach my $name (qw(test-project test-project-packs test-project-packs2 test-encoding test-util)) {
     next if -d $name;
     my $ae = Archive::Extract->new( archive => "$name.tgz" );
     $ae->extract;

t/09_util.t

@@ -0,0 +1,68 @@
+#!perl
+use strict;
+use warnings;
+use Test::More;
+use Git::PurePerl;
+use Path::Class;
+
+use Git::PurePerl::Util qw( find_git_dir current_git_dir );
+
+foreach my $directory (qw(test-project test-project-packs test-project-packs2))
+{
+    my $dir = dir($directory);
+    my $gd  = find_git_dir( dir($directory) );
+
+    is(
+        $gd->absolute->stringify,
+        dir($directory)->subdir('.git')->absolute->stringify,
+        "Correctly resolves an .git from a repo( $directory )"
+    );
+
+}
+
+foreach my $directory (
+    qw(
+    test-util/deep
+    test-util/deep/.git
+    test-util/deep/stage1
+    test-util/deep/stage1/stage2/
+    )
+  )
+{
+    is(
+        find_git_dir( dir($directory) )->absolute->stringify,
+        dir('test-util/deep/.git')->absolute->stringify,
+        "finding .git dirs works at all tree levels ( $directory )"
+    );
+}
+
+foreach my $directory (
+    qw(
+    test-util/bare
+    test-util/bare/info
+    test-util/bare/objects
+    test-util/bare/refs
+    test-util/bare/refs/heads
+    )
+  )
+{
+    is(
+        find_git_dir( dir($directory) )->absolute->stringify,
+        dir('test-util/bare')->absolute->stringify,
+        "finding bare dirs works at all tree levels ( $directory )"
+    );
+}
+
+use Cwd qw( getcwd );
+
+my $old_dir = getcwd;
+
+chdir "test-util/deep/stage1";
+
+is(
+    current_git_dir()->absolute->stringify,
+    dir('.')->parent->subdir('.git')->absolute->stringify,
+    "Can work with CWD"
+);
+
+done_testing;