diff options
Diffstat (limited to 'perl')
| -rw-r--r-- | perl/Git.pm | 157 |
1 files changed, 129 insertions, 28 deletions
diff --git a/perl/Git.pm b/perl/Git.pm index e2b66c4..7bbb5be 100644 --- a/perl/Git.pm +++ b/perl/Git.pm @@ -69,20 +69,18 @@ means getting an instance of the Git object using the repository() constructor. 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(); -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 @@ -93,6 +91,7 @@ increate nonwithstanding). 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); @@ -119,12 +118,17 @@ B<Repository> - Path to the Git 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. @@ -134,7 +138,10 @@ to the constructor; it is equivalent to setting only the C<Directory> option 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 @@ -152,18 +159,59 @@ sub repository { } 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 }; @@ -256,7 +304,7 @@ sub command_oneline { 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 { @@ -374,7 +422,7 @@ are involved. =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 @@ -385,6 +433,58 @@ are involved. # 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 ] ) @@ -584,8 +684,9 @@ sub _command_common_pipe { 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: $!"; |