Git.pm: Implement options for the command interface
[git.git] / perl / Git.pm
blobe2b66c461923934deef2bf096279c255dcf0c68e
1 =head1 NAME
3 Git - Perl interface to the Git version control system
5 =cut
8 package Git;
10 use strict;
13 BEGIN {
15 our ($VERSION, @ISA, @EXPORT, @EXPORT_OK);
17 # Totally unstable API.
18 $VERSION = '0.01';
21 =head1 SYNOPSIS
23 use Git;
25 my $version = Git::command_oneline('version');
27 git_cmd_try { Git::command_noisy('update-server-info') }
28 '%s failed w/ code %d';
30 my $repo = Git->repository (Directory => '/srv/git/cogito.git');
33 my @revs = $repo->command('rev-list', '--since=last monday', '--all');
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);
39 my $lastrev = $repo->command_oneline( [ 'rev-list', '--all' ],
40 STDERR => 0 );
42 =cut
45 require Exporter;
47 @ISA = qw(Exporter);
49 @EXPORT = qw(git_cmd_try);
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);
57 =head1 DESCRIPTION
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.
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.
72 TODO: In the future, we might also do
74 my $subdir = $repo->subdir('Documentation');
75 # Gets called in the subdirectory context:
76 $subdir->command('status');
78 my $remoterepo = $repo->remote_repository (Name => 'cogito', Branch => 'master');
79 $remoterepo ||= Git->remote_repository ('http://git.or.cz/cogito.git/');
80 my @refs = $remoterepo->refs();
82 So far, all functions just die if anything goes wrong. If you don't want that,
83 make appropriate provisions to catch the possible deaths. Better error recovery
84 mechanisms will be provided in the future.
86 Currently, the module merely wraps calls to external Git tools. In the future,
87 it will provide a much faster way to interact with Git by linking directly
88 to libgit. This should be completely opaque to the user, though (performance
89 increate nonwithstanding).
91 =cut
94 use Carp qw(carp croak); # but croak is bad - throw instead
95 use Error qw(:try);
97 require XSLoader;
98 XSLoader::load('Git', $VERSION);
103 =head1 CONSTRUCTORS
105 =over 4
107 =item repository ( OPTIONS )
109 =item repository ( DIRECTORY )
111 =item repository ()
113 Construct a new repository object.
114 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
115 Possible options are:
117 B<Repository> - Path to the Git repository.
119 B<WorkingCopy> - Path to the associated working copy; not strictly required
120 as many commands will happily crunch on a bare repository.
122 B<Directory> - Path to the Git working directory in its usual setup. This
123 is just for convenient setting of both C<Repository> and C<WorkingCopy>
124 at once: If the directory as a C<.git> subdirectory, C<Repository> is pointed
125 to the subdirectory and the directory is assumed to be the working copy.
126 If the directory does not have the subdirectory, C<WorkingCopy> is left
127 undefined and C<Repository> is pointed to the directory itself.
129 You should not use both C<Directory> and either of C<Repository> and
130 C<WorkingCopy> - the results of that are undefined.
132 Alternatively, a directory path may be passed as a single scalar argument
133 to the constructor; it is equivalent to setting only the C<Directory> option
134 field.
136 Calling the constructor with no options whatsoever is equivalent to
137 calling it with C<< Directory => '.' >>.
139 =cut
141 sub repository {
142 my $class = shift;
143 my @args = @_;
144 my %opts = ();
145 my $self;
147 if (defined $args[0]) {
148 if ($#args % 2 != 1) {
149 # Not a hash.
150 $#args == 0 or throw Error::Simple("bad usage");
151 %opts = ( Directory => $args[0] );
152 } else {
153 %opts = @args;
156 if ($opts{Directory}) {
157 -d $opts{Directory} or throw Error::Simple("Directory not found: $!");
158 if (-d $opts{Directory}."/.git") {
159 # TODO: Might make this more clever
160 $opts{WorkingCopy} = $opts{Directory};
161 $opts{Repository} = $opts{Directory}."/.git";
162 } else {
163 $opts{Repository} = $opts{Directory};
165 delete $opts{Directory};
169 $self = { opts => \%opts };
170 bless $self, $class;
174 =back
176 =head1 METHODS
178 =over 4
180 =item command ( COMMAND [, ARGUMENTS... ] )
182 =item command ( [ COMMAND, ARGUMENTS... ], { Opt => Val ... } )
184 Execute the given Git C<COMMAND> (specify it without the 'git-'
185 prefix), optionally with the specified extra C<ARGUMENTS>.
187 The second more elaborate form can be used if you want to further adjust
188 the command execution. Currently, only one option is supported:
190 B<STDERR> - How to deal with the command's error output. By default (C<undef>)
191 it is delivered to the caller's C<STDERR>. A false value (0 or '') will cause
192 it to be thrown away. If you want to process it, you can get it in a filehandle
193 you specify, but you must be extremely careful; if the error output is not
194 very short and you want to read it in the same process as where you called
195 C<command()>, you are set up for a nice deadlock!
197 The method can be called without any instance or on a specified Git repository
198 (in that case the command will be run in the repository context).
200 In scalar context, it returns all the command output in a single string
201 (verbatim).
203 In array context, it returns an array containing lines printed to the
204 command's stdout (without trailing newlines).
206 In both cases, the command's stdin and stderr are the same as the caller's.
208 =cut
210 sub command {
211 my ($fh, $ctx) = command_output_pipe(@_);
213 if (not defined wantarray) {
214 # Nothing to pepper the possible exception with.
215 _cmd_close($fh, $ctx);
217 } elsif (not wantarray) {
218 local $/;
219 my $text = <$fh>;
220 try {
221 _cmd_close($fh, $ctx);
222 } catch Git::Error::Command with {
223 # Pepper with the output:
224 my $E = shift;
225 $E->{'-outputref'} = \$text;
226 throw $E;
228 return $text;
230 } else {
231 my @lines = <$fh>;
232 chomp @lines;
233 try {
234 _cmd_close($fh, $ctx);
235 } catch Git::Error::Command with {
236 my $E = shift;
237 $E->{'-outputref'} = \@lines;
238 throw $E;
240 return @lines;
245 =item command_oneline ( COMMAND [, ARGUMENTS... ] )
247 =item command_oneline ( [ COMMAND, ARGUMENTS... ], { Opt => Val ... } )
249 Execute the given C<COMMAND> in the same way as command()
250 does but always return a scalar string containing the first line
251 of the command's standard output.
253 =cut
255 sub command_oneline {
256 my ($fh, $ctx) = command_output_pipe(@_);
258 my $line = <$fh>;
259 chomp $line;
260 try {
261 _cmd_close($fh, $ctx);
262 } catch Git::Error::Command with {
263 # Pepper with the output:
264 my $E = shift;
265 $E->{'-outputref'} = \$line;
266 throw $E;
268 return $line;
272 =item command_output_pipe ( COMMAND [, ARGUMENTS... ] )
274 =item command_output_pipe ( [ COMMAND, ARGUMENTS... ], { Opt => Val ... } )
276 Execute the given C<COMMAND> in the same way as command()
277 does but return a pipe filehandle from which the command output can be
278 read.
280 The function can return C<($pipe, $ctx)> in array context.
281 See C<command_close_pipe()> for details.
283 =cut
285 sub command_output_pipe {
286 _command_common_pipe('-|', @_);
290 =item command_input_pipe ( COMMAND [, ARGUMENTS... ] )
292 =item command_input_pipe ( [ COMMAND, ARGUMENTS... ], { Opt => Val ... } )
294 Execute the given C<COMMAND> in the same way as command_output_pipe()
295 does but return an input pipe filehandle instead; the command output
296 is not captured.
298 The function can return C<($pipe, $ctx)> in array context.
299 See C<command_close_pipe()> for details.
301 =cut
303 sub command_input_pipe {
304 _command_common_pipe('|-', @_);
308 =item command_close_pipe ( PIPE [, CTX ] )
310 Close the C<PIPE> as returned from C<command_*_pipe()>, checking
311 whether the command finished successfuly. The optional C<CTX> argument
312 is required if you want to see the command name in the error message,
313 and it is the second value returned by C<command_*_pipe()> when
314 called in array context. The call idiom is:
316 my ($fh, $ctx) = $r->command_output_pipe('status');
317 while (<$fh>) { ... }
318 $r->command_close_pipe($fh, $ctx);
320 Note that you should not rely on whatever actually is in C<CTX>;
321 currently it is simply the command name but in future the context might
322 have more complicated structure.
324 =cut
326 sub command_close_pipe {
327 my ($self, $fh, $ctx) = _maybe_self(@_);
328 $ctx ||= '<unknown>';
329 _cmd_close($fh, $ctx);
333 =item command_noisy ( COMMAND [, ARGUMENTS... ] )
335 Execute the given C<COMMAND> in the same way as command() does but do not
336 capture the command output - the standard output is not redirected and goes
337 to the standard output of the caller application.
339 While the method is called command_noisy(), you might want to as well use
340 it for the most silent Git commands which you know will never pollute your
341 stdout but you want to avoid the overhead of the pipe setup when calling them.
343 The function returns only after the command has finished running.
345 =cut
347 sub command_noisy {
348 my ($self, $cmd, @args) = _maybe_self(@_);
349 _check_valid_cmd($cmd);
351 my $pid = fork;
352 if (not defined $pid) {
353 throw Error::Simple("fork failed: $!");
354 } elsif ($pid == 0) {
355 _cmd_exec($self, $cmd, @args);
357 if (waitpid($pid, 0) > 0 and $?>>8 != 0) {
358 throw Git::Error::Command(join(' ', $cmd, @args), $? >> 8);
363 =item version ()
365 Return the Git version in use.
367 Implementation of this function is very fast; no external command calls
368 are involved.
370 =cut
372 # Implemented in Git.xs.
375 =item exec_path ()
377 Return path to the git sub-command executables (the same as
378 C<git --exec-path>). Useful mostly only internally.
380 Implementation of this function is very fast; no external command calls
381 are involved.
383 =cut
385 # Implemented in Git.xs.
388 =item hash_object ( FILENAME [, TYPE ] )
390 =item hash_object ( FILEHANDLE [, TYPE ] )
392 Compute the SHA1 object id of the given C<FILENAME> (or data waiting in
393 C<FILEHANDLE>) considering it is of the C<TYPE> object type (C<blob>
394 (default), C<commit>, C<tree>).
396 In case of C<FILEHANDLE> passed instead of file name, all the data
397 available are read and hashed, and the filehandle is automatically
398 closed. The file handle should be freshly opened - if you have already
399 read anything from the file handle, the results are undefined (since
400 this function works directly with the file descriptor and internal
401 PerlIO buffering might have messed things up).
403 The method can be called without any instance or on a specified Git repository,
404 it makes zero difference.
406 The function returns the SHA1 hash.
408 Implementation of this function is very fast; no external command calls
409 are involved.
411 =cut
413 # Implemented in Git.xs.
417 =back
419 =head1 ERROR HANDLING
421 All functions are supposed to throw Perl exceptions in case of errors.
422 See the L<Error> module on how to catch those. Most exceptions are mere
423 L<Error::Simple> instances.
425 However, the C<command()>, C<command_oneline()> and C<command_noisy()>
426 functions suite can throw C<Git::Error::Command> exceptions as well: those are
427 thrown when the external command returns an error code and contain the error
428 code as well as access to the captured command's output. The exception class
429 provides the usual C<stringify> and C<value> (command's exit code) methods and
430 in addition also a C<cmd_output> method that returns either an array or a
431 string with the captured command output (depending on the original function
432 call context; C<command_noisy()> returns C<undef>) and $<cmdline> which
433 returns the command and its arguments (but without proper quoting).
435 Note that the C<command_*_pipe()> functions cannot throw this exception since
436 it has no idea whether the command failed or not. You will only find out
437 at the time you C<close> the pipe; if you want to have that automated,
438 use C<command_close_pipe()>, which can throw the exception.
440 =cut
443 package Git::Error::Command;
445 @Git::Error::Command::ISA = qw(Error);
447 sub new {
448 my $self = shift;
449 my $cmdline = '' . shift;
450 my $value = 0 + shift;
451 my $outputref = shift;
452 my(@args) = ();
454 local $Error::Depth = $Error::Depth + 1;
456 push(@args, '-cmdline', $cmdline);
457 push(@args, '-value', $value);
458 push(@args, '-outputref', $outputref);
460 $self->SUPER::new(-text => 'command returned error', @args);
463 sub stringify {
464 my $self = shift;
465 my $text = $self->SUPER::stringify;
466 $self->cmdline() . ': ' . $text . ': ' . $self->value() . "\n";
469 sub cmdline {
470 my $self = shift;
471 $self->{'-cmdline'};
474 sub cmd_output {
475 my $self = shift;
476 my $ref = $self->{'-outputref'};
477 defined $ref or undef;
478 if (ref $ref eq 'ARRAY') {
479 return @$ref;
480 } else { # SCALAR
481 return $$ref;
486 =over 4
488 =item git_cmd_try { CODE } ERRMSG
490 This magical statement will automatically catch any C<Git::Error::Command>
491 exceptions thrown by C<CODE> and make your program die with C<ERRMSG>
492 on its lips; the message will have %s substituted for the command line
493 and %d for the exit status. This statement is useful mostly for producing
494 more user-friendly error messages.
496 In case of no exception caught the statement returns C<CODE>'s return value.
498 Note that this is the only auto-exported function.
500 =cut
502 sub git_cmd_try(&$) {
503 my ($code, $errmsg) = @_;
504 my @result;
505 my $err;
506 my $array = wantarray;
507 try {
508 if ($array) {
509 @result = &$code;
510 } else {
511 $result[0] = &$code;
513 } catch Git::Error::Command with {
514 my $E = shift;
515 $err = $errmsg;
516 $err =~ s/\%s/$E->cmdline()/ge;
517 $err =~ s/\%d/$E->value()/ge;
518 # We can't croak here since Error.pm would mangle
519 # that to Error::Simple.
521 $err and croak $err;
522 return $array ? @result : $result[0];
526 =back
528 =head1 COPYRIGHT
530 Copyright 2006 by Petr Baudis E<lt>pasky@suse.czE<gt>.
532 This module is free software; it may be used, copied, modified
533 and distributed under the terms of the GNU General Public Licence,
534 either version 2, or (at your option) any later version.
536 =cut
539 # Take raw method argument list and return ($obj, @args) in case
540 # the method was called upon an instance and (undef, @args) if
541 # it was called directly.
542 sub _maybe_self {
543 # This breaks inheritance. Oh well.
544 ref $_[0] eq 'Git' ? @_ : (undef, @_);
547 # Check if the command id is something reasonable.
548 sub _check_valid_cmd {
549 my ($cmd) = @_;
550 $cmd =~ /^[a-z0-9A-Z_-]+$/ or throw Error::Simple("bad command: $cmd");
553 # Common backend for the pipe creators.
554 sub _command_common_pipe {
555 my $direction = shift;
556 my ($self, @p) = _maybe_self(@_);
557 my (%opts, $cmd, @args);
558 if (ref $p[0]) {
559 ($cmd, @args) = @{shift @p};
560 %opts = ref $p[0] ? %{$p[0]} : @p;
561 } else {
562 ($cmd, @args) = @p;
564 _check_valid_cmd($cmd);
566 my $pid = open(my $fh, $direction);
567 if (not defined $pid) {
568 throw Error::Simple("open failed: $!");
569 } elsif ($pid == 0) {
570 if (defined $opts{STDERR}) {
571 close STDERR;
573 if ($opts{STDERR}) {
574 open (STDERR, '>&', $opts{STDERR})
575 or die "dup failed: $!";
577 _cmd_exec($self, $cmd, @args);
579 return wantarray ? ($fh, join(' ', $cmd, @args)) : $fh;
582 # When already in the subprocess, set up the appropriate state
583 # for the given repository and execute the git command.
584 sub _cmd_exec {
585 my ($self, @args) = @_;
586 if ($self) {
587 $self->{opts}->{Repository} and $ENV{'GIT_DIR'} = $self->{opts}->{Repository};
588 $self->{opts}->{WorkingCopy} and chdir($self->{opts}->{WorkingCopy});
590 _execv_git_cmd(@args);
591 die "exec failed: $!";
594 # Execute the given Git command ($_[0]) with arguments ($_[1..])
595 # by searching for it at proper places.
596 # _execv_git_cmd(), implemented in Git.xs.
598 # Close pipe to a subprocess.
599 sub _cmd_close {
600 my ($fh, $ctx) = @_;
601 if (not close $fh) {
602 if ($!) {
603 # It's just close, no point in fatalities
604 carp "error closing pipe: $!";
605 } elsif ($? >> 8) {
606 # The caller should pepper this.
607 throw Git::Error::Command($ctx, $? >> 8);
609 # else we might e.g. closed a live stream; the command
610 # dying of SIGPIPE would drive us here.
615 # Trickery for .xs routines: In order to avoid having some horrid
616 # C code trying to do stuff with undefs and hashes, we gate all
617 # xs calls through the following and in case we are being ran upon
618 # an instance call a C part of the gate which will set up the
619 # environment properly.
620 sub _call_gate {
621 my $xsfunc = shift;
622 my ($self, @args) = _maybe_self(@_);
624 if (defined $self) {
625 # XXX: We ignore the WorkingCopy! To properly support
626 # that will require heavy changes in libgit.
628 # XXX: And we ignore everything else as well. libgit
629 # at least needs to be extended to let us specify
630 # the $GIT_DIR instead of looking it up in environment.
631 #xs_call_gate($self->{opts}->{Repository});
634 # Having to call throw from the C code is a sure path to insanity.
635 local $SIG{__DIE__} = sub { throw Error::Simple("@_"); };
636 &$xsfunc(@args);
639 sub AUTOLOAD {
640 my $xsname;
641 our $AUTOLOAD;
642 ($xsname = $AUTOLOAD) =~ s/.*:://;
643 throw Error::Simple("&Git::$xsname not defined") if $xsname =~ /^xs_/;
644 $xsname = 'xs_'.$xsname;
645 _call_gate(\&$xsname, @_);
648 sub DESTROY { }
651 1; # Famous last words