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