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