perl/Git.pm

   1 =head1 NAME
   2
   3 Git - Perl interface to the Git version control system
   4
   5 =cut
   6
   7
   8 package Git;
   9
  10 use strict;
  11
  12
  13 BEGIN {
  14
  15 our ($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
  27   Git::command_noisy('update-server-info');
  28
  29   my $repo = Git->repository (Directory => '/srv/git/cogito.git');
  30
  31
  32   my @revs = $repo->command('rev-list', '--since=last monday', '--all');
  33
  34   my $fh = $repo->command_pipe('rev-list', '--since=last monday', '--all');
  35   my $lastrev = <$fh>; chomp $lastrev;
  36   close $fh; # You may want to test rev-list exit status here
  37
  38   my $lastrev = $repo->command_oneline('rev-list', '--all');
  39
  40 =cut
  41
  42
  43 require Exporter;
  44
  45 @ISA = qw(Exporter);
  46
  47 @EXPORT = qw();
  48
  49 # Methods which can be called as standalone functions as well:
  50 @EXPORT_OK = qw(command command_oneline command_pipe command_noisy
  51                 version exec_path hash_object);
  52
  53
  54 =head1 DESCRIPTION
  55
  56 This module provides Perl scripts easy way to interface the Git version control
  57 system. The modules have an easy and well-tested way to call arbitrary Git
  58 commands; in the future, the interface will also provide specialized methods
  59 for doing easily operations which are not totally trivial to do over
  60 the generic command interface.
  61
  62 While some commands can be executed outside of any context (e.g. 'version'
  63 or 'init-db'), most operations require a repository context, which in practice
  64 means getting an instance of the Git object using the repository() constructor.
  65 (In the future, we will also get a new_repository() constructor.) All commands
  66 called as methods of the object are then executed in the context of the
  67 repository.
  68
  69 TODO: In the future, we might also do
  70
  71         my $subdir = $repo->subdir('Documentation');
  72         # Gets called in the subdirectory context:
  73         $subdir->command('status');
  74
  75         my $remoterepo = $repo->remote_repository (Name => 'cogito', Branch => 'master');
  76         $remoterepo ||= Git->remote_repository ('http://git.or.cz/cogito.git/');
  77         my @refs = $remoterepo->refs();
  78
  79 So far, all functions just die if anything goes wrong. If you don't want that,
  80 make appropriate provisions to catch the possible deaths. Better error recovery
  81 mechanisms will be provided in the future.
  82
  83 Currently, the module merely wraps calls to external Git tools. In the future,
  84 it will provide a much faster way to interact with Git by linking directly
  85 to libgit. This should be completely opaque to the user, though (performance
  86 increate nonwithstanding).
  87
  88 =cut
  89
  90
  91 use Carp qw(carp); # croak is bad - throw instead
  92 use Error qw(:try);
  93
  94 require XSLoader;
  95 XSLoader::load('Git', $VERSION);
  96
  97 }
  98
  99
 100 =head1 CONSTRUCTORS
 101
 102 =over 4
 103
 104 =item repository ( OPTIONS )
 105
 106 =item repository ( DIRECTORY )
 107
 108 =item repository ()
 109
 110 Construct a new repository object.
 111 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
 112 Possible options are:
 113
 114 B<Repository> - Path to the Git repository.
 115
 116 B<WorkingCopy> - Path to the associated working copy; not strictly required
 117 as many commands will happily crunch on a bare repository.
 118
 119 B<Directory> - Path to the Git working directory in its usual setup. This
 120 is just for convenient setting of both C<Repository> and C<WorkingCopy>
 121 at once: If the directory as a C<.git> subdirectory, C<Repository> is pointed
 122 to the subdirectory and the directory is assumed to be the working copy.
 123 If the directory does not have the subdirectory, C<WorkingCopy> is left
 124 undefined and C<Repository> is pointed to the directory itself.
 125
 126 You should not use both C<Directory> and either of C<Repository> and
 127 C<WorkingCopy> - the results of that are undefined.
 128
 129 Alternatively, a directory path may be passed as a single scalar argument
 130 to the constructor; it is equivalent to setting only the C<Directory> option
 131 field.
 132
 133 Calling the constructor with no options whatsoever is equivalent to
 134 calling it with C<< Directory => '.' >>.
 135
 136 =cut
 137
 138 sub repository {
 139         my $class = shift;
 140         my @args = @_;
 141         my %opts = ();
 142         my $self;
 143
 144         if (defined $args[0]) {
 145                 if ($#args % 2 != 1) {
 146                         # Not a hash.
 147                         $#args == 0 or throw Error::Simple("bad usage");
 148                         %opts = ( Directory => $args[0] );
 149                 } else {
 150                         %opts = @args;
 151                 }
 152
 153                 if ($opts{Directory}) {
 154                         -d $opts{Directory} or throw Error::Simple("Directory not found: $!");
 155                         if (-d $opts{Directory}."/.git") {
 156                                 # TODO: Might make this more clever
 157                                 $opts{WorkingCopy} = $opts{Directory};
 158                                 $opts{Repository} = $opts{Directory}."/.git";
 159                         } else {
 160                                 $opts{Repository} = $opts{Directory};
 161                         }
 162                         delete $opts{Directory};
 163                 }
 164         }
 165
 166         $self = { opts => \%opts };
 167         bless $self, $class;
 168 }
 169
 170
 171 =back
 172
 173 =head1 METHODS
 174
 175 =over 4
 176
 177 =item command ( COMMAND [, ARGUMENTS... ] )
 178
 179 Execute the given Git C<COMMAND> (specify it without the 'git-'
 180 prefix), optionally with the specified extra C<ARGUMENTS>.
 181
 182 The method can be called without any instance or on a specified Git repository
 183 (in that case the command will be run in the repository context).
 184
 185 In scalar context, it returns all the command output in a single string
 186 (verbatim).
 187
 188 In array context, it returns an array containing lines printed to the
 189 command's stdout (without trailing newlines).
 190
 191 In both cases, the command's stdin and stderr are the same as the caller's.
 192
 193 =cut
 194
 195 sub command {
 196         my $fh = command_pipe(@_);
 197
 198         if (not defined wantarray) {
 199                 _cmd_close($fh);
 200
 201         } elsif (not wantarray) {
 202                 local $/;
 203                 my $text = <$fh>;
 204                 _cmd_close($fh);
 205                 return $text;
 206
 207         } else {
 208                 my @lines = <$fh>;
 209                 _cmd_close($fh);
 210                 chomp @lines;
 211                 return @lines;
 212         }
 213 }
 214
 215
 216 =item command_oneline ( COMMAND [, ARGUMENTS... ] )
 217
 218 Execute the given C<COMMAND> in the same way as command()
 219 does but always return a scalar string containing the first line
 220 of the command's standard output.
 221
 222 =cut
 223
 224 sub command_oneline {
 225         my $fh = command_pipe(@_);
 226
 227         my $line = <$fh>;
 228         _cmd_close($fh);
 229
 230         chomp $line;
 231         return $line;
 232 }
 233
 234
 235 =item command_pipe ( COMMAND [, ARGUMENTS... ] )
 236
 237 Execute the given C<COMMAND> in the same way as command()
 238 does but return a pipe filehandle from which the command output can be
 239 read.
 240
 241 =cut
 242
 243 sub command_pipe {
 244         my ($self, $cmd, @args) = _maybe_self(@_);
 245
 246         $cmd =~ /^[a-z0-9A-Z_-]+$/ or throw Error::Simple("bad command: $cmd");
 247
 248         my $pid = open(my $fh, "-|");
 249         if (not defined $pid) {
 250                 throw Error::Simple("open failed: $!");
 251         } elsif ($pid == 0) {
 252                 _cmd_exec($self, $cmd, @args);
 253         }
 254         return $fh;
 255 }
 256
 257
 258 =item command_noisy ( COMMAND [, ARGUMENTS... ] )
 259
 260 Execute the given C<COMMAND> in the same way as command() does but do not
 261 capture the command output - the standard output is not redirected and goes
 262 to the standard output of the caller application.
 263
 264 While the method is called command_noisy(), you might want to as well use
 265 it for the most silent Git commands which you know will never pollute your
 266 stdout but you want to avoid the overhead of the pipe setup when calling them.
 267
 268 The function returns only after the command has finished running.
 269
 270 =cut
 271
 272 sub command_noisy {
 273         my ($self, $cmd, @args) = _maybe_self(@_);
 274
 275         $cmd =~ /^[a-z0-9A-Z_-]+$/ or throw Error::Simple("bad command: $cmd");
 276
 277         my $pid = fork;
 278         if (not defined $pid) {
 279                 throw Error::Simple("fork failed: $!");
 280         } elsif ($pid == 0) {
 281                 _cmd_exec($self, $cmd, @args);
 282         }
 283         if (waitpid($pid, 0) > 0 and $? != 0) {
 284                 # This is the best candidate for a custom exception class.
 285                 throw Error::Simple("exit status: $?");
 286         }
 287 }
 288
 289
 290 =item version ()
 291
 292 Return the Git version in use.
 293
 294 Implementation of this function is very fast; no external command calls
 295 are involved.
 296
 297 =cut
 298
 299 # Implemented in Git.xs.
 300
 301
 302 =item exec_path ()
 303
 304 Return path to the git sub-command executables (the same as
 305 C<git --exec-path>). Useful mostly only internally.
 306
 307 Implementation of this function is very fast; no external command calls
 308 are involved.
 309
 310 =cut
 311
 312 # Implemented in Git.xs.
 313
 314
 315 =item hash_object ( FILENAME [, TYPE ] )
 316
 317 =item hash_object ( FILEHANDLE [, TYPE ] )
 318
 319 Compute the SHA1 object id of the given C<FILENAME> (or data waiting in
 320 C<FILEHANDLE>) considering it is of the C<TYPE> object type (C<blob>
 321 (default), C<commit>, C<tree>).
 322
 323 In case of C<FILEHANDLE> passed instead of file name, all the data
 324 available are read and hashed, and the filehandle is automatically
 325 closed. The file handle should be freshly opened - if you have already
 326 read anything from the file handle, the results are undefined (since
 327 this function works directly with the file descriptor and internal
 328 PerlIO buffering might have messed things up).
 329
 330 The method can be called without any instance or on a specified Git repository,
 331 it makes zero difference.
 332
 333 The function returns the SHA1 hash.
 334
 335 Implementation of this function is very fast; no external command calls
 336 are involved.
 337
 338 =cut
 339
 340 # Implemented in Git.xs.
 341
 342
 343 =back
 344
 345 =head1 ERROR HANDLING
 346
 347 All functions are supposed to throw Perl exceptions in case of errors.
 348 See L<Error>.
 349
 350 =head1 COPYRIGHT
 351
 352 Copyright 2006 by Petr Baudis E<lt>pasky@suse.czE<gt>.
 353
 354 This module is free software; it may be used, copied, modified
 355 and distributed under the terms of the GNU General Public Licence,
 356 either version 2, or (at your option) any later version.
 357
 358 =cut
 359
 360
 361 # Take raw method argument list and return ($obj, @args) in case
 362 # the method was called upon an instance and (undef, @args) if
 363 # it was called directly.
 364 sub _maybe_self {
 365         # This breaks inheritance. Oh well.
 366         ref $_[0] eq 'Git' ? @_ : (undef, @_);
 367 }
 368
 369 # When already in the subprocess, set up the appropriate state
 370 # for the given repository and execute the git command.
 371 sub _cmd_exec {
 372         my ($self, @args) = @_;
 373         if ($self) {
 374                 $self->{opts}->{Repository} and $ENV{'GIT_DIR'} = $self->{opts}->{Repository};
 375                 $self->{opts}->{WorkingCopy} and chdir($self->{opts}->{WorkingCopy});
 376         }
 377         _execv_git_cmd(@args);
 378         die "exec failed: $!";
 379 }
 380
 381 # Execute the given Git command ($_[0]) with arguments ($_[1..])
 382 # by searching for it at proper places.
 383 # _execv_git_cmd(), implemented in Git.xs.
 384
 385 # Close pipe to a subprocess.
 386 sub _cmd_close {
 387         my ($fh) = @_;
 388         if (not close $fh) {
 389                 if ($!) {
 390                         # It's just close, no point in fatalities
 391                         carp "error closing pipe: $!";
 392                 } elsif ($? >> 8) {
 393                         # This is the best candidate for a custom exception class.
 394                         throw Error::Simple("exit status: ".($? >> 8));
 395                 }
 396                 # else we might e.g. closed a live stream; the command
 397                 # dying of SIGPIPE would drive us here.
 398         }
 399 }
 400
 401
 402 # Trickery for .xs routines: In order to avoid having some horrid
 403 # C code trying to do stuff with undefs and hashes, we gate all
 404 # xs calls through the following and in case we are being ran upon
 405 # an instance call a C part of the gate which will set up the
 406 # environment properly.
 407 sub _call_gate {
 408         my $xsfunc = shift;
 409         my ($self, @args) = _maybe_self(@_);
 410
 411         if (defined $self) {
 412                 # XXX: We ignore the WorkingCopy! To properly support
 413                 # that will require heavy changes in libgit.
 414
 415                 # XXX: And we ignore everything else as well. libgit
 416                 # at least needs to be extended to let us specify
 417                 # the $GIT_DIR instead of looking it up in environment.
 418                 #xs_call_gate($self->{opts}->{Repository});
 419         }
 420
 421         # Having to call throw from the C code is a sure path to insanity.
 422         local $SIG{__DIE__} = sub { throw Error::Simple("@_"); };
 423         &$xsfunc(@args);
 424 }
 425
 426 sub AUTOLOAD {
 427         my $xsname;
 428         our $AUTOLOAD;
 429         ($xsname = $AUTOLOAD) =~ s/.*:://;
 430         throw Error::Simple("&Git::$xsname not defined") if $xsname =~ /^xs_/;
 431         $xsname = 'xs_'.$xsname;
 432         _call_gate(\&$xsname, @_);
 433 }
 434
 435 sub DESTROY { }
 436
 437
 438 1; # Famous last words