diff options
Diffstat (limited to 'perl/Git')
-rw-r--r-- | perl/Git/I18N.pm | 2 | ||||
-rw-r--r-- | perl/Git/SVN.pm | 64 | ||||
-rw-r--r-- | perl/Git/SVN/Editor.pm | 19 | ||||
-rw-r--r-- | perl/Git/SVN/Fetcher.pm | 24 | ||||
-rw-r--r-- | perl/Git/SVN/Log.pm | 9 | ||||
-rw-r--r-- | perl/Git/SVN/Prompt.pm | 36 | ||||
-rw-r--r-- | perl/Git/SVN/Ra.pm | 12 | ||||
-rw-r--r-- | perl/Git/SVN/Utils.pm | 2 |
8 files changed, 111 insertions, 57 deletions
diff --git a/perl/Git/I18N.pm b/perl/Git/I18N.pm index 40dd89719..f889fd6da 100644 --- a/perl/Git/I18N.pm +++ b/perl/Git/I18N.pm @@ -68,7 +68,7 @@ Git::I18N - Perl interface to Git's Gettext localizations print __("Welcome to Git!\n"); - printf __("The following error occured: %s\n"), $error; + printf __("The following error occurred: %s\n"), $error; =head1 DESCRIPTION diff --git a/perl/Git/SVN.pm b/perl/Git/SVN.pm index 59215fa86..6e804a271 100644 --- a/perl/Git/SVN.pm +++ b/perl/Git/SVN.pm @@ -11,7 +11,6 @@ use Carp qw/croak/; use File::Path qw/mkpath/; use File::Copy qw/copy/; use IPC::Open3; -use Time::Local; use Memoize; # core since 5.8.0, Jul 2002 use Memoize::Storable; use POSIX qw(:signal_h); @@ -22,6 +21,7 @@ use Git qw( command_noisy command_output_pipe command_close_pipe + get_tz_offset ); use Git::SVN::Utils qw( fatal @@ -490,7 +490,7 @@ sub refname { # # Additionally, % must be escaped because it is used for escaping # and we want our escaped refname to be reversible - $refname =~ s{([ \%~\^:\?\*\[\t])}{uc sprintf('%%%02x',ord($1))}eg; + $refname =~ s{([ \%~\^:\?\*\[\t])}{sprintf('%%%02X',ord($1))}eg; # no slash-separated component can begin with a dot . # /.* becomes /%2E* @@ -1311,14 +1311,6 @@ sub get_untracked { \@out; } -sub get_tz { - # some systmes don't handle or mishandle %z, so be creative. - my $t = shift || time; - my $gm = timelocal(gmtime($t)); - my $sign = qw( + + - )[ $t <=> $gm ]; - return sprintf("%s%02d%02d", $sign, (gmtime(abs($t - $gm)))[2,1]); -} - # parse_svn_date(DATE) # -------------------- # Given a date (in UTC) from Subversion, return a string in the format @@ -1351,7 +1343,7 @@ sub parse_svn_date { delete $ENV{TZ}; } - my $our_TZ = get_tz(); + my $our_TZ = get_tz_offset(); # This converts $epoch_in_UTC into our local timezone. my ($sec, $min, $hour, $mday, $mon, $year, @@ -1501,13 +1493,18 @@ sub lookup_svn_merge { my @merged_commit_ranges; # find the tip for my $range ( @ranges ) { + if ($range =~ /[*]$/) { + warn "W: Ignoring partial merge in svn:mergeinfo " + ."dirprop: $source:$range\n"; + next; + } my ($bottom, $top) = split "-", $range; $top ||= $bottom; my $bottom_commit = $gs->find_rev_after( $bottom, 1, $top ); my $top_commit = $gs->find_rev_before( $top, 1, $bottom ); unless ($top_commit and $bottom_commit) { - warn "W:unknown path/rev in svn:mergeinfo " + warn "W: unknown path/rev in svn:mergeinfo " ."dirprop: $source:$range\n"; next; } @@ -1602,6 +1599,7 @@ sub tie_for_persistent_memoization { my %lookup_svn_merge_cache; my %check_cherry_pick_cache; my %has_no_changes_cache; + my %_rev_list_cache; tie_for_persistent_memoization(\%lookup_svn_merge_cache, "$cache_path/lookup_svn_merge"); @@ -1623,6 +1621,14 @@ sub tie_for_persistent_memoization { SCALAR_CACHE => ['HASH' => \%has_no_changes_cache], LIST_CACHE => 'FAULT', ; + + tie_for_persistent_memoization(\%_rev_list_cache, + "$cache_path/_rev_list"); + memoize '_rev_list', + SCALAR_CACHE => 'FAULT', + LIST_CACHE => ['HASH' => \%_rev_list_cache], + ; + } sub unmemoize_svn_mergeinfo_functions { @@ -1632,6 +1638,7 @@ sub tie_for_persistent_memoization { Memoize::unmemoize 'lookup_svn_merge'; Memoize::unmemoize 'check_cherry_pick'; Memoize::unmemoize 'has_no_changes'; + Memoize::unmemoize '_rev_list'; } sub clear_memoized_mergeinfo_caches { @@ -1962,11 +1969,25 @@ sub rebuild_from_rev_db { unlink $path or croak "unlink: $!"; } +#define a global associate map to record rebuild status +my %rebuild_status; +#define a global associate map to record rebuild verify status +my %rebuild_verify_status; + sub rebuild { my ($self) = @_; my $map_path = $self->map_path; my $partial = (-e $map_path && ! -z $map_path); - return unless ::verify_ref($self->refname.'^0'); + my $verify_key = $self->refname.'^0'; + if (!$rebuild_verify_status{$verify_key}) { + my $verify_result = ::verify_ref($verify_key); + if ($verify_result) { + $rebuild_verify_status{$verify_key} = 1; + } + } + if (!$rebuild_verify_status{$verify_key}) { + return; + } if (!$partial && ($self->use_svm_props || $self->no_metadata)) { my $rev_db = $self->rev_db_path; $self->rebuild_from_rev_db($rev_db); @@ -1980,10 +2001,21 @@ sub rebuild { print "Rebuilding $map_path ...\n" if (!$partial); my ($base_rev, $head) = ($partial ? $self->rev_map_max_norebuild(1) : (undef, undef)); + my $key_value = ($head ? "$head.." : "") . $self->refname; + if (exists $rebuild_status{$key_value}) { + print "Done rebuilding $map_path\n" if (!$partial || !$head); + my $rev_db_path = $self->rev_db_path; + if (-f $self->rev_db_path) { + unlink $self->rev_db_path or croak "unlink: $!"; + } + $self->unlink_rev_db_symlink; + return; + } my ($log, $ctx) = - command_output_pipe(qw/rev-list --pretty=raw --reverse/, - ($head ? "$head.." : "") . $self->refname, + command_output_pipe(qw/rev-list --pretty=raw --reverse/, + $key_value, '--'); + $rebuild_status{$key_value} = 1; my $metadata_url = $self->metadata_url; remove_username($metadata_url); my $svn_uuid = $self->rewrite_uuid || $self->ra_uuid; @@ -2377,7 +2409,7 @@ sub map_path { sub uri_encode { my ($f) = @_; - $f =~ s#([^a-zA-Z0-9\*!\:_\./\-])#uc sprintf("%%%02x",ord($1))#eg; + $f =~ s#([^a-zA-Z0-9\*!\:_\./\-])#sprintf("%%%02X",ord($1))#eg; $f } diff --git a/perl/Git/SVN/Editor.pm b/perl/Git/SVN/Editor.pm index 3bbc20a05..34e8af966 100644 --- a/perl/Git/SVN/Editor.pm +++ b/perl/Git/SVN/Editor.pm @@ -145,7 +145,8 @@ sub repo_path { sub url_path { my ($self, $path) = @_; if ($self->{url} =~ m#^https?://#) { - $path =~ s!([^~a-zA-Z0-9_./-])!uc sprintf("%%%02x",ord($1))!eg; + # characters are taken from subversion/libsvn_subr/path.c + $path =~ s#([^~a-zA-Z0-9_./!$&'()*+,-])#sprintf("%%%02X",ord($1))#eg; } $self->{url} . '/' . $self->repo_path($path); } @@ -303,8 +304,12 @@ sub C { my ($self, $m, $deletions) = @_; my ($dir, $file) = split_path($m->{file_b}); my $pbat = $self->ensure_path($dir, $deletions); + # workaround for a bug in svn serf backend (v1.8.5 and below): + # store third argument to ->add_file() in a local variable, to make it + # have the same lifetime as $fbat + my $upa = $self->url_path($m->{file_a}); my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat, - $self->url_path($m->{file_a}), $self->{r}); + $upa, $self->{r}); print "\tC\t$m->{file_a} => $m->{file_b}\n" unless $::_q; $self->chg_file($fbat, $m); $self->close_file($fbat,undef,$self->{pool}); @@ -322,8 +327,10 @@ sub R { my ($self, $m, $deletions) = @_; my ($dir, $file) = split_path($m->{file_b}); my $pbat = $self->ensure_path($dir, $deletions); + # workaround for a bug in svn serf backend, see comment in C() above + my $upa = $self->url_path($m->{file_a}); my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat, - $self->url_path($m->{file_a}), $self->{r}); + $upa, $self->{r}); print "\tR\t$m->{file_a} => $m->{file_b}\n" unless $::_q; $self->apply_autoprops($file, $fbat); $self->chg_file($fbat, $m); @@ -358,12 +365,12 @@ sub T { mode_a => $m->{mode_a}, mode_b => '000000', sha1_a => $m->{sha1_a}, sha1_b => '0' x 40, chg => 'D', file_b => $m->{file_b} - }); + }, $deletions); $self->A({ mode_a => '000000', mode_b => $m->{mode_b}, sha1_a => '0' x 40, sha1_b => $m->{sha1_b}, chg => 'A', file_b => $m->{file_b} - }); + }, $deletions); return; } @@ -498,6 +505,8 @@ sub apply_diff { 1; __END__ +=head1 NAME + Git::SVN::Editor - commit driver for "git svn set-tree" and dcommit =head1 SYNOPSIS diff --git a/perl/Git/SVN/Fetcher.pm b/perl/Git/SVN/Fetcher.pm index 046a7a2f3..10edb2773 100644 --- a/perl/Git/SVN/Fetcher.pm +++ b/perl/Git/SVN/Fetcher.pm @@ -1,6 +1,7 @@ package Git::SVN::Fetcher; -use vars qw/@ISA $_ignore_regex $_preserve_empty_dirs $_placeholder_filename - @deleted_gpath %added_placeholder $repo_id/; +use vars qw/@ISA $_ignore_regex $_include_regex $_preserve_empty_dirs + $_placeholder_filename @deleted_gpath %added_placeholder + $repo_id/; use strict; use warnings; use SVN::Delta; @@ -33,6 +34,10 @@ sub new { my $v = eval { command_oneline('config', '--get', $k) }; $self->{ignore_regex} = $v; + $k = "svn-remote.$repo_id.include-paths"; + $v = eval { command_oneline('config', '--get', $k) }; + $self->{include_regex} = $v; + $k = "svn-remote.$repo_id.preserve-empty-dirs"; $v = eval { command_oneline('config', '--get', '--bool', $k) }; if ($v && $v eq 'true') { @@ -117,11 +122,18 @@ sub in_dot_git { } # return value: 0 -- don't ignore, 1 -- ignore +# This will also check whether the path is explicitly included sub is_path_ignored { my ($self, $path) = @_; return 1 if in_dot_git($path); return 1 if defined($self->{ignore_regex}) && $path =~ m!$self->{ignore_regex}!; + return 0 if defined($self->{include_regex}) && + $path =~ m!$self->{include_regex}!; + return 0 if defined($_include_regex) && + $path =~ m!$_include_regex!; + return 1 if defined($self->{include_regex}); + return 1 if defined($_include_regex); return 0 unless defined($_ignore_regex); return 1 if $path =~ m!$_ignore_regex!o; return 0; @@ -303,11 +315,13 @@ sub change_file_prop { sub apply_textdelta { my ($self, $fb, $exp) = @_; return undef if $self->is_path_ignored($fb->{path}); - my $fh = $::_repository->temp_acquire('svn_delta'); + my $suffix = 0; + ++$suffix while $::_repository->temp_is_locked("svn_delta_${$}_$suffix"); + my $fh = $::_repository->temp_acquire("svn_delta_${$}_$suffix"); # $fh gets auto-closed() by SVN::TxDelta::apply(), # (but $base does not,) so dup() it for reading in close_file open my $dup, '<&', $fh or croak $!; - my $base = $::_repository->temp_acquire('git_blob'); + my $base = $::_repository->temp_acquire("git_blob_${$}_$suffix"); if ($fb->{blob}) { my ($base_is_link, $size); @@ -512,6 +526,8 @@ sub stash_placeholder_list { 1; __END__ +=head1 NAME + Git::SVN::Fetcher - tree delta consumer for "git svn fetch" =head1 SYNOPSIS diff --git a/perl/Git/SVN/Log.pm b/perl/Git/SVN/Log.pm index 3cc1c6f08..34f2869ab 100644 --- a/perl/Git/SVN/Log.pm +++ b/perl/Git/SVN/Log.pm @@ -2,7 +2,11 @@ package Git::SVN::Log; use strict; use warnings; use Git::SVN::Utils qw(fatal); -use Git qw(command command_oneline command_output_pipe command_close_pipe); +use Git qw(command + command_oneline + command_output_pipe + command_close_pipe + get_tz_offset); use POSIX qw/strftime/; use constant commit_log_separator => ('-' x 72) . "\n"; use vars qw/$TZ $limit $color $pager $non_recursive $verbose $oneline @@ -113,13 +117,14 @@ sub run_pager { } open STDIN, '<&', $rfd or fatal "Can't redirect stdin: $!"; $ENV{LESS} ||= 'FRSX'; + $ENV{LV} ||= '-c'; exec $pager or fatal "Can't run pager: $! ($pager)"; } sub format_svn_date { my $t = shift || time; require Git::SVN; - my $gmoff = Git::SVN::get_tz($t); + my $gmoff = get_tz_offset($t); return strftime("%Y-%m-%d %H:%M:%S $gmoff (%a, %d %b %Y)", localtime($t)); } diff --git a/perl/Git/SVN/Prompt.pm b/perl/Git/SVN/Prompt.pm index 3a6f8af0d..e940b0850 100644 --- a/perl/Git/SVN/Prompt.pm +++ b/perl/Git/SVN/Prompt.pm @@ -62,16 +62,16 @@ sub ssl_server_trust { issuer_dname fingerprint); my $choice; prompt: - print STDERR $may_save ? + my $options = $may_save ? "(R)eject, accept (t)emporarily or accept (p)ermanently? " : "(R)eject or accept (t)emporarily? "; STDERR->flush; - $choice = lc(substr(<STDIN> || 'R', 0, 1)); - if ($choice =~ /^t$/i) { + $choice = lc(substr(Git::prompt("Certificate problem.\n" . $options) || 'R', 0, 1)); + if ($choice eq 't') { $cred->may_save(undef); - } elsif ($choice =~ /^r$/i) { + } elsif ($choice eq 'r') { return -1; - } elsif ($may_save && $choice =~ /^p$/i) { + } elsif ($may_save && $choice eq 'p') { $cred->may_save($may_save); } else { goto prompt; @@ -109,9 +109,7 @@ sub username { if (defined $_username) { $username = $_username; } else { - print STDERR "Username: "; - STDERR->flush; - chomp($username = <STDIN>); + $username = Git::prompt("Username: "); } $cred->username($username); $cred->may_save($may_save); @@ -120,31 +118,15 @@ sub username { sub _read_password { my ($prompt, $realm) = @_; - my $password = ''; - if (exists $ENV{GIT_ASKPASS}) { - open(PH, "-|", $ENV{GIT_ASKPASS}, $prompt); - $password = <PH>; - $password =~ s/[\012\015]//; # \n\r - close(PH); - } else { - print STDERR $prompt; - STDERR->flush; - require Term::ReadKey; - Term::ReadKey::ReadMode('noecho'); - while (defined(my $key = Term::ReadKey::ReadKey(0))) { - last if $key =~ /[\012\015]/; # \n\r - $password .= $key; - } - Term::ReadKey::ReadMode('restore'); - print STDERR "\n"; - STDERR->flush; - } + my $password = Git::prompt($prompt, 1); $password; } 1; __END__ +=head1 NAME + Git::SVN::Prompt - authentication callbacks for git-svn =head1 SYNOPSIS diff --git a/perl/Git/SVN/Ra.pm b/perl/Git/SVN/Ra.pm index 049c97bfa..a7b0119ee 100644 --- a/perl/Git/SVN/Ra.pm +++ b/perl/Git/SVN/Ra.pm @@ -32,6 +32,14 @@ BEGIN { } } +# serf has a bug that leads to a coredump upon termination if the +# remote access object is left around (not fixed yet in serf 1.3.1). +# Explicitly free it to work around the issue. +END { + $RA = undef; + $ra_invalid = 1; +} + sub _auth_providers () { my @rv = ( SVN::Client::get_simple_provider(), @@ -295,7 +303,7 @@ sub gs_do_switch { my $full_url = add_path_to_url( $self->url, $path ); my ($ra, $reparented); - if ($old_url =~ m#^svn(\+ssh)?://# || + if ($old_url =~ m#^svn(\+\w+)?://# || ($full_url =~ m#^https?://# && canonicalize_url($full_url) ne $full_url)) { $_[0] = undef; @@ -627,6 +635,8 @@ sub skip_unknown_revs { 1; __END__ +=head1 NAME + Git::SVN::Ra - Subversion remote access functions for git-svn =head1 SYNOPSIS diff --git a/perl/Git/SVN/Utils.pm b/perl/Git/SVN/Utils.pm index 8b8cf3755..3d1a0933a 100644 --- a/perl/Git/SVN/Utils.pm +++ b/perl/Git/SVN/Utils.pm @@ -155,7 +155,7 @@ sub _canonicalize_url_path { my @parts; foreach my $part (split m{/+}, $uri_path) { - $part =~ s/([^~\w.%+-]|%(?![a-fA-F0-9]{2}))/sprintf("%%%02X",ord($1))/eg; + $part =~ s/([^!\$%&'()*+,.\/\w:=\@_`~-]|%(?![a-fA-F0-9]{2}))/sprintf("%%%02X",ord($1))/eg; push @parts, $part; } |