diff options
Diffstat (limited to 'perl')
-rw-r--r-- | perl/Git.pm | 56 | ||||
-rw-r--r-- | perl/Git/I18N.pm | 2 | ||||
-rw-r--r-- | perl/Git/Packet.pm | 168 | ||||
-rw-r--r-- | perl/Git/SVN.pm | 2 | ||||
-rw-r--r-- | perl/Makefile | 1 |
5 files changed, 225 insertions, 4 deletions
diff --git a/perl/Git.pm b/perl/Git.pm index bfce1f795d..ffa09ace92 100644 --- a/perl/Git.pm +++ b/perl/Git.pm @@ -61,7 +61,8 @@ require Exporter; remote_refs prompt get_tz_offset get_record credential credential_read credential_write - temp_acquire temp_is_locked temp_release temp_reset temp_path); + temp_acquire temp_is_locked temp_release temp_reset temp_path + unquote_path); =head1 DESCRIPTION @@ -531,7 +532,7 @@ If TIME is not supplied, the current local time is used. =cut sub get_tz_offset { - # some systmes don't handle or mishandle %z, so be creative. + # some systems don't handle or mishandle %z, so be creative. my $t = shift || time; my $gm = timegm(localtime($t)); my $sign = qw( + + - )[ $gm <=> $t ]; @@ -1451,6 +1452,57 @@ sub prefix_lines { return $string; } +=item unquote_path ( PATH ) + +Unquote a quoted path containing c-escapes as returned by ls-files etc. +when not using -z or when parsing the output of diff -u. + +=cut + +{ + my %cquote_map = ( + "a" => chr(7), + "b" => chr(8), + "t" => chr(9), + "n" => chr(10), + "v" => chr(11), + "f" => chr(12), + "r" => chr(13), + "\\" => "\\", + "\042" => "\042", + ); + + sub unquote_path { + local ($_) = @_; + my ($retval, $remainder); + if (!/^\042(.*)\042$/) { + return $_; + } + ($_, $retval) = ($1, ""); + while (/^([^\\]*)\\(.*)$/) { + $remainder = $2; + $retval .= $1; + for ($remainder) { + if (/^([0-3][0-7][0-7])(.*)$/) { + $retval .= chr(oct($1)); + $_ = $2; + last; + } + if (/^([\\\042abtnvfr])(.*)$/) { + $retval .= $cquote_map{$1}; + $_ = $2; + last; + } + # This is malformed + throw Error::Simple("invalid quoted path $_[0]"); + } + $_ = $remainder; + } + $retval .= $_; + return $retval; + } +} + =item get_comment_line_char ( ) Gets the core.commentchar configuration value. diff --git a/perl/Git/I18N.pm b/perl/Git/I18N.pm index c41425c8d0..836a5c2382 100644 --- a/perl/Git/I18N.pm +++ b/perl/Git/I18N.pm @@ -74,7 +74,7 @@ Git::I18N - Perl interface to Git's Gettext localizations printf __("The following error occurred: %s\n"), $error; - printf __n("commited %d file\n", "commited %d files\n", $files), $files; + printf __n("committed %d file\n", "committed %d files\n", $files), $files; =head1 DESCRIPTION diff --git a/perl/Git/Packet.pm b/perl/Git/Packet.pm new file mode 100644 index 0000000000..255b28c098 --- /dev/null +++ b/perl/Git/Packet.pm @@ -0,0 +1,168 @@ +package Git::Packet; +use 5.008; +use strict; +use warnings; +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_required_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; + unless ( $buf =~ s/\n$// ) { + die "A non-binary line MUST be terminated by an LF.\n" + . "Received: '$buf'"; + } + return $buf; +} + +sub packet_txt_read { + my ( $res, $buf ) = packet_bin_read(); + unless ( $res == -1 or $buf eq '' ) { + $buf = remove_final_lf_or_die($buf); + } + return ( $res, $buf ); +} + +sub packet_required_key_val_read { + my ( $key ) = @_; + my ( $res, $buf ) = packet_txt_read(); + unless ( $res == -1 or ( $buf =~ s/^$key=// and $buf ne '' ) ) { + die "bad $key: '$buf'"; + } + return ( $res, $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; diff --git a/perl/Git/SVN.pm b/perl/Git/SVN.pm index 98518f4ddb..bc4eed3d75 100644 --- a/perl/Git/SVN.pm +++ b/perl/Git/SVN.pm @@ -1416,7 +1416,7 @@ sub parse_svn_date { delete $ENV{TZ}; } - my $our_TZ = get_tz_offset(); + my $our_TZ = get_tz_offset($epoch_in_UTC); # This converts $epoch_in_UTC into our local timezone. my ($sec, $min, $hour, $mday, $mon, $year, diff --git a/perl/Makefile b/perl/Makefile index 15d96fcc7a..f657de20e3 100644 --- a/perl/Makefile +++ b/perl/Makefile @@ -30,6 +30,7 @@ instdir_SQ = $(subst ','\'',$(prefix)/lib) modules += Git modules += Git/I18N modules += Git/IndexInfo +modules += Git/Packet modules += Git/SVN modules += Git/SVN/Memoize/YAML modules += Git/SVN/Fetcher |