Git.pm: Handle failed commands' output
[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
8b9150e3 35 my ($fh, $c) = $repo->command_pipe('rev-list', '--since=last monday', '--all');
b1edc53d 36 my $lastrev = <$fh>; chomp $lastrev;
8b9150e3 37 $repo->command_close_pipe($fh, $c);
b1edc53d
PB
38
39 my $lastrev = $repo->command_oneline('rev-list', '--all');
40
41=cut
42
43
44require Exporter;
45
46@ISA = qw(Exporter);
47
8b9150e3 48@EXPORT = qw(git_cmd_try);
b1edc53d
PB
49
50# Methods which can be called as standalone functions as well:
51@EXPORT_OK = qw(command command_oneline command_pipe command_noisy
8b9150e3 52 version exec_path hash_object git_cmd_try);
b1edc53d
PB
53
54
55=head1 DESCRIPTION
56
57This module provides Perl scripts easy way to interface the Git version control
58system. The modules have an easy and well-tested way to call arbitrary Git
59commands; in the future, the interface will also provide specialized methods
60for doing easily operations which are not totally trivial to do over
61the generic command interface.
62
63While some commands can be executed outside of any context (e.g. 'version'
64or 'init-db'), most operations require a repository context, which in practice
65means getting an instance of the Git object using the repository() constructor.
66(In the future, we will also get a new_repository() constructor.) All commands
67called as methods of the object are then executed in the context of the
68repository.
69
70TODO: In the future, we might also do
71
72 my $subdir = $repo->subdir('Documentation');
73 # Gets called in the subdirectory context:
74 $subdir->command('status');
75
76 my $remoterepo = $repo->remote_repository (Name => 'cogito', Branch => 'master');
77 $remoterepo ||= Git->remote_repository ('http://git.or.cz/cogito.git/');
78 my @refs = $remoterepo->refs();
79
80So far, all functions just die if anything goes wrong. If you don't want that,
81make appropriate provisions to catch the possible deaths. Better error recovery
82mechanisms will be provided in the future.
83
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);
b1edc53d
PB
94
95require XSLoader;
96XSLoader::load('Git', $VERSION);
97
98}
99
100
101=head1 CONSTRUCTORS
102
103=over 4
104
105=item repository ( OPTIONS )
106
107=item repository ( DIRECTORY )
108
109=item repository ()
110
111Construct a new repository object.
112C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
113Possible options are:
114
115B<Repository> - Path to the Git repository.
116
117B<WorkingCopy> - Path to the associated working copy; not strictly required
118as many commands will happily crunch on a bare repository.
119
120B<Directory> - Path to the Git working directory in its usual setup. This
121is just for convenient setting of both C<Repository> and C<WorkingCopy>
122at once: If the directory as a C<.git> subdirectory, C<Repository> is pointed
123to the subdirectory and the directory is assumed to be the working copy.
124If the directory does not have the subdirectory, C<WorkingCopy> is left
125undefined and C<Repository> is pointed to the directory itself.
126
b1edc53d
PB
127You should not use both C<Directory> and either of C<Repository> and
128C<WorkingCopy> - the results of that are undefined.
129
130Alternatively, a directory path may be passed as a single scalar argument
131to the constructor; it is equivalent to setting only the C<Directory> option
132field.
133
134Calling the constructor with no options whatsoever is equivalent to
135calling it with C<< Directory => '.' >>.
136
137=cut
138
139sub repository {
140 my $class = shift;
141 my @args = @_;
142 my %opts = ();
143 my $self;
144
145 if (defined $args[0]) {
146 if ($#args % 2 != 1) {
147 # Not a hash.
97b16c06
PB
148 $#args == 0 or throw Error::Simple("bad usage");
149 %opts = ( Directory => $args[0] );
b1edc53d
PB
150 } else {
151 %opts = @args;
152 }
153
154 if ($opts{Directory}) {
97b16c06 155 -d $opts{Directory} or throw Error::Simple("Directory not found: $!");
b1edc53d
PB
156 if (-d $opts{Directory}."/.git") {
157 # TODO: Might make this more clever
158 $opts{WorkingCopy} = $opts{Directory};
159 $opts{Repository} = $opts{Directory}."/.git";
160 } else {
161 $opts{Repository} = $opts{Directory};
162 }
163 delete $opts{Directory};
164 }
165 }
166
167 $self = { opts => \%opts };
168 bless $self, $class;
169}
170
171
172=back
173
174=head1 METHODS
175
176=over 4
177
178=item command ( COMMAND [, ARGUMENTS... ] )
179
180Execute the given Git C<COMMAND> (specify it without the 'git-'
181prefix), optionally with the specified extra C<ARGUMENTS>.
182
183The method can be called without any instance or on a specified Git repository
184(in that case the command will be run in the repository context).
185
186In scalar context, it returns all the command output in a single string
187(verbatim).
188
189In array context, it returns an array containing lines printed to the
190command's stdout (without trailing newlines).
191
192In both cases, the command's stdin and stderr are the same as the caller's.
193
194=cut
195
196sub command {
8b9150e3 197 my ($fh, $ctx) = command_pipe(@_);
b1edc53d
PB
198
199 if (not defined wantarray) {
8b9150e3
PB
200 # Nothing to pepper the possible exception with.
201 _cmd_close($fh, $ctx);
b1edc53d
PB
202
203 } elsif (not wantarray) {
204 local $/;
205 my $text = <$fh>;
8b9150e3
PB
206 try {
207 _cmd_close($fh, $ctx);
208 } catch Git::Error::Command with {
209 # Pepper with the output:
210 my $E = shift;
211 $E->{'-outputref'} = \$text;
212 throw $E;
213 };
b1edc53d
PB
214 return $text;
215
216 } else {
217 my @lines = <$fh>;
b1edc53d 218 chomp @lines;
8b9150e3
PB
219 try {
220 _cmd_close($fh, $ctx);
221 } catch Git::Error::Command with {
222 my $E = shift;
223 $E->{'-outputref'} = \@lines;
224 throw $E;
225 };
b1edc53d
PB
226 return @lines;
227 }
228}
229
230
231=item command_oneline ( COMMAND [, ARGUMENTS... ] )
232
233Execute the given C<COMMAND> in the same way as command()
234does but always return a scalar string containing the first line
235of the command's standard output.
236
237=cut
238
239sub command_oneline {
8b9150e3 240 my ($fh, $ctx) = command_pipe(@_);
b1edc53d
PB
241
242 my $line = <$fh>;
b1edc53d 243 chomp $line;
8b9150e3
PB
244 try {
245 _cmd_close($fh, $ctx);
246 } catch Git::Error::Command with {
247 # Pepper with the output:
248 my $E = shift;
249 $E->{'-outputref'} = \$line;
250 throw $E;
251 };
b1edc53d
PB
252 return $line;
253}
254
255
256=item command_pipe ( COMMAND [, ARGUMENTS... ] )
257
258Execute the given C<COMMAND> in the same way as command()
259does but return a pipe filehandle from which the command output can be
260read.
261
262=cut
263
264sub command_pipe {
265 my ($self, $cmd, @args) = _maybe_self(@_);
266
97b16c06 267 $cmd =~ /^[a-z0-9A-Z_-]+$/ or throw Error::Simple("bad command: $cmd");
b1edc53d
PB
268
269 my $pid = open(my $fh, "-|");
270 if (not defined $pid) {
97b16c06 271 throw Error::Simple("open failed: $!");
b1edc53d
PB
272 } elsif ($pid == 0) {
273 _cmd_exec($self, $cmd, @args);
274 }
8b9150e3
PB
275 return wantarray ? ($fh, join(' ', $cmd, @args)) : $fh;
276}
277
278
279=item command_close_pipe ( PIPE [, CTX ] )
280
281Close the C<PIPE> as returned from C<command_pipe()>, checking
282whether the command finished successfuly. The optional C<CTX> argument
283is required if you want to see the command name in the error message,
284and it is the second value returned by C<command_pipe()> when
285called in array context. The call idiom is:
286
287 my ($fh, $ctx) = $r->command_pipe('status');
288 while (<$fh>) { ... }
289 $r->command_close_pipe($fh, $ctx);
290
291Note that you should not rely on whatever actually is in C<CTX>;
292currently it is simply the command name but in future the context might
293have more complicated structure.
294
295=cut
296
297sub command_close_pipe {
298 my ($self, $fh, $ctx) = _maybe_self(@_);
299 $ctx ||= '<unknown>';
300 _cmd_close($fh, $ctx);
b1edc53d
PB
301}
302
303
304=item command_noisy ( COMMAND [, ARGUMENTS... ] )
305
306Execute the given C<COMMAND> in the same way as command() does but do not
307capture the command output - the standard output is not redirected and goes
308to the standard output of the caller application.
309
310While the method is called command_noisy(), you might want to as well use
311it for the most silent Git commands which you know will never pollute your
312stdout but you want to avoid the overhead of the pipe setup when calling them.
313
314The function returns only after the command has finished running.
315
316=cut
317
318sub command_noisy {
319 my ($self, $cmd, @args) = _maybe_self(@_);
320
97b16c06 321 $cmd =~ /^[a-z0-9A-Z_-]+$/ or throw Error::Simple("bad command: $cmd");
b1edc53d
PB
322
323 my $pid = fork;
324 if (not defined $pid) {
97b16c06 325 throw Error::Simple("fork failed: $!");
b1edc53d
PB
326 } elsif ($pid == 0) {
327 _cmd_exec($self, $cmd, @args);
328 }
8b9150e3
PB
329 if (waitpid($pid, 0) > 0 and $?>>8 != 0) {
330 throw Git::Error::Command(join(' ', $cmd, @args), $? >> 8);
b1edc53d
PB
331 }
332}
333
334
63df97ae
PB
335=item version ()
336
337Return the Git version in use.
338
339Implementation of this function is very fast; no external command calls
340are involved.
341
342=cut
343
344# Implemented in Git.xs.
345
346
eca1f6fd
PB
347=item exec_path ()
348
349Return path to the git sub-command executables (the same as
350C<git --exec-path>). Useful mostly only internally.
351
352Implementation of this function is very fast; no external command calls
353are involved.
354
355=cut
356
357# Implemented in Git.xs.
358
359
b1edc53d
PB
360=item hash_object ( FILENAME [, TYPE ] )
361
362=item hash_object ( FILEHANDLE [, TYPE ] )
363
364Compute the SHA1 object id of the given C<FILENAME> (or data waiting in
365C<FILEHANDLE>) considering it is of the C<TYPE> object type (C<blob>
366(default), C<commit>, C<tree>).
367
368In case of C<FILEHANDLE> passed instead of file name, all the data
369available are read and hashed, and the filehandle is automatically
370closed. The file handle should be freshly opened - if you have already
371read anything from the file handle, the results are undefined (since
372this function works directly with the file descriptor and internal
373PerlIO buffering might have messed things up).
374
375The method can be called without any instance or on a specified Git repository,
376it makes zero difference.
377
378The function returns the SHA1 hash.
379
380Implementation of this function is very fast; no external command calls
381are involved.
382
383=cut
384
385# Implemented in Git.xs.
386
387
8b9150e3 388
b1edc53d
PB
389=back
390
97b16c06 391=head1 ERROR HANDLING
b1edc53d 392
97b16c06 393All functions are supposed to throw Perl exceptions in case of errors.
8b9150e3
PB
394See the L<Error> module on how to catch those. Most exceptions are mere
395L<Error::Simple> instances.
396
397However, the C<command()>, C<command_oneline()> and C<command_noisy()>
398functions suite can throw C<Git::Error::Command> exceptions as well: those are
399thrown when the external command returns an error code and contain the error
400code as well as access to the captured command's output. The exception class
401provides the usual C<stringify> and C<value> (command's exit code) methods and
402in addition also a C<cmd_output> method that returns either an array or a
403string with the captured command output (depending on the original function
404call context; C<command_noisy()> returns C<undef>) and $<cmdline> which
405returns the command and its arguments (but without proper quoting).
406
407Note that the C<command_pipe()> function cannot throw this exception since
408it has no idea whether the command failed or not. You will only find out
409at the time you C<close> the pipe; if you want to have that automated,
410use C<command_close_pipe()>, which can throw the exception.
411
412=cut
413
414{
415 package Git::Error::Command;
416
417 @Git::Error::Command::ISA = qw(Error);
418
419 sub new {
420 my $self = shift;
421 my $cmdline = '' . shift;
422 my $value = 0 + shift;
423 my $outputref = shift;
424 my(@args) = ();
425
426 local $Error::Depth = $Error::Depth + 1;
427
428 push(@args, '-cmdline', $cmdline);
429 push(@args, '-value', $value);
430 push(@args, '-outputref', $outputref);
431
432 $self->SUPER::new(-text => 'command returned error', @args);
433 }
434
435 sub stringify {
436 my $self = shift;
437 my $text = $self->SUPER::stringify;
438 $self->cmdline() . ': ' . $text . ': ' . $self->value() . "\n";
439 }
440
441 sub cmdline {
442 my $self = shift;
443 $self->{'-cmdline'};
444 }
445
446 sub cmd_output {
447 my $self = shift;
448 my $ref = $self->{'-outputref'};
449 defined $ref or undef;
450 if (ref $ref eq 'ARRAY') {
451 return @$ref;
452 } else { # SCALAR
453 return $$ref;
454 }
455 }
456}
457
458=over 4
459
460=item git_cmd_try { CODE } ERRMSG
461
462This magical statement will automatically catch any C<Git::Error::Command>
463exceptions thrown by C<CODE> and make your program die with C<ERRMSG>
464on its lips; the message will have %s substituted for the command line
465and %d for the exit status. This statement is useful mostly for producing
466more user-friendly error messages.
467
468In case of no exception caught the statement returns C<CODE>'s return value.
469
470Note that this is the only auto-exported function.
471
472=cut
473
474sub git_cmd_try(&$) {
475 my ($code, $errmsg) = @_;
476 my @result;
477 my $err;
478 my $array = wantarray;
479 try {
480 if ($array) {
481 @result = &$code;
482 } else {
483 $result[0] = &$code;
484 }
485 } catch Git::Error::Command with {
486 my $E = shift;
487 $err = $errmsg;
488 $err =~ s/\%s/$E->cmdline()/ge;
489 $err =~ s/\%d/$E->value()/ge;
490 # We can't croak here since Error.pm would mangle
491 # that to Error::Simple.
492 };
493 $err and croak $err;
494 return $array ? @result : $result[0];
495}
496
497
498=back
b1edc53d
PB
499
500=head1 COPYRIGHT
501
502Copyright 2006 by Petr Baudis E<lt>pasky@suse.czE<gt>.
503
504This module is free software; it may be used, copied, modified
505and distributed under the terms of the GNU General Public Licence,
506either version 2, or (at your option) any later version.
507
508=cut
509
510
511# Take raw method argument list and return ($obj, @args) in case
512# the method was called upon an instance and (undef, @args) if
513# it was called directly.
514sub _maybe_self {
515 # This breaks inheritance. Oh well.
516 ref $_[0] eq 'Git' ? @_ : (undef, @_);
517}
518
519# When already in the subprocess, set up the appropriate state
520# for the given repository and execute the git command.
521sub _cmd_exec {
522 my ($self, @args) = @_;
523 if ($self) {
524 $self->{opts}->{Repository} and $ENV{'GIT_DIR'} = $self->{opts}->{Repository};
525 $self->{opts}->{WorkingCopy} and chdir($self->{opts}->{WorkingCopy});
526 }
97b16c06
PB
527 _execv_git_cmd(@args);
528 die "exec failed: $!";
b1edc53d
PB
529}
530
8062f81c
PB
531# Execute the given Git command ($_[0]) with arguments ($_[1..])
532# by searching for it at proper places.
533# _execv_git_cmd(), implemented in Git.xs.
534
b1edc53d
PB
535# Close pipe to a subprocess.
536sub _cmd_close {
8b9150e3 537 my ($fh, $ctx) = @_;
b1edc53d
PB
538 if (not close $fh) {
539 if ($!) {
540 # It's just close, no point in fatalities
541 carp "error closing pipe: $!";
542 } elsif ($? >> 8) {
8b9150e3
PB
543 # The caller should pepper this.
544 throw Git::Error::Command($ctx, $? >> 8);
b1edc53d
PB
545 }
546 # else we might e.g. closed a live stream; the command
547 # dying of SIGPIPE would drive us here.
548 }
549}
550
551
552# Trickery for .xs routines: In order to avoid having some horrid
553# C code trying to do stuff with undefs and hashes, we gate all
554# xs calls through the following and in case we are being ran upon
555# an instance call a C part of the gate which will set up the
556# environment properly.
557sub _call_gate {
558 my $xsfunc = shift;
559 my ($self, @args) = _maybe_self(@_);
560
561 if (defined $self) {
562 # XXX: We ignore the WorkingCopy! To properly support
563 # that will require heavy changes in libgit.
564
565 # XXX: And we ignore everything else as well. libgit
566 # at least needs to be extended to let us specify
567 # the $GIT_DIR instead of looking it up in environment.
568 #xs_call_gate($self->{opts}->{Repository});
569 }
570
97b16c06
PB
571 # Having to call throw from the C code is a sure path to insanity.
572 local $SIG{__DIE__} = sub { throw Error::Simple("@_"); };
b1edc53d
PB
573 &$xsfunc(@args);
574}
575
576sub AUTOLOAD {
577 my $xsname;
578 our $AUTOLOAD;
579 ($xsname = $AUTOLOAD) =~ s/.*:://;
97b16c06 580 throw Error::Simple("&Git::$xsname not defined") if $xsname =~ /^xs_/;
b1edc53d
PB
581 $xsname = 'xs_'.$xsname;
582 _call_gate(\&$xsname, @_);
583}
584
585sub DESTROY { }
586
587
5881; # Famous last words