File manager - Edit - /home/c14075/dragmet-ural.ru/www/Git.tar
Back
LoadCPAN.pm 0000644 00000006553 15137205472 0006442 0 ustar 00 package Git::LoadCPAN; use 5.008; use strict; use warnings $ENV{GIT_PERL_FATAL_WARNINGS} ? qw(FATAL all) : (); =head1 NAME Git::LoadCPAN - Wrapper for loading modules from the CPAN (OS) or Git's own copy =head1 DESCRIPTION The Perl code in Git depends on some modules from the CPAN, but we don't want to make those a hard requirement for anyone building from source. Therefore the L<Git::LoadCPAN> namespace shipped with Git contains wrapper modules like C<Git::LoadCPAN::Module::Name> that will first attempt to load C<Module::Name> from the OS, and if that doesn't work will fall back on C<FromCPAN::Module::Name> shipped with Git itself. Usually distributors will not ship with Git's Git::FromCPAN tree at all via the C<NO_PERL_CPAN_FALLBACKS> option, preferring to use their own packaging of CPAN modules instead. This module is only intended to be used for code shipping in the C<git.git> repository. Use it for anything else at your peril! =cut # NO_PERL_CPAN_FALLBACKS_STR evades the sed search-replace from the # Makefile, and allows for detecting whether the module is loaded from # perl/Git as opposed to perl/build/Git, which is useful for one-off # testing without having Error.pm et al installed. use constant NO_PERL_CPAN_FALLBACKS_STR => '@@' . 'NO_PERL_CPAN_FALLBACKS' . '@@'; use constant NO_PERL_CPAN_FALLBACKS => ( q[1] ne '' and q[1] ne NO_PERL_CPAN_FALLBACKS_STR ); sub import { shift; my $caller = caller; my %args = @_; my $module = exists $args{module} ? delete $args{module} : die "BUG: Expected 'module' parameter!"; my $import = exists $args{import} ? delete $args{import} : die "BUG: Expected 'import' parameter!"; die "BUG: Too many arguments!" if keys %args; # Foo::Bar to Foo/Bar.pm my $package_pm = $module; $package_pm =~ s[::][/]g; $package_pm .= '.pm'; eval { require $package_pm; 1; } or do { my $error = $@ || "Zombie Error"; if (NO_PERL_CPAN_FALLBACKS) { chomp(my $error = sprintf <<'THEY_PROMISED', $module); BUG: The '%s' module is not here, but NO_PERL_CPAN_FALLBACKS was set! Git needs this Perl module from the CPAN, and will by default ship with a copy of it. This Git was built with NO_PERL_CPAN_FALLBACKS, meaning that whoever built it promised to provide this module. You're seeing this error because they broke that promise, and we can't load our fallback version, since we were asked not to install it. If you're seeing this error and didn't package Git yourself the package you're using is broken, or your system is broken. This error won't appear if Git is built without NO_PERL_CPAN_FALLBACKS (instead we'll use our fallback version of the module). THEY_PROMISED die $error; } my $Git_LoadCPAN_pm_path = $INC{"Git/LoadCPAN.pm"} || die "BUG: Should have our own path from %INC!"; require File::Basename; my $Git_LoadCPAN_pm_root = File::Basename::dirname($Git_LoadCPAN_pm_path) || die "BUG: Can't figure out lib/Git dirname from '$Git_LoadCPAN_pm_path'!"; require File::Spec; my $Git_pm_FromCPAN_root = File::Spec->catdir($Git_LoadCPAN_pm_root, '..', 'FromCPAN'); die "BUG: '$Git_pm_FromCPAN_root' should be a directory!" unless -d $Git_pm_FromCPAN_root; local @INC = ($Git_pm_FromCPAN_root, @INC); require $package_pm; }; if ($import) { no strict 'refs'; *{"${caller}::import"} = sub { shift; use strict 'refs'; unshift @_, $module; goto &{"${module}::import"}; }; use strict 'refs'; } } 1; Packet.pm 0000644 00000010124 15137205472 0006315 0 ustar 00 package Git::Packet; use 5.008; use strict; use warnings $ENV{GIT_PERL_FATAL_WARNINGS} ? qw(FATAL all) : (); BEGIN { require Exporter; if ($] < 5.008003) { *import = \&Exporter::import; } else { # Exporter 5.57 which supports this invocation was # released with perl 5.8.3 Exporter->import('import'); } } our @EXPORT = qw( packet_compare_lists packet_bin_read packet_txt_read packet_key_val_read packet_bin_write packet_txt_write packet_flush packet_initialize packet_read_capabilities packet_read_and_check_capabilities packet_check_and_write_capabilities ); our @EXPORT_OK = @EXPORT; sub packet_compare_lists { my ($expect, @result) = @_; my $ix; if (scalar @$expect != scalar @result) { return undef; } for ($ix = 0; $ix < $#result; $ix++) { if ($expect->[$ix] ne $result[$ix]) { return undef; } } return 1; } sub packet_bin_read { my $buffer; my $bytes_read = read STDIN, $buffer, 4; if ( $bytes_read == 0 ) { # EOF - Git stopped talking to us! return ( -1, "" ); } elsif ( $bytes_read != 4 ) { die "invalid packet: '$buffer'"; } my $pkt_size = hex($buffer); if ( $pkt_size == 0 ) { return ( 1, "" ); } elsif ( $pkt_size > 4 ) { my $content_size = $pkt_size - 4; $bytes_read = read STDIN, $buffer, $content_size; if ( $bytes_read != $content_size ) { die "invalid packet ($content_size bytes expected; $bytes_read bytes read)"; } return ( 0, $buffer ); } else { die "invalid packet size: $pkt_size"; } } sub remove_final_lf_or_die { my $buf = shift; if ( $buf =~ s/\n$// ) { return $buf; } die "A non-binary line MUST be terminated by an LF.\n" . "Received: '$buf'"; } sub packet_txt_read { my ( $res, $buf ) = packet_bin_read(); if ( $res != -1 and $buf ne '' ) { $buf = remove_final_lf_or_die($buf); } return ( $res, $buf ); } # Read a text packet, expecting that it is in the form "key=value" for # the given $key. An EOF does not trigger any error and is reported # back to the caller (like packet_txt_read() does). Die if the "key" # part of "key=value" does not match the given $key, or the value part # is empty. sub packet_key_val_read { my ( $key ) = @_; my ( $res, $buf ) = packet_txt_read(); if ( $res == -1 or ( $buf =~ s/^$key=// and $buf ne '' ) ) { return ( $res, $buf ); } die "bad $key: '$buf'"; } sub packet_bin_write { my $buf = shift; print STDOUT sprintf( "%04x", length($buf) + 4 ); print STDOUT $buf; STDOUT->flush(); } sub packet_txt_write { packet_bin_write( $_[0] . "\n" ); } sub packet_flush { print STDOUT sprintf( "%04x", 0 ); STDOUT->flush(); } sub packet_initialize { my ($name, $version) = @_; packet_compare_lists([0, $name . "-client"], packet_txt_read()) || die "bad initialize"; packet_compare_lists([0, "version=" . $version], packet_txt_read()) || die "bad version"; packet_compare_lists([1, ""], packet_bin_read()) || die "bad version end"; packet_txt_write( $name . "-server" ); packet_txt_write( "version=" . $version ); packet_flush(); } sub packet_read_capabilities { my @cap; while (1) { my ( $res, $buf ) = packet_bin_read(); if ( $res == -1 ) { die "unexpected EOF when reading capabilities"; } return ( $res, @cap ) if ( $res != 0 ); $buf = remove_final_lf_or_die($buf); unless ( $buf =~ s/capability=// ) { die "bad capability buf: '$buf'"; } push @cap, $buf; } } # Read remote capabilities and check them against capabilities we require sub packet_read_and_check_capabilities { my @required_caps = @_; my ($res, @remote_caps) = packet_read_capabilities(); my %remote_caps = map { $_ => 1 } @remote_caps; foreach (@required_caps) { unless (exists($remote_caps{$_})) { die "required '$_' capability not available from remote" ; } } return %remote_caps; } # Check our capabilities we want to advertise against the remote ones # and then advertise our capabilities sub packet_check_and_write_capabilities { my ($remote_caps, @our_caps) = @_; foreach (@our_caps) { unless (exists($remote_caps->{$_})) { die "our capability '$_' is not available from remote" } packet_txt_write( "capability=" . $_ ); } packet_flush(); } 1; LoadCPAN/Mail/Address.pm 0000644 00000000303 15137205472 0010674 0 ustar 00 package Git::LoadCPAN::Mail::Address; use 5.008; use strict; use warnings $ENV{GIT_PERL_FATAL_WARNINGS} ? qw(FATAL all) : (); use Git::LoadCPAN ( module => 'Mail::Address', import => 0, ); 1; LoadCPAN/Error.pm 0000644 00000000263 15137205472 0007523 0 ustar 00 package Git::LoadCPAN::Error; use 5.008; use strict; use warnings $ENV{GIT_PERL_FATAL_WARNINGS} ? qw(FATAL all) : (); use Git::LoadCPAN ( module => 'Error', import => 1, ); 1; IndexInfo.pm 0000644 00000001520 15137205472 0006771 0 ustar 00 package Git::IndexInfo; use strict; use warnings $ENV{GIT_PERL_FATAL_WARNINGS} ? qw(FATAL all) : (); use Git qw/command_input_pipe command_close_pipe/; sub new { my ($class) = @_; my $hash_algo = Git::config('extensions.objectformat') || 'sha1'; my ($gui, $ctx) = command_input_pipe(qw/update-index -z --index-info/); bless { gui => $gui, ctx => $ctx, nr => 0, hash_algo => $hash_algo}, $class; } sub remove { my ($self, $path) = @_; my $length = $self->{hash_algo} eq 'sha256' ? 64 : 40; if (print { $self->{gui} } '0 ', 0 x $length, "\t", $path, "\0") { return ++$self->{nr}; } undef; } sub update { my ($self, $mode, $hash, $path) = @_; if (print { $self->{gui} } $mode, ' ', $hash, "\t", $path, "\0") { return ++$self->{nr}; } undef; } sub DESTROY { my ($self) = @_; command_close_pipe($self->{gui}, $self->{ctx}); } 1; I18N.pm 0000644 00000004740 15137205472 0005574 0 ustar 00 package Git::I18N; use 5.008; use strict; use warnings $ENV{GIT_PERL_FATAL_WARNINGS} ? qw(FATAL all) : (); BEGIN { require Exporter; if ($] < 5.008003) { *import = \&Exporter::import; } else { # Exporter 5.57 which supports this invocation was # released with perl 5.8.3 Exporter->import('import'); } } our @EXPORT = qw(__ __n N__); our @EXPORT_OK = @EXPORT; sub __bootstrap_locale_messages { our $TEXTDOMAIN = 'git'; our $TEXTDOMAINDIR ||= $ENV{GIT_TEXTDOMAINDIR} || '/usr/share/locale'; require POSIX; POSIX->import(qw(setlocale)); # Non-core prerequisite module require Locale::Messages; Locale::Messages->import(qw(:locale_h :libintl_h)); setlocale(LC_MESSAGES(), ''); setlocale(LC_CTYPE(), ''); textdomain($TEXTDOMAIN); bindtextdomain($TEXTDOMAIN => $TEXTDOMAINDIR); return; } BEGIN { # Used by our test script to see if it should test fallbacks or # not. our $__HAS_LIBRARY = 1; local $@; eval { __bootstrap_locale_messages(); *__ = \&Locale::Messages::gettext; *__n = \&Locale::Messages::ngettext; 1; } or do { # Tell test.pl that we couldn't load the gettext library. $Git::I18N::__HAS_LIBRARY = 0; # Just a fall-through no-op *__ = sub ($) { $_[0] }; *__n = sub ($$$) { $_[2] == 1 ? $_[0] : $_[1] }; }; sub N__($) { return shift; } } 1; __END__ =head1 NAME Git::I18N - Perl interface to Git's Gettext localizations =head1 SYNOPSIS use Git::I18N; print __("Welcome to Git!\n"); printf __("The following error occurred: %s\n"), $error; printf __n("committed %d file\n", "committed %d files\n", $files), $files; =head1 DESCRIPTION Git's internal Perl interface to gettext via L<Locale::Messages>. If L<Locale::Messages> can't be loaded (it's not a core module) we provide stub passthrough fallbacks. This is a distilled interface to gettext, see C<info '(gettext)Perl'> for the full interface. This module implements only a small part of it. =head1 FUNCTIONS =head2 __($) L<Locale::Messages>'s gettext function if all goes well, otherwise our passthrough fallback function. =head2 __n($$$) L<Locale::Messages>'s ngettext function or passthrough fallback function. =head2 N__($) No-operation that only returns its argument. Use this if you want xgettext to extract the text to the pot template but do not want to trigger retrival of the translation at run time. =head1 AUTHOR E<AElig>var ArnfjE<ouml>rE<eth> Bjarmason <avarab@gmail.com> =head1 COPYRIGHT Copyright 2010 E<AElig>var ArnfjE<ouml>rE<eth> Bjarmason <avarab@gmail.com> =cut
| ver. 1.4 |
Github
|
.
| PHP 7.4.33 | Generation time: 0.26 |
proxy
|
phpinfo
|
Settings