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 version 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 { 138my$class=shift; 139my@args=@_; 140my%opts= (); 141my$self; 142 143if(defined$args[0]) { 144if($#args%2!=1) { 145# Not a hash. 146$#args==0or croak "bad usage"; 147%opts= (Directory =>$args[0]); 148}else{ 149%opts=@args; 150} 151 152if($opts{Directory}) { 153-d $opts{Directory}or croak "Directory not found:$!"; 154if(-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} 161delete$opts{Directory}; 162} 163} 164 165$self= { opts => \%opts}; 166bless$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 { 195my$fh= command_pipe(@_); 196 197if(not defined wantarray) { 198 _cmd_close($fh); 199 200}elsif(not wantarray) { 201local$/; 202my$text= <$fh>; 203 _cmd_close($fh); 204return$text; 205 206}else{ 207my@lines= <$fh>; 208 _cmd_close($fh); 209chomp@lines; 210return@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 { 224my$fh= command_pipe(@_); 225 226my$line= <$fh>; 227 _cmd_close($fh); 228 229chomp$line; 230return$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 { 243my($self,$cmd,@args) = _maybe_self(@_); 244 245$cmd=~/^[a-z0-9A-Z_-]+$/or croak "bad command:$cmd"; 246 247my$pid=open(my$fh,"-|"); 248if(not defined$pid) { 249 croak "open failed:$!"; 250}elsif($pid==0) { 251 _cmd_exec($self,$cmd,@args); 252} 253return$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 { 272my($self,$cmd,@args) = _maybe_self(@_); 273 274$cmd=~/^[a-z0-9A-Z_-]+$/or croak "bad command:$cmd"; 275 276my$pid=fork; 277if(not defined$pid) { 278 croak "fork failed:$!"; 279}elsif($pid==0) { 280 _cmd_exec($self,$cmd,@args); 281} 282if(waitpid($pid,0) >0and$?!=0) { 283 croak "exit status:$?"; 284} 285} 286 287 288=item version () 289 290Return the Git version in use. 291 292Implementation of this function is very fast; no external command calls 293are involved. 294 295=cut 296 297# Implemented in Git.xs. 298 299 300=item exec_path () 301 302Return path to the git sub-command executables (the same as 303C<git --exec-path>). Useful mostly only internally. 304 305Implementation of this function is very fast; no external command calls 306are involved. 307 308=cut 309 310# Implemented in Git.xs. 311 312 313=item hash_object ( FILENAME [, TYPE ] ) 314 315=item hash_object ( FILEHANDLE [, TYPE ] ) 316 317Compute the SHA1 object id of the given C<FILENAME> (or data waiting in 318C<FILEHANDLE>) considering it is of the C<TYPE> object type (C<blob> 319(default), C<commit>, C<tree>). 320 321In case of C<FILEHANDLE> passed instead of file name, all the data 322available are read and hashed, and the filehandle is automatically 323closed. The file handle should be freshly opened - if you have already 324read anything from the file handle, the results are undefined (since 325this function works directly with the file descriptor and internal 326PerlIO buffering might have messed things up). 327 328The method can be called without any instance or on a specified Git repository, 329it makes zero difference. 330 331The function returns the SHA1 hash. 332 333Implementation of this function is very fast; no external command calls 334are involved. 335 336=cut 337 338# Implemented in Git.xs. 339 340 341=back 342 343=head1 TODO 344 345This is still fairly crude. 346We need some good way to report errors back except just dying. 347 348=head1 COPYRIGHT 349 350Copyright 2006 by Petr Baudis E<lt>pasky@suse.czE<gt>. 351 352This module is free software; it may be used, copied, modified 353and distributed under the terms of the GNU General Public Licence, 354either version 2, or (at your option) any later version. 355 356=cut 357 358 359# Take raw method argument list and return ($obj, @args) in case 360# the method was called upon an instance and (undef, @args) if 361# it was called directly. 362sub _maybe_self { 363# This breaks inheritance. Oh well. 364ref$_[0]eq'Git'?@_: (undef,@_); 365} 366 367# When already in the subprocess, set up the appropriate state 368# for the given repository and execute the git command. 369sub _cmd_exec { 370my($self,@args) =@_; 371if($self) { 372$self->{opts}->{Repository}and$ENV{'GIT_DIR'} =$self->{opts}->{Repository}; 373$self->{opts}->{WorkingCopy}and chdir($self->{opts}->{WorkingCopy}); 374} 375 xs__execv_git_cmd(@args); 376 croak "exec failed:$!"; 377} 378 379# Execute the given Git command ($_[0]) with arguments ($_[1..]) 380# by searching for it at proper places. 381# _execv_git_cmd(), implemented in Git.xs. 382 383# Close pipe to a subprocess. 384sub _cmd_close { 385my($fh) =@_; 386if(not close$fh) { 387if($!) { 388# It's just close, no point in fatalities 389 carp "error closing pipe:$!"; 390}elsif($?>>8) { 391 croak "exit status: ".($?>>8); 392} 393# else we might e.g. closed a live stream; the command 394# dying of SIGPIPE would drive us here. 395} 396} 397 398 399# Trickery for .xs routines: In order to avoid having some horrid 400# C code trying to do stuff with undefs and hashes, we gate all 401# xs calls through the following and in case we are being ran upon 402# an instance call a C part of the gate which will set up the 403# environment properly. 404sub _call_gate { 405my$xsfunc=shift; 406my($self,@args) = _maybe_self(@_); 407 408if(defined$self) { 409# XXX: We ignore the WorkingCopy! To properly support 410# that will require heavy changes in libgit. 411 412# XXX: And we ignore everything else as well. libgit 413# at least needs to be extended to let us specify 414# the $GIT_DIR instead of looking it up in environment. 415#xs_call_gate($self->{opts}->{Repository}); 416} 417 418&$xsfunc(@args); 419} 420 421sub AUTOLOAD { 422my$xsname; 423our$AUTOLOAD; 424($xsname=$AUTOLOAD) =~s/.*:://; 425 croak "&Git::$xsnamenot defined"if$xsname=~/^xs_/; 426$xsname='xs_'.$xsname; 427 _call_gate(\&$xsname,@_); 428} 429 430sub DESTROY { } 431 432 4331;# Famous last words