Don't yap about merge-subtree during make
[gitweb.git] / perl / Git.pm
index b4ee88bdfdc9fd6050b3898d0dcb6040a68ae967..b5b1cf5edcd860e88c461c600d3fa841654fef76 100644 (file)
@@ -63,7 +63,7 @@ =head1 DESCRIPTION
 the generic command interface.
 
 While some commands can be executed outside of any context (e.g. 'version'
-or 'init-db'), most operations require a repository context, which in practice
+or 'init'), most operations require a repository context, which in practice
 means getting an instance of the Git object using the repository() constructor.
 (In the future, we will also get a new_repository() constructor.) All commands
 called as methods of the object are then executed in the context of the
@@ -93,9 +93,6 @@ =head1 DESCRIPTION
 use Error qw(:try);
 use Cwd qw(abs_path);
 
-require XSLoader;
-XSLoader::load('Git', $VERSION);
-
 }
 
 
@@ -278,7 +275,7 @@ sub command {
 
        } else {
                my @lines = <$fh>;
-               chomp @lines;
+               defined and chomp for @lines;
                try {
                        _cmd_close($fh, $ctx);
                } catch Git::Error::Command with {
@@ -357,7 +354,7 @@ sub command_input_pipe {
 =item command_close_pipe ( PIPE [, CTX ] )
 
 Close the C<PIPE> as returned from C<command_*_pipe()>, checking
-whether the command finished successfuly. The optional C<CTX> argument
+whether the command finished successfully. The optional C<CTX> argument
 is required if you want to see the command name in the error message,
 and it is the second value returned by C<command_*_pipe()> when
 called in array context. The call idiom is:
@@ -413,12 +410,13 @@ sub command_noisy {
 
 Return the Git version in use.
 
-Implementation of this function is very fast; no external command calls
-are involved.
-
 =cut
 
-# Implemented in Git.xs.
+sub version {
+       my $verstr = command_oneline('--version');
+       $verstr =~ s/^git version //;
+       $verstr;
+}
 
 
 =item exec_path ()
@@ -426,12 +424,9 @@ sub command_noisy {
 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
-are involved.
-
 =cut
 
-# Implemented in Git.xs.
+sub exec_path { command_oneline('--exec-path') }
 
 
 =item repo_path ()
@@ -473,7 +468,6 @@ sub command_noisy {
 
 sub wc_chdir {
        my ($self, $subdir) = @_;
-
        $self->wc_path()
                or throw Error::Simple("bare repository");
 
@@ -486,43 +480,138 @@ sub wc_chdir {
 }
 
 
-=item hash_object ( TYPE, FILENAME )
+=item config ( VARIABLE )
+
+Retrieve the configuration C<VARIABLE> in the same manner as C<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('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('config', '--get-all', $var);
+               } else {
+                       return $self->command_oneline('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, FILEHANDLE )
+=item config_boolean ( VARIABLE )
+
+Retrieve the boolean configuration C<VARIABLE>.
+
+Must be called on a repository instance.
+
+This currently wraps command('config') so it is not so fast.
+
+=cut
+
+sub config_boolean {
+       my ($self, $var) = @_;
+       $self->repo_path()
+               or throw Error::Simple("not a repository");
+
+       try {
+               return $self->command_oneline('config', '--bool', '--get',
+                                             $var);
+       } catch Git::Error::Command with {
+               my $E = shift;
+               if ($E->value() == 1) {
+                       # Key not found.
+                       return undef;
+               } else {
+                       throw $E;
+               }
+       };
+}
+
+
+=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 )
 
 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>,
 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
-closed. The file handle should be freshly opened - if you have already
-read anything from the file handle, the results are undefined (since
-this function works directly with the file descriptor and internal
-PerlIO buffering might have messed things up).
-
 The method can be called without any instance or on a specified Git repository,
 it makes zero difference.
 
 The function returns the SHA1 hash.
 
-Implementation of this function is very fast; no external command calls
-are involved.
-
 =cut
 
+# TODO: Support for passing FILEHANDLE instead of FILENAME
 sub hash_object {
        my ($self, $type, $file) = _maybe_self(@_);
-
-       # hash_object_* implemented in Git.xs.
-
-       if (ref($file) eq 'GLOB') {
-               my $hash = hash_object_pipe($type, fileno($file));
-               close $file;
-               return $hash;
-       } else {
-               hash_object_file($type, $file);
-       }
+       command_oneline('hash-object', '-t', $type, $file);
 }
 
 
@@ -677,13 +766,19 @@ sub _command_common_pipe {
        _check_valid_cmd($cmd);
 
        my $fh;
-       if ($^O eq '##INSERT_ACTIVESTATE_STRING_HERE##') {
+       if ($^O eq 'MSWin32') {
                # 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);
+               # the strange construction with *ACPIPE is just to
+               # explain the tie below that we want to bind to
+               # a handle class, not scalar. It is not known if
+               # it is something specific to ActiveState Perl or
+               # just a Perl quirk.
+               tie (*ACPIPE, 'Git::activestate_pipe', $cmd, @args);
+               $fh = *ACPIPE;
 
        } else {
                my $pid = open($fh, $direction);
@@ -718,7 +813,7 @@ sub _cmd_exec {
 
 # Execute the given Git command ($_[0]) with arguments ($_[1..])
 # by searching for it at proper places.
-# _execv_git_cmd(), implemented in Git.xs.
+sub _execv_git_cmd { exec('git', @_); }
 
 # Close pipe to a subprocess.
 sub _cmd_close {
@@ -737,39 +832,6 @@ sub _cmd_close {
 }
 
 
-# Trickery for .xs routines: In order to avoid having some horrid
-# C code trying to do stuff with undefs and hashes, we gate all
-# xs calls through the following and in case we are being ran upon
-# an instance call a C part of the gate which will set up the
-# environment properly.
-sub _call_gate {
-       my $xsfunc = shift;
-       my ($self, @args) = _maybe_self(@_);
-
-       if (defined $self) {
-               # XXX: We ignore the WorkingCopy! To properly support
-               # that will require heavy changes in libgit.
-
-               # 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});
-       }
-
-       # Having to call throw from the C code is a sure path to insanity.
-       local $SIG{__DIE__} = sub { throw Error::Simple("@_"); };
-       &$xsfunc(@args);
-}
-
-sub AUTOLOAD {
-       my $xsname;
-       our $AUTOLOAD;
-       ($xsname = $AUTOLOAD) =~ s/.*:://;
-       throw Error::Simple("&Git::$xsname not defined") if $xsname =~ /^xs_/;
-       $xsname = 'xs_'.$xsname;
-       _call_gate(\&$xsname, @_);
-}
-
 sub DESTROY { }
 
 
@@ -783,8 +845,9 @@ sub TIEHANDLE {
        # 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};
+       # Let's just hope ActiveState Perl does at least the quoting
+       # correctly.
+       my @data = qx{git @params};
        bless { i => 0, data => \@data }, $class;
 }