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