File manager

File manager - Edit - /usr/local/cpanel/3rdparty/perl/542/cpanel-lib/Git/Repository/Command.pm

Back
package Git::Repository::Command; $Git::Repository::Command::VERSION = '1.325'; use strict; use warnings; use 5.006; use Carp; use Cwd qw( cwd ); use IO::Handle; use Scalar::Util qw( blessed ); use File::Spec; use System::Command; our @ISA = qw( System::Command ); # a few simple accessors for my $attr (qw( pid stdin stdout stderr exit signal core )) { no strict 'refs'; $attr = sub { return $_[0]{$attr} }; } for my $attr (qw( cmdline )) { no strict 'refs'; $attr = sub { return @{ $_[0]{$attr} } }; } sub _which { my @pathext = (''); push @pathext, $^O eq 'MSWin32' ? split ';', $ENV{PATHEXT} : $^O eq 'cygwin' ? qw( .com .exe .bat ) : (); for my $path ( File::Spec->path ) { for my $ext (@pathext) { my $binary = File::Spec->catfile( $path, $_[0] . $ext ); return $binary if -x $binary && !-d _; } } # not found return undef; } # CAN I HAS GIT? my %binary; # cache calls to _is_git sub _is_git { my ( $binary, @args ) = @_; my $args = join "\0", @args; # git option might be an arrayref containing an executable with arguments # Best that can be done is to check if the first part is executable # and use the arguments as part of the cache key # compute cache key: # - filename (path-rel): $CWD \0 $PATH # - filename (path): $PATH # - absolute path (abs): empty string # - relative path (rel): dirname my $path = defined $ENV{PATH} && length( $ENV{PATH} ) ? $ENV{PATH} : ''; my ( $type, $key ) = ( File::Spec->splitpath($binary) )[2] eq $binary ? grep( !File::Spec->file_name_is_absolute($_), File::Spec->path ) ? ( 'path-rel', join "\0", cwd(), $path ) : ( 'path', $path ) : File::Spec->file_name_is_absolute($binary) ? ( 'abs', '' ) : ( 'rel', cwd() ); # This relatively complex cache key scheme allows PATH or cwd to change # during the life of a program using Git::Repository, which is likely # to happen. On the other hand, it completely ignores the possibility # that any part of the cached path to a git binary could be a symlink # which target may also change during the life of the program. # check the cache return $binary{$type}{$key}{$binary}{$args} if exists $binary{$type}{$key}{$binary}{$args}; # compute a list of candidate files (look in PATH if needed) my $git = $type =~ /^path/ ? _which($binary) : File::Spec->rel2abs($binary); $git = File::Spec->rel2abs($git) if defined $git && $type eq 'path-rel'; # if we can't find any, we're done return $binary{$type}{$key}{$binary} = undef if !( defined $git && -x $git ); # try to run it my $cmd = System::Command->new( $git, @args, '--version' ); my $version = do { local $/ = "\n"; $cmd->stdout->getline; } \|\| ''; $cmd->close; # does it really look like git? return $binary{$type}{$key}{$binary}{$args} = $version =~ /^git version \d/ ? $type eq 'path' ? $binary # leave the shell figure it out itself too : $git : undef; } sub new { my ( $class, @cmd ) = @_; # split the args my (@r, @o); @cmd = # take out the first Git::Repository in $r, and options in @o grep !( blessed $_ && $_->isa('Git::Repository') ? push @r, $_ : 0 ), grep !( ref eq 'HASH' ? push @o, $_ : 0 ), @cmd; # wouldn't know what to do with more than one Git::Repository object croak "Too many Git::Repository objects given: @r" if @r > 1; my $r = shift @r; # keep changes to the environment local local %ENV = %ENV; # a Git::Repository object will give more context if ($r) { # pick up repository options unshift @o, $r->options; # get some useful paths my ( $git_dir, $work_tree ) = ( $r->git_dir, $r->work_tree ); unshift @o, { cwd => $work_tree } if defined $work_tree && length $work_tree; # setup our %ENV delete @ENV{qw( GIT_DIR GIT_WORK_TREE )}; $ENV{GIT_DIR} = $git_dir; $ENV{GIT_WORK_TREE} = $work_tree if defined $work_tree; } # pick up the modified PATH, if any exists $_->{env} and exists $_->{env}{PATH} and $ENV{PATH} = $_->{env}{PATH} for @o; # extract and process the 'fatal' option push @o, { fatal => { 128 => 1, # fatal 129 => 1, # usage map s/^-// ? ( $_ => '' ) : ( $_ => 1 ), map /^!0$/ ? ( 1 .. 255 ) : $_, map ref() ? @$_ : $_, grep defined, map $_->{fatal}, @o } }; # get and check the git command my $git_cmd = ( map { exists $_->{git} ? $_->{git} : () } @o )[-1]; # git option might be an arrayref containing an executable with arguments # (e.g. [ qw( /usr/bin/sudo -u nobody git ) ] ) ( $git_cmd, my @args ) = defined $git_cmd ? ref $git_cmd ? @$git_cmd : ($git_cmd) : ('git'); my $git = _is_git($git_cmd, @args); croak sprintf "git binary '%s' not available or broken", join( ' ', $git_cmd, @args ) # show the full command given if !defined $git; # turn us into a dumb terminal delete $ENV{TERM}; # spawn the command and re-bless the object in our class return bless System::Command->new( $git, @args, @cmd, @o ), $class; } sub final_output { my ($self, @cb) = @_; # get output / errput my ( @output, @errput ); $self->loop_on( input_record_separator => "\n", stdout => sub { chomp( my $o = shift ); push @output, $o; }, stderr => sub { chomp( my $e = shift ); push @errput, $e; }, ); # done with it $self->close; # fatal exit codes set by the 'fatal' option # when working with fatal => '!0' it's helpful to be able to show the exit status # so that specific exit codes can be made non-fatal if desired. if ( $self->options->{fatal}{ $self->exit } ) { croak join( "\n", @errput ) \|\| 'fatal: unknown git error, exit status '.$self->exit; } # something else's wrong if ( @errput && !$self->options->{quiet} ) { carp join "\n", @errput; } # process the output with the optional callbacks for my $cb (@cb) { @output = map $cb->($_), @output; } # return the output return wantarray ? @output : join "\n", @output; } 1; __END__ =head1 NAME Git::Repository::Command - Command objects for running git =pod =head1 SYNOPSIS use Git::Repository::Command; # invoke an external git command, and return an object $cmd = Git::Repository::Command->new(@cmd); # a Git::Repository object can provide more context $cmd = Git::Repository::Command->new( $r, @cmd ); # options can be passed as a hashref $cmd = Git::Repository::Command->new( $r, @cmd, \%option ); # $cmd is basically a hash, with keys / accessors $cmd->stdin(); # filehandle to the process' stdin (write) $cmd->stdout(); # filehandle to the process' stdout (read) $cmd->stderr(); # filehandle to the process' stdout (read) $cmd->pid(); # pid of the child process # done! $cmd->close(); # exit information $cmd->exit(); # exit status $cmd->signal(); # signal $cmd->core(); # core dumped? (boolean) # cut to the chase my ( $pid, $in, $out, $err ) = Git::Repository::Command->spawn(@cmd); =head1 DESCRIPTION L<Git::Repository::Command> is a class that actually launches a B<git> commands, allowing to interact with it through its C<STDIN>, C<STDOUT> and C<STDERR>. This class is a subclass of L<System::Command>, meant to be invoked through L<Git::Repository>. =head1 METHODS As a subclass of L<System::Command>, L<Git::Repository::Command> supports the following methods: =head2 new Git::Repository::Command->new( @cmd ); Runs a B<git> command with the parameters in C<@cmd>. If C<@cmd> contains a L<Git::Repository> object, it is used to provide context to the B<git> command. If C<@cmd> contains one or more hash reference, they are taken as I<option> hashes. The recognized keys are: =over 4 =item C<git> The actual git binary to run. By default, it is just C<git>. In case the C<git> to be run is actually a command with parameters (e.g. when using B<sudo> or another command executer), the option value should be an array reference with the command and parameters, like this: { git => [qw( sudo -u nobody git )] } =item C<cwd> The I<current working directory> in which the git command will be run. (C<chdir()> will be called just before launching the command.) If not provided, it will default to the root of the Git repository work tree (if the repository is bare, then no C<chdir()> will be performed). =item C<env> A hashref containing key / values to add to the git command environment. =item C<fatal> An arrayref containing a list of exit codes that will be considered fatal by C<final_output()>. Prepending the value with C<-> will make it non-fatal, which can be useful to override a default. The string C<"!0"> can be used as a shortcut for C<[ 1 .. 255 ]>. If several option hashes have the C<fatal> key, the lists of exit codes will be combined, with the values provided last taking precedence (when using a combination of positive / negative values). The generated list always contains C<128> and C<129>; to make them non-fatal, just add C<-128> and C<-129> to the list provided to the C<fatal> option. =item C<input> A string that is send to the git command standard input, which is then closed. Using the empty string as C<input> will close the git command standard input without writing to it. Using C<undef> as C<input> will not do anything. This behaviour provides a way to modify options inherited from C<new()> or a hash populated by some other part of the program. On some systems, some git commands may close standard input on startup, which will cause a C<SIGPIPE> when trying to write to it. This will raise an exception. =item C<quiet> Boolean option to control the output of warnings. If true, methods such as C<final_output()> will not warn when Git outputs messages on C<STDERR>. =back If the L<Git::Repository> object has its own option hash, it will be used to provide default values that can be overridden by the actual option hash passed to C<new()>. If several option hashes are passed to C<new()>, they will all be merged, keys in later hashes taking precedence over keys in earlier hashes. The L<Git::Repository::Command> object returned by C<new()> has a number of attributes defined (see below). =head2 close $cmd->close(); Close all pipes to the child process, and collects exit status, etc. and defines a number of attributes (see below). =head2 final_output $cmd->final_output( @callbacks ); Collect all the output, and terminate the command. Returns the output as a string in scalar context, or as a list of lines in list context. Also accepts a hashref of options. Lines are automatically C<chomp>ed. If C<@callbacks> is provided, the code references will be applied successively to each line of output. The line being processed is in C<$_>, but the coderef must still return the result string. If the Git command printed anything on stderr, it will be printed as warnings. If the git sub-process exited with a status code listed in the C<fatal> option, it will C<die()>. The defaults fatal exit codes are C<128> (fatal error), and C<129> (usage message). =head2 Accessors The attributes of a L<Git::Repository::Command> object are also accessible through a number of accessors. The object returned by C<new()> will have the following attributes defined: =over 4 =item cmdline Return the command-line actually executed, as a list of strings. =item pid The PID of the underlying B<git> command. =item stdin A filehandle opened in write mode to the child process' standard input. =item stdout A filehandle opened in read mode to the child process' standard output. =item stderr A filehandle opened in read mode to the child process' standard error output. =back Regarding the handles to the child git process, note that in the following code: my $fh = Git::Repository::Command->new( @cmd )->stdout; C<$fh> is opened and points to the output of the git subcommand, while the anonymous L<Git::Repository::Command> object has been destroyed. After the call to C<close()>, the following attributes will be defined: =over 4 =item exit The exit status of the underlying B<git> command. =item core A boolean value indicating if the command dumped core. =item signal The signal, if any, that killed the command. =back =head1 AUTHOR Philippe Bruhat (BooK) <book@cpan.org> =head1 ACKNOWLEDGEMENTS The core of L<Git::Repository::Command> has been moved into its own distribution: L<System::Command>. Proper Win32 support is now delegated to that module. Before that, the Win32 implementation owed a lot to two people. First, Olivier Raginel (BABAR), who provided me with a test platform with Git and Strawberry Perl installed, which I could use at any time. Many thanks go also to Chris Williams (BINGOS) for pointing me towards perlmonks posts by ikegami that contained crucial elements to a working MSWin32 implementation. In the end, it was Christian Walder (MITHALDU) who helped me finalize Win32 support for L<System::Command> through a quick round of edit (on my Linux box) and testing (on his Windows box) during the Perl QA Hackathon 2013 in Lancaster. =head1 COPYRIGHT Copyright 2010-2016 Philippe Bruhat (BooK), all rights reserved. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut

| ver. 1.4 | Github | . | PHP 8.1.34 | Generation time: 0.03 | proxy | phpinfo | Settings