Git.pm: Add support for subdirectories inside of working copies

This patch adds support for subdirectories inside of working copies;
you can specify them in the constructor either as the Directory
option (it will just get autodetected using rev-parse) or explicitly
using the WorkingSubdir option. This makes Git->repository() do the
exact same path setup and repository lookup as the Git porcelain
does.

This patch also introduces repo_path(), wc_path() and wc_subdir()
accessor methods and wc_chdir() mutator.

Signed-off-by: Petr Baudis <pasky@suse.cz>
Signed-off-by: Junio C Hamano <junkio@cox.net>

diff --git a/perl/Git.pm b/perl/Git.pm
index e2b66c461923934deef2bf096279c255dcf0c68e..7bbb5be77e1731bd378307826078843f7785cbc2 100644 (file)
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -69,20 +69,18 @@ =head1 DESCRIPTION
 called as methods of the object are then executed in the context of the
 repository.
 
 called as methods of the object are then executed in the context of the
 repository.
 

-TODO: In the future, we might also do
+Part of the "repository state" is also information about path to the attached
+working copy (unless you work with a bare repository). You can also navigate
+inside of the working copy using the C<wc_chdir()> method. (Note that
+the repository object is self-contained and will not change working directory
+of your process.)

 
 

-       my $subdir = $repo->subdir('Documentation');
-       # Gets called in the subdirectory context:
-       $subdir->command('status');
+TODO: In the future, we might also do

 
        my $remoterepo = $repo->remote_repository (Name => 'cogito', Branch => 'master');
        $remoterepo ||= Git->remote_repository ('http://git.or.cz/cogito.git/');
        my @refs = $remoterepo->refs();
 
 
        my $remoterepo = $repo->remote_repository (Name => 'cogito', Branch => 'master');
        $remoterepo ||= Git->remote_repository ('http://git.or.cz/cogito.git/');
        my @refs = $remoterepo->refs();
 

-So far, all functions just die if anything goes wrong. If you don't want that,
-make appropriate provisions to catch the possible deaths. Better error recovery
-mechanisms will be provided in the future.
-

 Currently, the module merely wraps calls to external Git tools. In the future,
 it will provide a much faster way to interact with Git by linking directly
 to libgit. This should be completely opaque to the user, though (performance
 Currently, the module merely wraps calls to external Git tools. In the future,
 it will provide a much faster way to interact with Git by linking directly
 to libgit. This should be completely opaque to the user, though (performance


@@ -93,6 +91,7 @@ =head1 DESCRIPTION
 
 use Carp qw(carp croak); # but croak is bad - throw instead
 use Error qw(:try);
 
 use Carp qw(carp croak); # but croak is bad - throw instead
 use Error qw(:try);

+use Cwd qw(abs_path);

 
 require XSLoader;
 XSLoader::load('Git', $VERSION);
 
 require XSLoader;
 XSLoader::load('Git', $VERSION);


@@ -119,12 +118,17 @@ =head1 CONSTRUCTORS
 B<WorkingCopy> - Path to the associated working copy; not strictly required
 as many commands will happily crunch on a bare repository.
 
 B<WorkingCopy> - Path to the associated working copy; not strictly required
 as many commands will happily crunch on a bare repository.
 

-B<Directory> - Path to the Git working directory in its usual setup. This
-is just for convenient setting of both C<Repository> and C<WorkingCopy>
-at once: If the directory as a C<.git> subdirectory, C<Repository> is pointed
-to the subdirectory and the directory is assumed to be the working copy.
-If the directory does not have the subdirectory, C<WorkingCopy> is left
-undefined and C<Repository> is pointed to the directory itself.
+B<WorkingSubdir> - Subdirectory in the working copy to work inside.
+Just left undefined if you do not want to limit the scope of operations.
+
+B<Directory> - Path to the Git working directory in its usual setup.
+The C<.git> directory is searched in the directory and all the parent
+directories; if found, C<WorkingCopy> is set to the directory containing
+it and C<Repository> to the C<.git> directory itself. If no C<.git>
+directory was found, the C<Directory> is assumed to be a bare repository,
+C<Repository> is set to point at it and C<WorkingCopy> is left undefined.
+If the C<$GIT_DIR> environment variable is set, things behave as expected
+as well.

 
 You should not use both C<Directory> and either of C<Repository> and
 C<WorkingCopy> - the results of that are undefined.
 
 You should not use both C<Directory> and either of C<Repository> and
 C<WorkingCopy> - the results of that are undefined.


@@ -134,7 +138,10 @@ =head1 CONSTRUCTORS
 field.
 
 Calling the constructor with no options whatsoever is equivalent to
 field.
 
 Calling the constructor with no options whatsoever is equivalent to

-calling it with C<< Directory => '.' >>.
+calling it with C<< Directory => '.' >>. In general, if you are building
+a standard porcelain command, simply doing C<< Git->repository() >> should
+do the right thing and setup the object to reflect exactly where the user
+is right now.

 
 =cut
 
 
 =cut
 


@@ -152,18 +159,59 @@ sub repository {
                } else {
                        %opts = @args;
                }
                } else {
                        %opts = @args;
                }

+       }
+
+       if (not defined $opts{Repository} and not defined $opts{WorkingCopy}) {
+               $opts{Directory} ||= '.';
+       }
+
+       if ($opts{Directory}) {
+               -d $opts{Directory} or throw Error::Simple("Directory not found: $!");
+
+               my $search = Git->repository(WorkingCopy => $opts{Directory});
+               my $dir;
+               try {
+                       $dir = $search->command_oneline(['rev-parse', '--git-dir'],
+                                                       STDERR => 0);
+               } catch Git::Error::Command with {
+                       $dir = undef;
+               };

 
 

-               if ($opts{Directory}) {
-                       -d $opts{Directory} or throw Error::Simple("Directory not found: $!");
-                       if (-d $opts{Directory}."/.git") {
-                               # TODO: Might make this more clever
-                               $opts{WorkingCopy} = $opts{Directory};
-                               $opts{Repository} = $opts{Directory}."/.git";
-                       } else {
-                               $opts{Repository} = $opts{Directory};
+               if ($dir) {
+                       $opts{Repository} = abs_path($dir);
+
+                       # If --git-dir went ok, this shouldn't die either.
+                       my $prefix = $search->command_oneline('rev-parse', '--show-prefix');
+                       $dir = abs_path($opts{Directory}) . '/';
+                       if ($prefix) {
+                               if (substr($dir, -length($prefix)) ne $prefix) {
+                                       throw Error::Simple("rev-parse confused me - $dir does not have trailing $prefix");
+                               }
+                               substr($dir, -length($prefix)) = '';

                        }
                        }

-                       delete $opts{Directory};
+                       $opts{WorkingCopy} = $dir;
+                       $opts{WorkingSubdir} = $prefix;
+
+               } else {
+                       # A bare repository? Let's see...
+                       $dir = $opts{Directory};
+
+                       unless (-d "$dir/refs" and -d "$dir/objects" and -e "$dir/HEAD") {
+                               # Mimick git-rev-parse --git-dir error message:
+                               throw Error::Simple('fatal: Not a git repository');
+                       }
+                       my $search = Git->repository(Repository => $dir);
+                       try {
+                               $search->command('symbolic-ref', 'HEAD');
+                       } catch Git::Error::Command with {
+                               # Mimick git-rev-parse --git-dir error message:
+                               throw Error::Simple('fatal: Not a git repository');
+                       }
+
+                       $opts{Repository} = abs_path($dir);

                }
                }

+
+               delete $opts{Directory};

        }
 
        $self = { opts => \%opts };
        }
 
        $self = { opts => \%opts };


@@ -256,7 +304,7 @@ sub command_oneline {
        my ($fh, $ctx) = command_output_pipe(@_);
 
        my $line = <$fh>;
        my ($fh, $ctx) = command_output_pipe(@_);
 
        my $line = <$fh>;

-       chomp $line;
+       defined $line and chomp $line;

        try {
                _cmd_close($fh, $ctx);
        } catch Git::Error::Command with {
        try {
                _cmd_close($fh, $ctx);
        } catch Git::Error::Command with {


@@ -374,7 +422,7 @@ sub command_noisy {
 
 =item exec_path ()
 
 
 =item exec_path ()
 

-Return path to the git sub-command executables (the same as
+Return path to the Git sub-command executables (the same as

 C<git --exec-path>). Useful mostly only internally.
 
 Implementation of this function is very fast; no external command calls
 C<git --exec-path>). Useful mostly only internally.
 
 Implementation of this function is very fast; no external command calls


@@ -385,6 +433,58 @@ sub command_noisy {
 # Implemented in Git.xs.
 
 
 # Implemented in Git.xs.
 
 

+=item repo_path ()
+
+Return path to the git repository. Must be called on a repository instance.
+
+=cut
+
+sub repo_path { $_[0]->{opts}->{Repository} }
+
+
+=item wc_path ()
+
+Return path to the working copy. Must be called on a repository instance.
+
+=cut
+
+sub wc_path { $_[0]->{opts}->{WorkingCopy} }
+
+
+=item wc_subdir ()
+
+Return path to the subdirectory inside of a working copy. Must be called
+on a repository instance.
+
+=cut
+
+sub wc_subdir { $_[0]->{opts}->{WorkingSubdir} ||= '' }
+
+
+=item wc_chdir ( SUBDIR )
+
+Change the working copy subdirectory to work within. The C<SUBDIR> is
+relative to the working copy root directory (not the current subdirectory).
+Must be called on a repository instance attached to a working copy
+and the directory must exist.
+
+=cut
+
+sub wc_chdir {
+       my ($self, $subdir) = @_;
+
+       $self->wc_path()
+               or throw Error::Simple("bare repository");
+
+       -d $self->wc_path().'/'.$subdir
+               or throw Error::Simple("subdir not found: $!");
+       # Of course we will not "hold" the subdirectory so anyone
+       # can delete it now and we will never know. But at least we tried.
+
+       $self->{opts}->{WorkingSubdir} = $subdir;
+}
+
+

 =item hash_object ( FILENAME [, TYPE ] )
 
 =item hash_object ( FILEHANDLE [, TYPE ] )
 =item hash_object ( FILENAME [, TYPE ] )
 
 =item hash_object ( FILEHANDLE [, TYPE ] )


@@ -584,8 +684,9 @@ sub _command_common_pipe {
 sub _cmd_exec {
        my ($self, @args) = @_;
        if ($self) {
 sub _cmd_exec {
        my ($self, @args) = @_;
        if ($self) {

-               $self->{opts}->{Repository} and $ENV{'GIT_DIR'} = $self->{opts}->{Repository};
-               $self->{opts}->{WorkingCopy} and chdir($self->{opts}->{WorkingCopy});
+               $self->repo_path() and $ENV{'GIT_DIR'} = $self->repo_path();
+               $self->wc_path() and chdir($self->wc_path());
+               $self->wc_subdir() and chdir($self->wc_subdir());

        }
        _execv_git_cmd(@args);
        die "exec failed: $!";
        }
        _execv_git_cmd(@args);
        die "exec failed: $!";