Git.pm: Implement options for the command interface
[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
72TODO: In the future, we might also do
73
74 my $subdir = $repo->subdir('Documentation');
75 # Gets called in the subdirectory context:
76 $subdir->command('status');
77
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();
81
82So far, all functions just die if anything goes wrong. If you don't want that,
83make appropriate provisions to catch the possible deaths. Better error recovery
84mechanisms will be provided in the future.
85
86Currently, the module merely wraps calls to external Git tools. In the future,
87it will provide a much faster way to interact with Git by linking directly
88to libgit. This should be completely opaque to the user, though (performance
89increate nonwithstanding).
90
91=cut
92
93
8b9150e3 94use Carp qw(carp croak); # but croak is bad - throw instead
97b16c06 95use Error qw(:try);
b1edc53d
PB
96
97require XSLoader;
98XSLoader::load('Git', $VERSION);
99
100}
101
102
103=head1 CONSTRUCTORS
104
105=over 4
106
107=item repository ( OPTIONS )
108
109=item repository ( DIRECTORY )
110
111=item repository ()
112
113Construct a new repository object.
114C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
115Possible options are:
116
117B<Repository> - Path to the Git repository.
118
119B<WorkingCopy> - Path to the associated working copy; not strictly required
120as many commands will happily crunch on a bare repository.
121
122B<Directory> - Path to the Git working directory in its usual setup. This
123is just for convenient setting of both C<Repository> and C<WorkingCopy>
124at once: If the directory as a C<.git> subdirectory, C<Repository> is pointed
125to the subdirectory and the directory is assumed to be the working copy.
126If the directory does not have the subdirectory, C<WorkingCopy> is left
127undefined and C<Repository> is pointed to the directory itself.
128
b1edc53d
PB
129You should not use both C<Directory> and either of C<Repository> and
130C<WorkingCopy> - the results of that are undefined.
131
132Alternatively, a directory path may be passed as a single scalar argument
133to the constructor; it is equivalent to setting only the C<Directory> option
134field.
135
136Calling the constructor with no options whatsoever is equivalent to
137calling it with C<< Directory => '.' >>.
138
139=cut
140
141sub repository {
142 my $class = shift;
143 my @args = @_;
144 my %opts = ();
145 my $self;
146
147 if (defined $args[0]) {
148 if ($#args % 2 != 1) {
149 # Not a hash.
97b16c06
PB
150 $#args == 0 or throw Error::Simple("bad usage");
151 %opts = ( Directory => $args[0] );
b1edc53d
PB
152 } else {
153 %opts = @args;
154 }
155
156 if ($opts{Directory}) {
97b16c06 157 -d $opts{Directory} or throw Error::Simple("Directory not found: $!");
b1edc53d
PB
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};
164 }
165 delete $opts{Directory};
166 }
167 }
168
169 $self = { opts => \%opts };
170 bless $self, $class;
171}
172
173
174=back
175
176=head1 METHODS
177
178=over 4
179
180=item command ( COMMAND [, ARGUMENTS... ] )
181
d43ba468
PB
182=item command ( [ COMMAND, ARGUMENTS... ], { Opt => Val ... } )
183
b1edc53d
PB
184Execute the given Git C<COMMAND> (specify it without the 'git-'
185prefix), optionally with the specified extra C<ARGUMENTS>.
186
d43ba468
PB
187The second more elaborate form can be used if you want to further adjust
188the command execution. Currently, only one option is supported:
189
190B<STDERR> - How to deal with the command's error output. By default (C<undef>)
191it is delivered to the caller's C<STDERR>. A false value (0 or '') will cause
192it to be thrown away. If you want to process it, you can get it in a filehandle
193you specify, but you must be extremely careful; if the error output is not
194very short and you want to read it in the same process as where you called
195C<command()>, you are set up for a nice deadlock!
196
b1edc53d
PB
197The 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).
199
200In scalar context, it returns all the command output in a single string
201(verbatim).
202
203In array context, it returns an array containing lines printed to the
204command's stdout (without trailing newlines).
205
206In both cases, the command's stdin and stderr are the same as the caller's.
207
208=cut
209
210sub command {
d79850e1 211 my ($fh, $ctx) = command_output_pipe(@_);
b1edc53d
PB
212
213 if (not defined wantarray) {
8b9150e3
PB
214 # Nothing to pepper the possible exception with.
215 _cmd_close($fh, $ctx);
b1edc53d
PB
216
217 } elsif (not wantarray) {
218 local $/;
219 my $text = <$fh>;
8b9150e3
PB
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;
227 };
b1edc53d
PB
228 return $text;
229
230 } else {
231 my @lines = <$fh>;
b1edc53d 232 chomp @lines;
8b9150e3
PB
233 try {
234 _cmd_close($fh, $ctx);
235 } catch Git::Error::Command with {
236 my $E = shift;
237 $E->{'-outputref'} = \@lines;
238 throw $E;
239 };
b1edc53d
PB
240 return @lines;
241 }
242}
243
244
245=item command_oneline ( COMMAND [, ARGUMENTS... ] )
246
d43ba468
PB
247=item command_oneline ( [ COMMAND, ARGUMENTS... ], { Opt => Val ... } )
248
b1edc53d
PB
249Execute the given C<COMMAND> in the same way as command()
250does but always return a scalar string containing the first line
251of the command's standard output.
252
253=cut
254
255sub command_oneline {
d79850e1 256 my ($fh, $ctx) = command_output_pipe(@_);
b1edc53d
PB
257
258 my $line = <$fh>;
b1edc53d 259 chomp $line;
8b9150e3
PB
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;
267 };
b1edc53d
PB
268 return $line;
269}
270
271
d79850e1 272=item command_output_pipe ( COMMAND [, ARGUMENTS... ] )
b1edc53d 273
d43ba468
PB
274=item command_output_pipe ( [ COMMAND, ARGUMENTS... ], { Opt => Val ... } )
275
b1edc53d
PB
276Execute the given C<COMMAND> in the same way as command()
277does but return a pipe filehandle from which the command output can be
278read.
279
d79850e1
PB
280The function can return C<($pipe, $ctx)> in array context.
281See C<command_close_pipe()> for details.
282
b1edc53d
PB
283=cut
284
d79850e1
PB
285sub command_output_pipe {
286 _command_common_pipe('-|', @_);
287}
b1edc53d 288
b1edc53d 289
d79850e1
PB
290=item command_input_pipe ( COMMAND [, ARGUMENTS... ] )
291
d43ba468
PB
292=item command_input_pipe ( [ COMMAND, ARGUMENTS... ], { Opt => Val ... } )
293
d79850e1
PB
294Execute the given C<COMMAND> in the same way as command_output_pipe()
295does but return an input pipe filehandle instead; the command output
296is not captured.
297
298The function can return C<($pipe, $ctx)> in array context.
299See C<command_close_pipe()> for details.
300
301=cut
302
303sub command_input_pipe {
304 _command_common_pipe('|-', @_);
8b9150e3
PB
305}
306
307
308=item command_close_pipe ( PIPE [, CTX ] )
309
d79850e1 310Close the C<PIPE> as returned from C<command_*_pipe()>, checking
8b9150e3
PB
311whether the command finished successfuly. The optional C<CTX> argument
312is required if you want to see the command name in the error message,
d79850e1 313and it is the second value returned by C<command_*_pipe()> when
8b9150e3
PB
314called in array context. The call idiom is:
315
d79850e1
PB
316 my ($fh, $ctx) = $r->command_output_pipe('status');
317 while (<$fh>) { ... }
318 $r->command_close_pipe($fh, $ctx);
8b9150e3
PB
319
320Note that you should not rely on whatever actually is in C<CTX>;
321currently it is simply the command name but in future the context might
322have more complicated structure.
323
324=cut
325
326sub command_close_pipe {
327 my ($self, $fh, $ctx) = _maybe_self(@_);
328 $ctx ||= '<unknown>';
329 _cmd_close($fh, $ctx);
b1edc53d
PB
330}
331
332
333=item command_noisy ( COMMAND [, ARGUMENTS... ] )
334
335Execute the given C<COMMAND> in the same way as command() does but do not
336capture the command output - the standard output is not redirected and goes
337to the standard output of the caller application.
338
339While the method is called command_noisy(), you might want to as well use
340it for the most silent Git commands which you know will never pollute your
341stdout but you want to avoid the overhead of the pipe setup when calling them.
342
343The function returns only after the command has finished running.
344
345=cut
346
347sub command_noisy {
348 my ($self, $cmd, @args) = _maybe_self(@_);
d79850e1 349 _check_valid_cmd($cmd);
b1edc53d
PB
350
351 my $pid = fork;
352 if (not defined $pid) {
97b16c06 353 throw Error::Simple("fork failed: $!");
b1edc53d
PB
354 } elsif ($pid == 0) {
355 _cmd_exec($self, $cmd, @args);
356 }
8b9150e3
PB
357 if (waitpid($pid, 0) > 0 and $?>>8 != 0) {
358 throw Git::Error::Command(join(' ', $cmd, @args), $? >> 8);
b1edc53d
PB
359 }
360}
361
362
63df97ae
PB
363=item version ()
364
365Return the Git version in use.
366
367Implementation of this function is very fast; no external command calls
368are involved.
369
370=cut
371
372# Implemented in Git.xs.
373
374
eca1f6fd
PB
375=item exec_path ()
376
377Return path to the git sub-command executables (the same as
378C<git --exec-path>). Useful mostly only internally.
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
b1edc53d
PB
388=item hash_object ( FILENAME [, TYPE ] )
389
390=item hash_object ( FILEHANDLE [, TYPE ] )
391
392Compute the SHA1 object id of the given C<FILENAME> (or data waiting in
393C<FILEHANDLE>) considering it is of the C<TYPE> object type (C<blob>
394(default), C<commit>, C<tree>).
395
396In case of C<FILEHANDLE> passed instead of file name, all the data
397available are read and hashed, and the filehandle is automatically
398closed. The file handle should be freshly opened - if you have already
399read anything from the file handle, the results are undefined (since
400this function works directly with the file descriptor and internal
401PerlIO buffering might have messed things up).
402
403The method can be called without any instance or on a specified Git repository,
404it makes zero difference.
405
406The function returns the SHA1 hash.
407
408Implementation of this function is very fast; no external command calls
409are involved.
410
411=cut
412
413# Implemented in Git.xs.
414
415
8b9150e3 416
b1edc53d
PB
417=back
418
97b16c06 419=head1 ERROR HANDLING
b1edc53d 420
97b16c06 421All functions are supposed to throw Perl exceptions in case of errors.
8b9150e3
PB
422See the L<Error> module on how to catch those. Most exceptions are mere
423L<Error::Simple> instances.
424
425However, the C<command()>, C<command_oneline()> and C<command_noisy()>
426functions suite can throw C<Git::Error::Command> exceptions as well: those are
427thrown when the external command returns an error code and contain the error
428code as well as access to the captured command's output. The exception class
429provides the usual C<stringify> and C<value> (command's exit code) methods and
430in addition also a C<cmd_output> method that returns either an array or a
431string with the captured command output (depending on the original function
432call context; C<command_noisy()> returns C<undef>) and $<cmdline> which
433returns the command and its arguments (but without proper quoting).
434
d79850e1 435Note that the C<command_*_pipe()> functions cannot throw this exception since
8b9150e3
PB
436it has no idea whether the command failed or not. You will only find out
437at the time you C<close> the pipe; if you want to have that automated,
438use C<command_close_pipe()>, which can throw the exception.
439
440=cut
441
442{
443 package Git::Error::Command;
444
445 @Git::Error::Command::ISA = qw(Error);
446
447 sub new {
448 my $self = shift;
449 my $cmdline = '' . shift;
450 my $value = 0 + shift;
451 my $outputref = shift;
452 my(@args) = ();
453
454 local $Error::Depth = $Error::Depth + 1;
455
456 push(@args, '-cmdline', $cmdline);
457 push(@args, '-value', $value);
458 push(@args, '-outputref', $outputref);
459
460 $self->SUPER::new(-text => 'command returned error', @args);
461 }
462
463 sub stringify {
464 my $self = shift;
465 my $text = $self->SUPER::stringify;
466 $self->cmdline() . ': ' . $text . ': ' . $self->value() . "\n";
467 }
468
469 sub cmdline {
470 my $self = shift;
471 $self->{'-cmdline'};
472 }
473
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;
482 }
483 }
484}
485
486=over 4
487
488=item git_cmd_try { CODE } ERRMSG
489
490This magical statement will automatically catch any C<Git::Error::Command>
491exceptions thrown by C<CODE> and make your program die with C<ERRMSG>
492on its lips; the message will have %s substituted for the command line
493and %d for the exit status. This statement is useful mostly for producing
494more user-friendly error messages.
495
496In case of no exception caught the statement returns C<CODE>'s return value.
497
498Note that this is the only auto-exported function.
499
500=cut
501
502sub 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;
512 }
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.
520 };
521 $err and croak $err;
522 return $array ? @result : $result[0];
523}
524
525
526=back
b1edc53d
PB
527
528=head1 COPYRIGHT
529
530Copyright 2006 by Petr Baudis E<lt>pasky@suse.czE<gt>.
531
532This module is free software; it may be used, copied, modified
533and distributed under the terms of the GNU General Public Licence,
534either version 2, or (at your option) any later version.
535
536=cut
537
538
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.
542sub _maybe_self {
543 # This breaks inheritance. Oh well.
544 ref $_[0] eq 'Git' ? @_ : (undef, @_);
545}
546
d79850e1
PB
547# Check if the command id is something reasonable.
548sub _check_valid_cmd {
549 my ($cmd) = @_;
550 $cmd =~ /^[a-z0-9A-Z_-]+$/ or throw Error::Simple("bad command: $cmd");
551}
552
553# Common backend for the pipe creators.
554sub _command_common_pipe {
555 my $direction = shift;
d43ba468
PB
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;
563 }
d79850e1
PB
564 _check_valid_cmd($cmd);
565
566 my $pid = open(my $fh, $direction);
567 if (not defined $pid) {
568 throw Error::Simple("open failed: $!");
569 } elsif ($pid == 0) {
d43ba468
PB
570 if (defined $opts{STDERR}) {
571 close STDERR;
572 }
573 if ($opts{STDERR}) {
574 open (STDERR, '>&', $opts{STDERR})
575 or die "dup failed: $!";
576 }
d79850e1
PB
577 _cmd_exec($self, $cmd, @args);
578 }
579 return wantarray ? ($fh, join(' ', $cmd, @args)) : $fh;
580}
581
b1edc53d
PB
582# When already in the subprocess, set up the appropriate state
583# for the given repository and execute the git command.
584sub _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});
589 }
97b16c06
PB
590 _execv_git_cmd(@args);
591 die "exec failed: $!";
b1edc53d
PB
592}
593
8062f81c
PB
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.
597
b1edc53d
PB
598# Close pipe to a subprocess.
599sub _cmd_close {
8b9150e3 600 my ($fh, $ctx) = @_;
b1edc53d
PB
601 if (not close $fh) {
602 if ($!) {
603 # It's just close, no point in fatalities
604 carp "error closing pipe: $!";
605 } elsif ($? >> 8) {
8b9150e3
PB
606 # The caller should pepper this.
607 throw Git::Error::Command($ctx, $? >> 8);
b1edc53d
PB
608 }
609 # else we might e.g. closed a live stream; the command
610 # dying of SIGPIPE would drive us here.
611 }
612}
613
614
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.
620sub _call_gate {
621 my $xsfunc = shift;
622 my ($self, @args) = _maybe_self(@_);
623
624 if (defined $self) {
625 # XXX: We ignore the WorkingCopy! To properly support
626 # that will require heavy changes in libgit.
627
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});
632 }
633
97b16c06
PB
634 # Having to call throw from the C code is a sure path to insanity.
635 local $SIG{__DIE__} = sub { throw Error::Simple("@_"); };
b1edc53d
PB
636 &$xsfunc(@args);
637}
638
639sub AUTOLOAD {
640 my $xsname;
641 our $AUTOLOAD;
642 ($xsname = $AUTOLOAD) =~ s/.*:://;
97b16c06 643 throw Error::Simple("&Git::$xsname not defined") if $xsname =~ /^xs_/;
b1edc53d
PB
644 $xsname = 'xs_'.$xsname;
645 _call_gate(\&$xsname, @_);
646}
647
648sub DESTROY { }
649
650
6511; # Famous last words