perl/Git.pm

   1 =head1 NAME
   2
   3 Git - Perl interface to the Git version control system
   4
   5 =cut
   6
   7
   8 package Git;
   9
  10 use strict;
  11
  12
  13 BEGIN {
  14
  15 our ($VERSION, @ISA, @EXPORT, @EXPORT_OK);
  16
  17 # Totally unstable API.
  18 $VERSION = '0.01';
  19
  20
  21 =head1 SYNOPSIS
  22
  23   use Git;
  24
  25   my $version = Git::command_oneline('version');
  26
  27   git_cmd_try { Git::command_noisy('update-server-info') }
  28               '%s failed w/ code %d';
  29
  30   my $repo = Git->repository (Directory => '/srv/git/cogito.git');
  31
  32
  33   my @revs = $repo->command('rev-list', '--since=last monday', '--all');
  34
  35   my ($fh, $c) = $repo->command_output_pipe('rev-list', '--since=last monday', '--all');
  36   my $lastrev = <$fh>; chomp $lastrev;
  37   $repo->command_close_pipe($fh, $c);
  38
  39   my $lastrev = $repo->command_oneline( [ 'rev-list', '--all' ],
  40                                         STDERR => 0 );
  41
  42 =cut
  43
  44
  45 require Exporter;
  46
  47 @ISA = qw(Exporter);
  48
  49 @EXPORT = qw(git_cmd_try);
  50
  51 # Methods which can be called as standalone functions as well:
  52 @EXPORT_OK = qw(command command_oneline command_noisy
  53                 command_output_pipe command_input_pipe command_close_pipe
  54                 version exec_path hash_object git_cmd_try);
  55
  56
  57 =head1 DESCRIPTION
  58
  59 This module provides Perl scripts easy way to interface the Git version control
  60 system. The modules have an easy and well-tested way to call arbitrary Git
  61 commands; in the future, the interface will also provide specialized methods
  62 for doing easily operations which are not totally trivial to do over
  63 the generic command interface.
  64
  65 While some commands can be executed outside of any context (e.g. 'version'
  66 or 'init-db'), most operations require a repository context, which in practice
  67 means getting an instance of the Git object using the repository() constructor.
  68 (In the future, we will also get a new_repository() constructor.) All commands
  69 called as methods of the object are then executed in the context of the
  70 repository.
  71
  72 Part of the "repository state" is also information about path to the attached
  73 working copy (unless you work with a bare repository). You can also navigate
  74 inside of the working copy using the C<wc_chdir()> method. (Note that
  75 the repository object is self-contained and will not change working directory
  76 of your process.)
  77
  78 TODO: In the future, we might also do
  79
  80         my $remoterepo = $repo->remote_repository (Name => 'cogito', Branch => 'master');
  81         $remoterepo ||= Git->remote_repository ('http://git.or.cz/cogito.git/');
  82         my @refs = $remoterepo->refs();
  83
  84 Currently, the module merely wraps calls to external Git tools. In the future,
  85 it will provide a much faster way to interact with Git by linking directly
  86 to libgit. This should be completely opaque to the user, though (performance
  87 increate nonwithstanding).
  88
  89 =cut
  90
  91
  92 use Carp qw(carp croak); # but croak is bad - throw instead
  93 use Error qw(:try);
  94 use Cwd qw(abs_path);
  95
  96 require XSLoader;
  97 XSLoader::load('Git', $VERSION);
  98
  99 }
 100
 101
 102 =head1 CONSTRUCTORS
 103
 104 =over 4
 105
 106 =item repository ( OPTIONS )
 107
 108 =item repository ( DIRECTORY )
 109
 110 =item repository ()
 111
 112 Construct a new repository object.
 113 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
 114 Possible options are:
 115
 116 B<Repository> - Path to the Git repository.
 117
 118 B<WorkingCopy> - Path to the associated working copy; not strictly required
 119 as many commands will happily crunch on a bare repository.
 120
 121 B<WorkingSubdir> - Subdirectory in the working copy to work inside.
 122 Just left undefined if you do not want to limit the scope of operations.
 123
 124 B<Directory> - Path to the Git working directory in its usual setup.
 125 The C<.git> directory is searched in the directory and all the parent
 126 directories; if found, C<WorkingCopy> is set to the directory containing
 127 it and C<Repository> to the C<.git> directory itself. If no C<.git>
 128 directory was found, the C<Directory> is assumed to be a bare repository,
 129 C<Repository> is set to point at it and C<WorkingCopy> is left undefined.
 130 If the C<$GIT_DIR> environment variable is set, things behave as expected
 131 as well.
 132
 133 You should not use both C<Directory> and either of C<Repository> and
 134 C<WorkingCopy> - the results of that are undefined.
 135
 136 Alternatively, a directory path may be passed as a single scalar argument
 137 to the constructor; it is equivalent to setting only the C<Directory> option
 138 field.
 139
 140 Calling the constructor with no options whatsoever is equivalent to
 141 calling it with C<< Directory => '.' >>. In general, if you are building
 142 a standard porcelain command, simply doing C<< Git->repository() >> should
 143 do the right thing and setup the object to reflect exactly where the user
 144 is right now.
 145
 146 =cut
 147
 148 sub repository {
 149         my $class = shift;
 150         my @args = @_;
 151         my %opts = ();
 152         my $self;
 153
 154         if (defined $args[0]) {
 155                 if ($#args % 2 != 1) {
 156                         # Not a hash.
 157                         $#args == 0 or throw Error::Simple("bad usage");
 158                         %opts = ( Directory => $args[0] );
 159                 } else {
 160                         %opts = @args;
 161                 }
 162         }
 163
 164         if (not defined $opts{Repository} and not defined $opts{WorkingCopy}) {
 165                 $opts{Directory} ||= '.';
 166         }
 167
 168         if ($opts{Directory}) {
 169                 -d $opts{Directory} or throw Error::Simple("Directory not found: $!");
 170
 171                 my $search = Git->repository(WorkingCopy => $opts{Directory});
 172                 my $dir;
 173                 try {
 174                         $dir = $search->command_oneline(['rev-parse', '--git-dir'],
 175                                                         STDERR => 0);
 176                 } catch Git::Error::Command with {
 177                         $dir = undef;
 178                 };
 179
 180                 if ($dir) {
 181                         $dir =~ m#^/# or $dir = $opts{Directory} . '/' . $dir;
 182                         $opts{Repository} = $dir;
 183
 184                         # If --git-dir went ok, this shouldn't die either.
 185                         my $prefix = $search->command_oneline('rev-parse', '--show-prefix');
 186                         $dir = abs_path($opts{Directory}) . '/';
 187                         if ($prefix) {
 188                                 if (substr($dir, -length($prefix)) ne $prefix) {
 189                                         throw Error::Simple("rev-parse confused me - $dir does not have trailing $prefix");
 190                                 }
 191                                 substr($dir, -length($prefix)) = '';
 192                         }
 193                         $opts{WorkingCopy} = $dir;
 194                         $opts{WorkingSubdir} = $prefix;
 195
 196                 } else {
 197                         # A bare repository? Let's see...
 198                         $dir = $opts{Directory};
 199
 200                         unless (-d "$dir/refs" and -d "$dir/objects" and -e "$dir/HEAD") {
 201                                 # Mimick git-rev-parse --git-dir error message:
 202                                 throw Error::Simple('fatal: Not a git repository');
 203                         }
 204                         my $search = Git->repository(Repository => $dir);
 205                         try {
 206                                 $search->command('symbolic-ref', 'HEAD');
 207                         } catch Git::Error::Command with {
 208                                 # Mimick git-rev-parse --git-dir error message:
 209                                 throw Error::Simple('fatal: Not a git repository');
 210                         }
 211
 212                         $opts{Repository} = abs_path($dir);
 213                 }
 214
 215                 delete $opts{Directory};
 216         }
 217
 218         $self = { opts => \%opts };
 219         bless $self, $class;
 220 }
 221
 222
 223 =back
 224
 225 =head1 METHODS
 226
 227 =over 4
 228
 229 =item command ( COMMAND [, ARGUMENTS... ] )
 230
 231 =item command ( [ COMMAND, ARGUMENTS... ], { Opt => Val ... } )
 232
 233 Execute the given Git C<COMMAND> (specify it without the 'git-'
 234 prefix), optionally with the specified extra C<ARGUMENTS>.
 235
 236 The second more elaborate form can be used if you want to further adjust
 237 the command execution. Currently, only one option is supported:
 238
 239 B<STDERR> - How to deal with the command's error output. By default (C<undef>)
 240 it is delivered to the caller's C<STDERR>. A false value (0 or '') will cause
 241 it to be thrown away. If you want to process it, you can get it in a filehandle
 242 you specify, but you must be extremely careful; if the error output is not
 243 very short and you want to read it in the same process as where you called
 244 C<command()>, you are set up for a nice deadlock!
 245
 246 The method can be called without any instance or on a specified Git repository
 247 (in that case the command will be run in the repository context).
 248
 249 In scalar context, it returns all the command output in a single string
 250 (verbatim).
 251
 252 In array context, it returns an array containing lines printed to the
 253 command's stdout (without trailing newlines).
 254
 255 In both cases, the command's stdin and stderr are the same as the caller's.
 256
 257 =cut
 258
 259 sub command {
 260         my ($fh, $ctx) = command_output_pipe(@_);
 261
 262         if (not defined wantarray) {
 263                 # Nothing to pepper the possible exception with.
 264                 _cmd_close($fh, $ctx);
 265
 266         } elsif (not wantarray) {
 267                 local $/;
 268                 my $text = <$fh>;
 269                 try {
 270                         _cmd_close($fh, $ctx);
 271                 } catch Git::Error::Command with {
 272                         # Pepper with the output:
 273                         my $E = shift;
 274                         $E->{'-outputref'} = \$text;
 275                         throw $E;
 276                 };
 277                 return $text;
 278
 279         } else {
 280                 my @lines = <$fh>;
 281                 chomp @lines;
 282                 try {
 283                         _cmd_close($fh, $ctx);
 284                 } catch Git::Error::Command with {
 285                         my $E = shift;
 286                         $E->{'-outputref'} = \@lines;
 287                         throw $E;
 288                 };
 289                 return @lines;
 290         }
 291 }
 292
 293
 294 =item command_oneline ( COMMAND [, ARGUMENTS... ] )
 295
 296 =item command_oneline ( [ COMMAND, ARGUMENTS... ], { Opt => Val ... } )
 297
 298 Execute the given C<COMMAND> in the same way as command()
 299 does but always return a scalar string containing the first line
 300 of the command's standard output.
 301
 302 =cut
 303
 304 sub command_oneline {
 305         my ($fh, $ctx) = command_output_pipe(@_);
 306
 307         my $line = <$fh>;
 308         defined $line and chomp $line;
 309         try {
 310                 _cmd_close($fh, $ctx);
 311         } catch Git::Error::Command with {
 312                 # Pepper with the output:
 313                 my $E = shift;
 314                 $E->{'-outputref'} = \$line;
 315                 throw $E;
 316         };
 317         return $line;
 318 }
 319
 320
 321 =item command_output_pipe ( COMMAND [, ARGUMENTS... ] )
 322
 323 =item command_output_pipe ( [ COMMAND, ARGUMENTS... ], { Opt => Val ... } )
 324
 325 Execute the given C<COMMAND> in the same way as command()
 326 does but return a pipe filehandle from which the command output can be
 327 read.
 328
 329 The function can return C<($pipe, $ctx)> in array context.
 330 See C<command_close_pipe()> for details.
 331
 332 =cut
 333
 334 sub command_output_pipe {
 335         _command_common_pipe('-|', @_);
 336 }
 337
 338
 339 =item command_input_pipe ( COMMAND [, ARGUMENTS... ] )
 340
 341 =item command_input_pipe ( [ COMMAND, ARGUMENTS... ], { Opt => Val ... } )
 342
 343 Execute the given C<COMMAND> in the same way as command_output_pipe()
 344 does but return an input pipe filehandle instead; the command output
 345 is not captured.
 346
 347 The function can return C<($pipe, $ctx)> in array context.
 348 See C<command_close_pipe()> for details.
 349
 350 =cut
 351
 352 sub command_input_pipe {
 353         _command_common_pipe('|-', @_);
 354 }
 355
 356
 357 =item command_close_pipe ( PIPE [, CTX ] )
 358
 359 Close the C<PIPE> as returned from C<command_*_pipe()>, checking
 360 whether the command finished successfuly. The optional C<CTX> argument
 361 is required if you want to see the command name in the error message,
 362 and it is the second value returned by C<command_*_pipe()> when
 363 called in array context. The call idiom is:
 364
 365         my ($fh, $ctx) = $r->command_output_pipe('status');
 366         while (<$fh>) { ... }
 367         $r->command_close_pipe($fh, $ctx);
 368
 369 Note that you should not rely on whatever actually is in C<CTX>;
 370 currently it is simply the command name but in future the context might
 371 have more complicated structure.
 372
 373 =cut
 374
 375 sub command_close_pipe {
 376         my ($self, $fh, $ctx) = _maybe_self(@_);
 377         $ctx ||= '<unknown>';
 378         _cmd_close($fh, $ctx);
 379 }
 380
 381
 382 =item command_noisy ( COMMAND [, ARGUMENTS... ] )
 383
 384 Execute the given C<COMMAND> in the same way as command() does but do not
 385 capture the command output - the standard output is not redirected and goes
 386 to the standard output of the caller application.
 387
 388 While the method is called command_noisy(), you might want to as well use
 389 it for the most silent Git commands which you know will never pollute your
 390 stdout but you want to avoid the overhead of the pipe setup when calling them.
 391
 392 The function returns only after the command has finished running.
 393
 394 =cut
 395
 396 sub command_noisy {
 397         my ($self, $cmd, @args) = _maybe_self(@_);
 398         _check_valid_cmd($cmd);
 399
 400         my $pid = fork;
 401         if (not defined $pid) {
 402                 throw Error::Simple("fork failed: $!");
 403         } elsif ($pid == 0) {
 404                 _cmd_exec($self, $cmd, @args);
 405         }
 406         if (waitpid($pid, 0) > 0 and $?>>8 != 0) {
 407                 throw Git::Error::Command(join(' ', $cmd, @args), $? >> 8);
 408         }
 409 }
 410
 411
 412 =item version ()
 413
 414 Return the Git version in use.
 415
 416 Implementation of this function is very fast; no external command calls
 417 are involved.
 418
 419 =cut
 420
 421 # Implemented in Git.xs.
 422
 423
 424 =item exec_path ()
 425
 426 Return path to the Git sub-command executables (the same as
 427 C<git --exec-path>). Useful mostly only internally.
 428
 429 Implementation of this function is very fast; no external command calls
 430 are involved.
 431
 432 =cut
 433
 434 # Implemented in Git.xs.
 435
 436
 437 =item repo_path ()
 438
 439 Return path to the git repository. Must be called on a repository instance.
 440
 441 =cut
 442
 443 sub repo_path { $_[0]->{opts}->{Repository} }
 444
 445
 446 =item wc_path ()
 447
 448 Return path to the working copy. Must be called on a repository instance.
 449
 450 =cut
 451
 452 sub wc_path { $_[0]->{opts}->{WorkingCopy} }
 453
 454
 455 =item wc_subdir ()
 456
 457 Return path to the subdirectory inside of a working copy. Must be called
 458 on a repository instance.
 459
 460 =cut
 461
 462 sub wc_subdir { $_[0]->{opts}->{WorkingSubdir} ||= '' }
 463
 464
 465 =item wc_chdir ( SUBDIR )
 466
 467 Change the working copy subdirectory to work within. The C<SUBDIR> is
 468 relative to the working copy root directory (not the current subdirectory).
 469 Must be called on a repository instance attached to a working copy
 470 and the directory must exist.
 471
 472 =cut
 473
 474 sub wc_chdir {
 475         my ($self, $subdir) = @_;
 476
 477         $self->wc_path()
 478                 or throw Error::Simple("bare repository");
 479
 480         -d $self->wc_path().'/'.$subdir
 481                 or throw Error::Simple("subdir not found: $!");
 482         # Of course we will not "hold" the subdirectory so anyone
 483         # can delete it now and we will never know. But at least we tried.
 484
 485         $self->{opts}->{WorkingSubdir} = $subdir;
 486 }
 487
 488
 489 =item hash_object ( TYPE, FILENAME )
 490
 491 =item hash_object ( TYPE, FILEHANDLE )
 492
 493 Compute the SHA1 object id of the given C<FILENAME> (or data waiting in
 494 C<FILEHANDLE>) considering it is of the C<TYPE> object type (C<blob>,
 495 C<commit>, C<tree>).
 496
 497 In case of C<FILEHANDLE> passed instead of file name, all the data
 498 available are read and hashed, and the filehandle is automatically
 499 closed. The file handle should be freshly opened - if you have already
 500 read anything from the file handle, the results are undefined (since
 501 this function works directly with the file descriptor and internal
 502 PerlIO buffering might have messed things up).
 503
 504 The method can be called without any instance or on a specified Git repository,
 505 it makes zero difference.
 506
 507 The function returns the SHA1 hash.
 508
 509 Implementation of this function is very fast; no external command calls
 510 are involved.
 511
 512 =cut
 513
 514 # Implemented in Git.xs.
 515
 516
 517
 518 =back
 519
 520 =head1 ERROR HANDLING
 521
 522 All functions are supposed to throw Perl exceptions in case of errors.
 523 See the L<Error> module on how to catch those. Most exceptions are mere
 524 L<Error::Simple> instances.
 525
 526 However, the C<command()>, C<command_oneline()> and C<command_noisy()>
 527 functions suite can throw C<Git::Error::Command> exceptions as well: those are
 528 thrown when the external command returns an error code and contain the error
 529 code as well as access to the captured command's output. The exception class
 530 provides the usual C<stringify> and C<value> (command's exit code) methods and
 531 in addition also a C<cmd_output> method that returns either an array or a
 532 string with the captured command output (depending on the original function
 533 call context; C<command_noisy()> returns C<undef>) and $<cmdline> which
 534 returns the command and its arguments (but without proper quoting).
 535
 536 Note that the C<command_*_pipe()> functions cannot throw this exception since
 537 it has no idea whether the command failed or not. You will only find out
 538 at the time you C<close> the pipe; if you want to have that automated,
 539 use C<command_close_pipe()>, which can throw the exception.
 540
 541 =cut
 542
 543 {
 544         package Git::Error::Command;
 545
 546         @Git::Error::Command::ISA = qw(Error);
 547
 548         sub new {
 549                 my $self = shift;
 550                 my $cmdline = '' . shift;
 551                 my $value = 0 + shift;
 552                 my $outputref = shift;
 553                 my(@args) = ();
 554
 555                 local $Error::Depth = $Error::Depth + 1;
 556
 557                 push(@args, '-cmdline', $cmdline);
 558                 push(@args, '-value', $value);
 559                 push(@args, '-outputref', $outputref);
 560
 561                 $self->SUPER::new(-text => 'command returned error', @args);
 562         }
 563
 564         sub stringify {
 565                 my $self = shift;
 566                 my $text = $self->SUPER::stringify;
 567                 $self->cmdline() . ': ' . $text . ': ' . $self->value() . "\n";
 568         }
 569
 570         sub cmdline {
 571                 my $self = shift;
 572                 $self->{'-cmdline'};
 573         }
 574
 575         sub cmd_output {
 576                 my $self = shift;
 577                 my $ref = $self->{'-outputref'};
 578                 defined $ref or undef;
 579                 if (ref $ref eq 'ARRAY') {
 580                         return @$ref;
 581                 } else { # SCALAR
 582                         return $$ref;
 583                 }
 584         }
 585 }
 586
 587 =over 4
 588
 589 =item git_cmd_try { CODE } ERRMSG
 590
 591 This magical statement will automatically catch any C<Git::Error::Command>
 592 exceptions thrown by C<CODE> and make your program die with C<ERRMSG>
 593 on its lips; the message will have %s substituted for the command line
 594 and %d for the exit status. This statement is useful mostly for producing
 595 more user-friendly error messages.
 596
 597 In case of no exception caught the statement returns C<CODE>'s return value.
 598
 599 Note that this is the only auto-exported function.
 600
 601 =cut
 602
 603 sub git_cmd_try(&$) {
 604         my ($code, $errmsg) = @_;
 605         my @result;
 606         my $err;
 607         my $array = wantarray;
 608         try {
 609                 if ($array) {
 610                         @result = &$code;
 611                 } else {
 612                         $result[0] = &$code;
 613                 }
 614         } catch Git::Error::Command with {
 615                 my $E = shift;
 616                 $err = $errmsg;
 617                 $err =~ s/\%s/$E->cmdline()/ge;
 618                 $err =~ s/\%d/$E->value()/ge;
 619                 # We can't croak here since Error.pm would mangle
 620                 # that to Error::Simple.
 621         };
 622         $err and croak $err;
 623         return $array ? @result : $result[0];
 624 }
 625
 626
 627 =back
 628
 629 =head1 COPYRIGHT
 630
 631 Copyright 2006 by Petr Baudis E<lt>pasky@suse.czE<gt>.
 632
 633 This module is free software; it may be used, copied, modified
 634 and distributed under the terms of the GNU General Public Licence,
 635 either version 2, or (at your option) any later version.
 636
 637 =cut
 638
 639
 640 # Take raw method argument list and return ($obj, @args) in case
 641 # the method was called upon an instance and (undef, @args) if
 642 # it was called directly.
 643 sub _maybe_self {
 644         # This breaks inheritance. Oh well.
 645         ref $_[0] eq 'Git' ? @_ : (undef, @_);
 646 }
 647
 648 # Check if the command id is something reasonable.
 649 sub _check_valid_cmd {
 650         my ($cmd) = @_;
 651         $cmd =~ /^[a-z0-9A-Z_-]+$/ or throw Error::Simple("bad command: $cmd");
 652 }
 653
 654 # Common backend for the pipe creators.
 655 sub _command_common_pipe {
 656         my $direction = shift;
 657         my ($self, @p) = _maybe_self(@_);
 658         my (%opts, $cmd, @args);
 659         if (ref $p[0]) {
 660                 ($cmd, @args) = @{shift @p};
 661                 %opts = ref $p[0] ? %{$p[0]} : @p;
 662         } else {
 663                 ($cmd, @args) = @p;
 664         }
 665         _check_valid_cmd($cmd);
 666
 667         my $fh;
 668         if ($^O eq '##INSERT_ACTIVESTATE_STRING_HERE##') {
 669                 # ActiveState Perl
 670                 #defined $opts{STDERR} and
 671                 #       warn 'ignoring STDERR option - running w/ ActiveState';
 672                 $direction eq '-|' or
 673                         die 'input pipe for ActiveState not implemented';
 674                 tie ($fh, 'Git::activestate_pipe', $cmd, @args);
 675
 676         } else {
 677                 my $pid = open($fh, $direction);
 678                 if (not defined $pid) {
 679                         throw Error::Simple("open failed: $!");
 680                 } elsif ($pid == 0) {
 681                         if (defined $opts{STDERR}) {
 682                                 close STDERR;
 683                         }
 684                         if ($opts{STDERR}) {
 685                                 open (STDERR, '>&', $opts{STDERR})
 686                                         or die "dup failed: $!";
 687                         }
 688                         _cmd_exec($self, $cmd, @args);
 689                 }
 690         }
 691         return wantarray ? ($fh, join(' ', $cmd, @args)) : $fh;
 692 }
 693
 694 # When already in the subprocess, set up the appropriate state
 695 # for the given repository and execute the git command.
 696 sub _cmd_exec {
 697         my ($self, @args) = @_;
 698         if ($self) {
 699                 $self->repo_path() and $ENV{'GIT_DIR'} = $self->repo_path();
 700                 $self->wc_path() and chdir($self->wc_path());
 701                 $self->wc_subdir() and chdir($self->wc_subdir());
 702         }
 703         _execv_git_cmd(@args);
 704         die "exec failed: $!";
 705 }
 706
 707 # Execute the given Git command ($_[0]) with arguments ($_[1..])
 708 # by searching for it at proper places.
 709 # _execv_git_cmd(), implemented in Git.xs.
 710
 711 # Close pipe to a subprocess.
 712 sub _cmd_close {
 713         my ($fh, $ctx) = @_;
 714         if (not close $fh) {
 715                 if ($!) {
 716                         # It's just close, no point in fatalities
 717                         carp "error closing pipe: $!";
 718                 } elsif ($? >> 8) {
 719                         # The caller should pepper this.
 720                         throw Git::Error::Command($ctx, $? >> 8);
 721                 }
 722                 # else we might e.g. closed a live stream; the command
 723                 # dying of SIGPIPE would drive us here.
 724         }
 725 }
 726
 727
 728 # Trickery for .xs routines: In order to avoid having some horrid
 729 # C code trying to do stuff with undefs and hashes, we gate all
 730 # xs calls through the following and in case we are being ran upon
 731 # an instance call a C part of the gate which will set up the
 732 # environment properly.
 733 sub _call_gate {
 734         my $xsfunc = shift;
 735         my ($self, @args) = _maybe_self(@_);
 736
 737         if (defined $self) {
 738                 # XXX: We ignore the WorkingCopy! To properly support
 739                 # that will require heavy changes in libgit.
 740
 741                 # XXX: And we ignore everything else as well. libgit
 742                 # at least needs to be extended to let us specify
 743                 # the $GIT_DIR instead of looking it up in environment.
 744                 #xs_call_gate($self->{opts}->{Repository});
 745         }
 746
 747         # Having to call throw from the C code is a sure path to insanity.
 748         local $SIG{__DIE__} = sub { throw Error::Simple("@_"); };
 749         &$xsfunc(@args);
 750 }
 751
 752 sub AUTOLOAD {
 753         my $xsname;
 754         our $AUTOLOAD;
 755         ($xsname = $AUTOLOAD) =~ s/.*:://;
 756         throw Error::Simple("&Git::$xsname not defined") if $xsname =~ /^xs_/;
 757         $xsname = 'xs_'.$xsname;
 758         _call_gate(\&$xsname, @_);
 759 }
 760
 761 sub DESTROY { }
 762
 763
 764 # Pipe implementation for ActiveState Perl.
 765
 766 package Git::activestate_pipe;
 767 use strict;
 768
 769 sub TIEHANDLE {
 770         my ($class, @params) = @_;
 771         # FIXME: This is probably horrible idea and the thing will explode
 772         # at the moment you give it arguments that require some quoting,
 773         # but I have no ActiveState clue... --pasky
 774         my $cmdline = join " ", @params;
 775         my @data = qx{$cmdline};
 776         bless { i => 0, data => \@data }, $class;
 777 }
 778
 779 sub READLINE {
 780         my $self = shift;
 781         if ($self->{i} >= scalar @{$self->{data}}) {
 782                 return undef;
 783         }
 784         return $self->{'data'}->[ $self->{i}++ ];
 785 }
 786
 787 sub CLOSE {
 788         my $self = shift;
 789         delete $self->{data};
 790         delete $self->{i};
 791 }
 792
 793 sub EOF {
 794         my $self = shift;
 795         return ($self->{i} >= scalar @{$self->{data}});
 796 }
 797
 798
 799 1; # Famous last words