Git.pm: Don't #define around die

diff --git a/perl/Git.pm b/perl/Git.pm
index 7bbb5be77e1731bd378307826078843f7785cbc2..b4ee88bdfdc9fd6050b3898d0dcb6040a68ae967 100644 (file)
--- a/perl/Git.pm
+++ b/perl/Git.pm
@@ -178,7 +178,8 @@ sub repository {
                };
 
                if ($dir) {
-                       $opts{Repository} = abs_path($dir);
+                       $dir =~ m#^/# or $dir = $opts{Directory} . '/' . $dir;
+                       $opts{Repository} = $dir;
 
                        # If --git-dir went ok, this shouldn't die either.
                        my $prefix = $search->command_oneline('rev-parse', '--show-prefix');
@@ -485,13 +486,13 @@ sub wc_chdir {
 }
 
 
-=item hash_object ( FILENAME [, TYPE ] )
+=item hash_object ( TYPE, FILENAME )
 
-=item hash_object ( FILEHANDLE [, TYPE ] )
+=item hash_object ( TYPE, FILEHANDLE )
 
 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>
-(default), C<commit>, C<tree>).
+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
@@ -510,7 +511,19 @@ sub wc_chdir {
 
 =cut
 
-# Implemented in Git.xs.
+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);
+       }
+}
 
 
 
@@ -663,18 +676,29 @@ sub _command_common_pipe {
        }
        _check_valid_cmd($cmd);
 
-       my $pid = open(my $fh, $direction);
-       if (not defined $pid) {
-               throw Error::Simple("open failed: $!");
-       } elsif ($pid == 0) {
-               if (defined $opts{STDERR}) {
-                       close STDERR;
-               }
-               if ($opts{STDERR}) {
-                       open (STDERR, '>&', $opts{STDERR})
-                               or die "dup failed: $!";
+       my $fh;
+       if ($^O eq '##INSERT_ACTIVESTATE_STRING_HERE##') {
+               # 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);
+
+       } else {
+               my $pid = open($fh, $direction);
+               if (not defined $pid) {
+                       throw Error::Simple("open failed: $!");
+               } elsif ($pid == 0) {
+                       if (defined $opts{STDERR}) {
+                               close STDERR;
+                       }
+                       if ($opts{STDERR}) {
+                               open (STDERR, '>&', $opts{STDERR})
+                                       or die "dup failed: $!";
+                       }
+                       _cmd_exec($self, $cmd, @args);
                }
-               _cmd_exec($self, $cmd, @args);
        }
        return wantarray ? ($fh, join(' ', $cmd, @args)) : $fh;
 }
@@ -749,4 +773,39 @@ sub AUTOLOAD {
 sub DESTROY { }
 
 
+# Pipe implementation for ActiveState Perl.
+
+package Git::activestate_pipe;
+use strict;
+
+sub TIEHANDLE {
+       my ($class, @params) = @_;
+       # 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};
+       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}});
+}
+
+
 1; # Famous last words