diff options
Diffstat (limited to 'perl/Git')
| -rw-r--r-- | perl/Git/I18N.pm | 19 | ||||
| -rw-r--r-- | perl/Git/SVN.pm | 290 | ||||
| -rw-r--r-- | perl/Git/SVN/Editor.pm | 57 | ||||
| -rw-r--r-- | perl/Git/SVN/Fetcher.pm | 26 | ||||
| -rw-r--r-- | perl/Git/SVN/GlobSpec.pm | 18 | ||||
| -rw-r--r-- | perl/Git/SVN/Log.pm | 2 | ||||
| -rw-r--r-- | perl/Git/SVN/Migration.pm | 39 | ||||
| -rw-r--r-- | perl/Git/SVN/Ra.pm | 116 |
8 files changed, 396 insertions, 171 deletions
diff --git a/perl/Git/I18N.pm b/perl/Git/I18N.pm index f889fd6da9..c41425c8d0 100644 --- a/perl/Git/I18N.pm +++ b/perl/Git/I18N.pm @@ -13,7 +13,7 @@ BEGIN { } } -our @EXPORT = qw(__); +our @EXPORT = qw(__ __n N__); our @EXPORT_OK = @EXPORT; sub __bootstrap_locale_messages { @@ -44,6 +44,7 @@ BEGIN 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. @@ -51,7 +52,10 @@ BEGIN # Just a fall-through no-op *__ = sub ($) { $_[0] }; + *__n = sub ($$$) { $_[2] == 1 ? $_[0] : $_[1] }; }; + + sub N__($) { return shift; } } 1; @@ -70,6 +74,9 @@ 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; + + =head1 DESCRIPTION Git's internal Perl interface to gettext via L<Locale::Messages>. If @@ -87,6 +94,16 @@ it. 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> diff --git a/perl/Git/SVN.pm b/perl/Git/SVN.pm index 6e804a271c..98518f4ddb 100644 --- a/perl/Git/SVN.pm +++ b/perl/Git/SVN.pm @@ -9,11 +9,10 @@ use vars qw/$_no_metadata $_use_log_author $_add_author_from $_localtime/; use Carp qw/croak/; use File::Path qw/mkpath/; -use File::Copy qw/copy/; use IPC::Open3; use Memoize; # core since 5.8.0, Jul 2002 -use Memoize::Storable; use POSIX qw(:signal_h); +use Time::Local; use Git qw( command @@ -32,11 +31,7 @@ use Git::SVN::Utils qw( add_path_to_url ); -my $can_use_yaml; -BEGIN { - $can_use_yaml = eval { require Git::SVN::Memoize::YAML; 1}; -} - +my $memo_backend; our $_follow_parent = 1; our $_minimize_url = 'unset'; our $default_repo_id = 'svn'; @@ -103,6 +98,11 @@ sub resolve_local_globs { " globbed: $refname\n"; } my $u = (::cmt_metadata("$refname"))[0]; + if (!defined($u)) { + warn +"W: $refname: no associated commit metadata from SVN, skipping\n"; + next; + } $u =~ s!^\Q$url\E(/|$)!! or die "$refname: '$url' not found in '$u'\n"; if ($pathname ne $u) { @@ -480,8 +480,8 @@ sub refname { # It cannot end with a slash /, we'll throw up on this because # SVN can't have directories with a slash in their name, either: if ($refname =~ m{/$}) { - die "ref: '$refname' ends with a trailing slash, this is ", - "not permitted by git nor Subversion\n"; + die "ref: '$refname' ends with a trailing slash; this is ", + "not permitted by git or Subversion\n"; } # It cannot have ASCII control character space, tilde ~, caret ^, @@ -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])}{sprintf('%%%02X',ord($1))}eg; + $refname =~ s{([ \%~\^:\?\*\[\t\\])}{sprintf('%%%02X',ord($1))}eg; # no slash-separated component can begin with a dot . # /.* becomes /%2E* @@ -807,10 +807,15 @@ sub get_fetch_range { (++$min, $max); } +sub svn_dir { + command_oneline(qw(rev-parse --git-path svn)); +} + sub tmp_config { my (@args) = @_; - my $old_def_config = "$ENV{GIT_DIR}/svn/config"; - my $config = "$ENV{GIT_DIR}/svn/.metadata"; + my $svn_dir = svn_dir(); + my $old_def_config = "$svn_dir/config"; + my $config = "$svn_dir/.metadata"; if (! -f $config && -f $old_def_config) { rename $old_def_config, $config or die "Failed rename $old_def_config => $config: $!\n"; @@ -1178,7 +1183,7 @@ sub find_parent_branch { or die "SVN connection failed somewhere...\n"; } print STDERR "Successfully followed parent\n" unless $::_q > 1; - return $self->make_log_entry($rev, [$parent], $ed); + return $self->make_log_entry($rev, [$parent], $ed, $r0, $branch_from); } return undef; } @@ -1191,7 +1196,7 @@ sub do_fetch { # we can have a branch that was deleted, then re-added # under the same name but copied from another path, in # which case we'll have multiple parents (we don't - # want to break the original ref, nor lose copypath info): + # want to break the original ref or lose copypath info): if (my $log_entry = $self->find_parent_branch($paths, $rev)) { push @{$log_entry->{parents}}, $lc; return $log_entry; @@ -1210,26 +1215,93 @@ sub do_fetch { unless ($self->ra->gs_do_update($last_rev, $rev, $self, $ed)) { die "SVN connection failed somewhere...\n"; } - $self->make_log_entry($rev, \@parents, $ed); + $self->make_log_entry($rev, \@parents, $ed, $last_rev, $self->path); } sub mkemptydirs { my ($self, $r) = @_; + # add/remove/collect a paths table + # + # Paths are split into a tree of nodes, stored as a hash of hashes. + # + # Each node contains a 'path' entry for the path (if any) associated + # with that node and a 'children' entry for any nodes under that + # location. + # + # Removing a path requires a hash lookup for each component then + # dropping that node (and anything under it), which is substantially + # faster than a grep slice into a single hash of paths for large + # numbers of paths. + # + # For a large (200K) number of empty_dir directives this reduces + # scanning time to 3 seconds vs 10 minutes for grep+delete on a single + # hash of paths. + sub add_path { + my ($paths_table, $path) = @_; + my $node_ref; + + foreach my $x (split('/', $path)) { + if (!exists($paths_table->{$x})) { + $paths_table->{$x} = { children => {} }; + } + + $node_ref = $paths_table->{$x}; + $paths_table = $paths_table->{$x}->{children}; + } + + $node_ref->{path} = $path; + } + + sub remove_path { + my ($paths_table, $path) = @_; + my $nodes_ref; + my $node_name; + + foreach my $x (split('/', $path)) { + if (!exists($paths_table->{$x})) { + return; + } + + $nodes_ref = $paths_table; + $node_name = $x; + + $paths_table = $paths_table->{$x}->{children}; + } + + delete($nodes_ref->{$node_name}); + } + + sub collect_paths { + my ($paths_table, $paths_ref) = @_; + + foreach my $v (values %$paths_table) { + my $p = $v->{path}; + my $c = $v->{children}; + + collect_paths($c, $paths_ref); + + if (defined($p)) { + push(@$paths_ref, $p); + } + } + } + sub scan { - my ($r, $empty_dirs, $line) = @_; + my ($r, $paths_table, $line) = @_; if (defined $r && $line =~ /^r(\d+)$/) { return 0 if $1 > $r; } elsif ($line =~ /^ \+empty_dir: (.+)$/) { - $empty_dirs->{$1} = 1; + add_path($paths_table, $1); } elsif ($line =~ /^ \-empty_dir: (.+)$/) { - my @d = grep {m[^\Q$1\E(/|$)]} (keys %$empty_dirs); - delete @$empty_dirs{@d}; + remove_path($paths_table, $1); } 1; # continue }; - my %empty_dirs = (); + my @empty_dirs; + my %paths_table; + my $gz_file = "$self->{dir}/unhandled.log.gz"; if (-f $gz_file) { if (!can_compress()) { @@ -1240,7 +1312,7 @@ sub mkemptydirs { die "Unable to open $gz_file: $!\n"; my $line; while ($gz->gzreadline($line) > 0) { - scan($r, \%empty_dirs, $line) or last; + scan($r, \%paths_table, $line) or last; } $gz->gzclose; } @@ -1249,13 +1321,14 @@ sub mkemptydirs { if (open my $fh, '<', "$self->{dir}/unhandled.log") { binmode $fh or croak "binmode: $!"; while (<$fh>) { - scan($r, \%empty_dirs, $_) or last; + scan($r, \%paths_table, $_) or last; } close $fh; } + collect_paths(\%paths_table, \@empty_dirs); my $strip = qr/\A\Q@{[$self->path]}\E(?:\/|$)/; - foreach my $d (sort keys %empty_dirs) { + foreach my $d (sort @empty_dirs) { $d = uri_decode($d); $d =~ s/$strip//; next unless length($d); @@ -1321,7 +1394,7 @@ sub get_untracked { sub parse_svn_date { my $date = shift || return '+0000 1970-01-01 00:00:00'; my ($Y,$m,$d,$H,$M,$S) = ($date =~ /^(\d{4})\-(\d\d)\-(\d\d)T - (\d\d)\:(\d\d)\:(\d\d)\.\d*Z$/x) or + (\d\d?)\:(\d\d)\:(\d\d)\.\d*Z$/x) or croak "Unable to parse date: $date\n"; my $parsed_date; # Set next. @@ -1332,7 +1405,7 @@ sub parse_svn_date { $ENV{TZ} = 'UTC'; my $epoch_in_UTC = - POSIX::strftime('%s', $S, $M, $H, $d, $m - 1, $Y - 1900); + Time::Local::timelocal($S, $M, $H, $d, $m - 1, $Y - 1900); # Determine our local timezone (including DST) at the # time of $epoch_in_UTC. $Git::SVN::Log::TZ stored the @@ -1433,7 +1506,7 @@ sub check_author { } sub find_extra_svk_parents { - my ($self, $ed, $tickets, $parents) = @_; + my ($self, $tickets, $parents) = @_; # aha! svk:merge property changed... my @tickets = split "\n", $tickets; my @known_parents; @@ -1478,9 +1551,9 @@ sub find_extra_svk_parents { sub lookup_svn_merge { my $uuid = shift; my $url = shift; - my $merge = shift; + my $source = shift; + my $revs = shift; - my ($source, $revs) = split ":", $merge; my $path = $source; $path =~ s{^/}{}; my $gs = Git::SVN->find_by_url($url.$source, $url, $path); @@ -1537,7 +1610,7 @@ sub _rev_list { @rv; } -sub check_cherry_pick { +sub check_cherry_pick2 { my $base = shift; my $tip = shift; my $parents = shift; @@ -1552,7 +1625,8 @@ sub check_cherry_pick { delete $commits{$commit}; } } - return (keys %commits); + my @k = (keys %commits); + return (scalar @k, $k[0]); } sub has_no_changes { @@ -1577,10 +1651,29 @@ sub tie_for_persistent_memoization { my $hash = shift; my $path = shift; - if ($can_use_yaml) { + unless ($memo_backend) { + if (eval { require Git::SVN::Memoize::YAML; 1}) { + $memo_backend = 1; + } else { + require Memoize::Storable; + $memo_backend = -1; + } + } + + if ($memo_backend > 0) { tie %$hash => 'Git::SVN::Memoize::YAML', "$path.yaml"; } else { - tie %$hash => 'Memoize::Storable', "$path.db", 'nstore'; + # first verify that any existing file can actually be loaded + # (it may have been saved by an incompatible version) + my $db = "$path.db"; + if (-e $db) { + use Storable qw(retrieve); + + if (!eval { retrieve($db); 1 }) { + unlink $db or die "unlink $db failed: $!"; + } + } + tie %$hash => 'Memoize::Storable', $db, 'nstore'; } } @@ -1593,13 +1686,12 @@ sub tie_for_persistent_memoization { return if $memoized; $memoized = 1; - my $cache_path = "$ENV{GIT_DIR}/svn/.caches/"; + my $cache_path = svn_dir() . '/.caches/'; mkpath([$cache_path]) unless -d $cache_path; my %lookup_svn_merge_cache; - my %check_cherry_pick_cache; + my %check_cherry_pick2_cache; my %has_no_changes_cache; - my %_rev_list_cache; tie_for_persistent_memoization(\%lookup_svn_merge_cache, "$cache_path/lookup_svn_merge"); @@ -1608,11 +1700,11 @@ sub tie_for_persistent_memoization { LIST_CACHE => ['HASH' => \%lookup_svn_merge_cache], ; - tie_for_persistent_memoization(\%check_cherry_pick_cache, - "$cache_path/check_cherry_pick"); - memoize 'check_cherry_pick', + tie_for_persistent_memoization(\%check_cherry_pick2_cache, + "$cache_path/check_cherry_pick2"); + memoize 'check_cherry_pick2', SCALAR_CACHE => 'FAULT', - LIST_CACHE => ['HASH' => \%check_cherry_pick_cache], + LIST_CACHE => ['HASH' => \%check_cherry_pick2_cache], ; tie_for_persistent_memoization(\%has_no_changes_cache, @@ -1621,14 +1713,6 @@ 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 { @@ -1636,19 +1720,19 @@ sub tie_for_persistent_memoization { $memoized = 0; Memoize::unmemoize 'lookup_svn_merge'; - Memoize::unmemoize 'check_cherry_pick'; + Memoize::unmemoize 'check_cherry_pick2'; Memoize::unmemoize 'has_no_changes'; - Memoize::unmemoize '_rev_list'; } sub clear_memoized_mergeinfo_caches { die "Only call this method in non-memoized context" if ($memoized); - my $cache_path = "$ENV{GIT_DIR}/svn/.caches/"; + my $cache_path = svn_dir() . '/.caches/'; return unless -d $cache_path; for my $cache_file (("$cache_path/lookup_svn_merge", - "$cache_path/check_cherry_pick", + "$cache_path/check_cherry_pick", # old + "$cache_path/check_cherry_pick2", "$cache_path/has_no_changes")) { for my $suffix (qw(yaml db)) { my $file = "$cache_file.$suffix"; @@ -1702,11 +1786,49 @@ sub parents_exclude { return @excluded; } +# Compute what's new in svn:mergeinfo. +sub mergeinfo_changes { + my ($self, $old_path, $old_rev, $path, $rev, $mergeinfo_prop) = @_; + my %minfo = map {split ":", $_ } split "\n", $mergeinfo_prop; + my $old_minfo = {}; + + my $ra = $self->ra; + # Give up if $old_path isn't in the repo. + # This is probably a merge on a subtree. + if ($ra->check_path($old_path, $old_rev) != $SVN::Node::dir) { + warn "W: ignoring svn:mergeinfo on $old_path, ", + "directory didn't exist in r$old_rev\n"; + return {}; + } + my (undef, undef, $props) = $ra->get_dir($old_path, $old_rev); + if (defined $props->{"svn:mergeinfo"}) { + my %omi = map {split ":", $_ } split "\n", + $props->{"svn:mergeinfo"}; + $old_minfo = \%omi; + } + + my %changes = (); + foreach my $p (keys %minfo) { + my $a = $old_minfo->{$p} || ""; + my $b = $minfo{$p}; + # Omit merged branches whose ranges lists are unchanged. + next if $a eq $b; + # Remove any common range list prefix. + ($a ^ $b) =~ /^[\0]*/; + my $common_prefix = rindex $b, ",", $+[0] - 1; + $changes{$p} = substr $b, $common_prefix + 1; + } + print STDERR "Checking svn:mergeinfo changes since r$old_rev: ", + scalar(keys %minfo), " sources, ", + scalar(keys %changes), " changed\n"; + + return \%changes; +} # note: this function should only be called if the various dirprops # have actually changed sub find_extra_svn_parents { - my ($self, $ed, $mergeinfo, $parents) = @_; + my ($self, $mergeinfo, $parents) = @_; # aha! svk:merge property changed... memoize_svn_mergeinfo_functions(); @@ -1715,14 +1837,15 @@ sub find_extra_svn_parents { # history. Then, we figure out which git revisions are in # that tip, but not this revision. If all of those revisions # are now marked as merge, we can add the tip as a parent. - my @merges = split "\n", $mergeinfo; + my @merges = sort keys %$mergeinfo; my @merge_tips; my $url = $self->url; my $uuid = $self->ra_uuid; my @all_ranges; for my $merge ( @merges ) { my ($tip_commit, @ranges) = - lookup_svn_merge( $uuid, $url, $merge ); + lookup_svn_merge( $uuid, $url, + $merge, $mergeinfo->{$merge} ); unless (!$tip_commit or grep { $_ eq $tip_commit } @$parents ) { push @merge_tips, $tip_commit; @@ -1738,8 +1861,9 @@ sub find_extra_svn_parents { # check merge tips for new parents my @new_parents; for my $merge_tip ( @merge_tips ) { - my $spec = shift @merges; + my $merge = shift @merges; next unless $merge_tip and $excluded{$merge_tip}; + my $spec = "$merge:$mergeinfo->{$merge}"; # check out 'new' tips my $merge_base; @@ -1759,19 +1883,17 @@ sub find_extra_svn_parents { } # double check that there are no missing non-merge commits - my (@incomplete) = check_cherry_pick( + my ($ninc, $ifirst) = check_cherry_pick2( $merge_base, $merge_tip, $parents, @all_ranges, ); - if ( @incomplete ) { - warn "W:svn cherry-pick ignored ($spec) - missing " - .@incomplete." commit(s) (eg $incomplete[0])\n"; + if ($ninc) { + warn "W: svn cherry-pick ignored ($spec) - missing " . + "$ninc commit(s) (eg $ifirst)\n"; } else { - warn - "Found merge parent (svn:mergeinfo prop): ", - $merge_tip, "\n"; + warn "Found merge parent ($spec): ", $merge_tip, "\n"; push @new_parents, $merge_tip; } } @@ -1797,22 +1919,26 @@ sub find_extra_svn_parents { } sub make_log_entry { - my ($self, $rev, $parents, $ed) = @_; + my ($self, $rev, $parents, $ed, $parent_rev, $parent_path) = @_; my $untracked = $self->get_untracked($ed); my @parents = @$parents; - my $ps = $ed->{path_strip} || ""; - for my $path ( grep { m/$ps/ } %{$ed->{dir_prop}} ) { - my $props = $ed->{dir_prop}{$path}; - if ( $props->{"svk:merge"} ) { - $self->find_extra_svk_parents - ($ed, $props->{"svk:merge"}, \@parents); + my $props = $ed->{dir_prop}{$self->path}; + if ($self->follow_parent) { + my $tickets = $props->{"svk:merge"}; + if ($tickets) { + $self->find_extra_svk_parents($tickets, \@parents); } - if ( $props->{"svn:mergeinfo"} ) { - $self->find_extra_svn_parents - ($ed, - $props->{"svn:mergeinfo"}, - \@parents); + + my $mergeinfo_prop = $props->{"svn:mergeinfo"}; + if ($mergeinfo_prop) { + my $mi_changes = $self->mergeinfo_changes( + $parent_path, + $parent_rev, + $self->path, + $rev, + $mergeinfo_prop); + $self->find_extra_svn_parents($mi_changes, \@parents); } } @@ -2161,8 +2287,9 @@ sub rev_map_set { # both of these options make our .rev_db file very, very important # and we can't afford to lose it because rebuild() won't work if ($self->use_svm_props || $self->no_metadata) { + require File::Copy; $sync = 1; - copy($db, $db_lock) or die "rev_map_set(@_): ", + File::Copy::copy($db, $db_lock) or die "rev_map_set(@_): ", "Failed to copy: ", "$db => $db_lock ($!)\n"; } else { @@ -2334,12 +2461,13 @@ sub _new { "refs/remotes/$prefix$default_ref_id"; } $_[1] = $repo_id; - my $dir = "$ENV{GIT_DIR}/svn/$ref_id"; + my $svn_dir = svn_dir(); + my $dir = "$svn_dir/$ref_id"; - # Older repos imported by us used $GIT_DIR/svn/foo instead of - # $GIT_DIR/svn/refs/remotes/foo when tracking refs/remotes/foo - if ($ref_id =~ m{^refs/remotes/(.*)}) { - my $old_dir = "$ENV{GIT_DIR}/svn/$1"; + # Older repos imported by us used $svn_dir/foo instead of + # $svn_dir/refs/remotes/foo when tracking refs/remotes/foo + if ($ref_id =~ m{^refs/remotes/(.+)}) { + my $old_dir = "$svn_dir/$1"; if (-d $old_dir && ! -d $dir) { $dir = $old_dir; } @@ -2349,7 +2477,7 @@ sub _new { mkpath([$dir]); my $obj = bless { ref_id => $ref_id, dir => $dir, index => "$dir/index", - config => "$ENV{GIT_DIR}/svn/config", + config => "$svn_dir/config", map_root => "$dir/.rev_map", repo_id => $repo_id }, $class; # Ensure it gets canonicalized diff --git a/perl/Git/SVN/Editor.pm b/perl/Git/SVN/Editor.pm index 34e8af966c..0df16ed726 100644 --- a/perl/Git/SVN/Editor.pm +++ b/perl/Git/SVN/Editor.pm @@ -5,10 +5,11 @@ use warnings; use SVN::Core; use SVN::Delta; use Carp qw/croak/; -use IO::File; use Git qw/command command_oneline command_noisy command_output_pipe command_input_pipe command_close_pipe - command_bidi_pipe command_close_bidi_pipe/; + command_bidi_pipe command_close_bidi_pipe + get_record/; + BEGIN { @ISA = qw(SVN::Delta::Editor); } @@ -42,6 +43,7 @@ sub new { "$self->{svn_path}/" : ''; $self->{config} = $opts->{config}; $self->{mergeinfo} = $opts->{mergeinfo}; + $self->{pathnameencoding} = Git::config('svn.pathnameencoding'); return $self; } @@ -57,11 +59,9 @@ sub generate_diff { push @diff_tree, "-l$_rename_limit" if defined $_rename_limit; push @diff_tree, $tree_a, $tree_b; my ($diff_fh, $ctx) = command_output_pipe(@diff_tree); - local $/ = "\0"; my $state = 'meta'; my @mods; - while (<$diff_fh>) { - chomp $_; # this gets rid of the trailing "\0" + while (defined($_ = get_record($diff_fh, "\0"))) { if ($state eq 'meta' && /^:(\d{6})\s(\d{6})\s ($::sha1)\s($::sha1)\s ([MTCRAD])\d*$/xo) { @@ -144,11 +144,12 @@ sub repo_path { sub url_path { my ($self, $path) = @_; + $path = $self->repo_path($path); if ($self->{url} =~ m#^https?://#) { # 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); + $self->{url} . '/' . $path; } sub rmdirs { @@ -172,9 +173,7 @@ sub rmdirs { my ($fh, $ctx) = command_output_pipe(qw/ls-tree --name-only -r -z/, $self->{tree_b}); - local $/ = "\0"; - while (<$fh>) { - chomp; + while (defined($_ = get_record($fh, "\0"))) { my @dn = split m#/#, $_; while (pop @dn) { delete $rm->{join '/', @dn}; @@ -288,6 +287,40 @@ sub apply_autoprops { } } +sub check_attr { + my ($attr,$path) = @_; + my $val = command_oneline("check-attr", $attr, "--", $path); + if ($val) { $val =~ s/^[^:]*:\s*[^:]*:\s*(.*)\s*$/$1/; } + return $val; +} + +sub apply_manualprops { + my ($self, $file, $fbat) = @_; + my $pending_properties = check_attr( "svn-properties", $file ); + if ($pending_properties eq "") { return; } + # Parse the list of properties to set. + my @props = split(/;/, $pending_properties); + # TODO: get existing properties to compare to + # - this fails for add so currently not done + # my $existing_props = ::get_svnprops($file); + my $existing_props = {}; + # TODO: caching svn properties or storing them in .gitattributes + # would make that faster + foreach my $prop (@props) { + # Parse 'name=value' syntax and set the property. + if ($prop =~ /([^=]+)=(.*)/) { + my ($n,$v) = ($1,$2); + for ($n, $v) { + s/^\s+//; s/\s+$//; + } + my $existing = $existing_props->{$n}; + if (!defined($existing) || $existing ne $v) { + $self->change_file_prop($fbat, $n, $v); + } + } + } +} + sub A { my ($self, $m, $deletions) = @_; my ($dir, $file) = split_path($m->{file_b}); @@ -296,6 +329,7 @@ sub A { undef, -1); print "\tA\t$m->{file_b}\n" unless $::_q; $self->apply_autoprops($file, $fbat); + $self->apply_manualprops($m->{file_b}, $fbat); $self->chg_file($fbat, $m); $self->close_file($fbat,undef,$self->{pool}); } @@ -311,6 +345,7 @@ sub C { my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat, $upa, $self->{r}); print "\tC\t$m->{file_a} => $m->{file_b}\n" unless $::_q; + $self->apply_manualprops($m->{file_b}, $fbat); $self->chg_file($fbat, $m); $self->close_file($fbat,undef,$self->{pool}); } @@ -333,6 +368,7 @@ sub R { $upa, $self->{r}); print "\tR\t$m->{file_a} => $m->{file_b}\n" unless $::_q; $self->apply_autoprops($file, $fbat); + $self->apply_manualprops($m->{file_b}, $fbat); $self->chg_file($fbat, $m); $self->close_file($fbat,undef,$self->{pool}); @@ -348,6 +384,7 @@ sub M { my $fbat = $self->open_file($self->repo_path($m->{file_b}), $pbat,$self->{r},$self->{pool}); print "\t$m->{chg}\t$m->{file_b}\n" unless $::_q; + $self->apply_manualprops($m->{file_b}, $fbat); $self->chg_file($fbat, $m); $self->close_file($fbat,undef,$self->{pool}); } @@ -548,7 +585,7 @@ The interface will change as git-svn evolves. =head1 DEPENDENCIES Subversion perl bindings, -the core L<Carp> and L<IO::File> modules, +the core L<Carp> module, and git's L<Git> helper module. C<Git::SVN::Editor> has not been tested using callers other than diff --git a/perl/Git/SVN/Fetcher.pm b/perl/Git/SVN/Fetcher.pm index 10edb27732..64e900a0e9 100644 --- a/perl/Git/SVN/Fetcher.pm +++ b/perl/Git/SVN/Fetcher.pm @@ -7,10 +7,10 @@ use warnings; use SVN::Delta; use Carp qw/croak/; use File::Basename qw/dirname/; -use IO::File qw//; use Git qw/command command_oneline command_noisy command_output_pipe command_input_pipe command_close_pipe - command_bidi_pipe command_close_bidi_pipe/; + command_bidi_pipe command_close_bidi_pipe + get_record/; BEGIN { @ISA = qw(SVN::Delta::Editor); } @@ -87,11 +87,9 @@ sub _mark_empty_symlinks { my $printed_warning; chomp(my $empty_blob = `git hash-object -t blob --stdin < /dev/null`); my ($ls, $ctx) = command_output_pipe(qw/ls-tree -r -z/, $cmt); - local $/ = "\0"; my $pfx = defined($switch_path) ? $switch_path : $git_svn->path; $pfx .= '/' if length($pfx); - while (<$ls>) { - chomp; + while (defined($_ = get_record($ls, "\0"))) { s/\A100644 blob $empty_blob\t//o or next; unless ($printed_warning) { print STDERR "Scanning for empty symlinks, ", @@ -180,9 +178,7 @@ sub delete_entry { my ($ls, $ctx) = command_output_pipe(qw/ls-tree -r --name-only -z/, $tree); - local $/ = "\0"; - while (<$ls>) { - chomp; + while (defined($_ = get_record($ls, "\0"))) { my $rmpath = "$gpath/$_"; $self->{gii}->remove($rmpath); print "\tD\t$rmpath\n" unless $::_q; @@ -248,9 +244,7 @@ sub add_directory { my ($ls, $ctx) = command_output_pipe(qw/ls-tree -r --name-only -z/, $self->{c}); - local $/ = "\0"; - while (<$ls>) { - chomp; + while (defined($_ = get_record($ls, "\0"))) { $self->{gii}->remove($_); print "\tD\t$_\n" unless $::_q; push @deleted_gpath, $gpath; @@ -322,6 +316,14 @@ sub apply_textdelta { # (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_${$}_$suffix"); + # close_file may call temp_acquire on 'svn_hash', but because of the + # call chain, if the temp_acquire call from close_file ends up being the + # call that first creates the 'svn_hash' temp file, then the FileHandle + # that's created as a result will end up in an SVN::Pool that we clear + # in SVN::Ra::gs_fetch_loop_common. Avoid that by making sure the + # 'svn_hash' FileHandle is already created before close_file is called. + my $tmp_fh = $::_repository->temp_acquire('svn_hash'); + $::_repository->temp_release($tmp_fh, 1); if ($fb->{blob}) { my ($base_is_link, $size); @@ -600,7 +602,7 @@ developing git-svn. =head1 DEPENDENCIES L<SVN::Delta> from the Subversion perl bindings, -the core L<Carp>, L<File::Basename>, and L<IO::File> modules, +the core L<Carp> and L<File::Basename> modules, and git's L<Git> helper module. C<Git::SVN::Fetcher> has not been tested using callers other than diff --git a/perl/Git/SVN/GlobSpec.pm b/perl/Git/SVN/GlobSpec.pm index c95f5d76ca..a0a8d17621 100644 --- a/perl/Git/SVN/GlobSpec.pm +++ b/perl/Git/SVN/GlobSpec.pm @@ -8,19 +8,23 @@ sub new { $re =~ s!/+$!!g; # no need for trailing slashes my (@left, @right, @patterns); my $state = "left"; - my $die_msg = "Only one set of wildcard directories " . - "(e.g. '*' or '*/*/*') is supported: '$glob'\n"; + my $die_msg = "Only one set of wildcards " . + "(e.g. '*' or '*/*/*') is supported: $glob\n"; for my $part (split(m|/|, $glob)) { - if ($part =~ /\*/ && $part ne "*") { - die "Invalid pattern in '$glob': $part\n"; - } elsif ($pattern_ok && $part =~ /[{}]/ && + if ($pattern_ok && $part =~ /[{}]/ && $part !~ /^\{[^{}]+\}/) { die "Invalid pattern in '$glob': $part\n"; } - if ($part eq "*") { + my $nstars = $part =~ tr/*//; + if ($nstars > 1) { + die "Only one '*' is allowed in a pattern: '$part'\n"; + } + if ($part =~ /(.*)\*(.*)/) { die $die_msg if $state eq "right"; + my ($l, $r) = ($1, $2); $state = "pattern"; - push(@patterns, "[^/]*"); + my $pat = quotemeta($l) . '[^/]*' . quotemeta($r); + push(@patterns, $pat); } elsif ($pattern_ok && $part =~ /^\{(.*)\}$/) { die $die_msg if $state eq "right"; $state = "pattern"; diff --git a/perl/Git/SVN/Log.pm b/perl/Git/SVN/Log.pm index 34f2869ab5..664105357c 100644 --- a/perl/Git/SVN/Log.pm +++ b/perl/Git/SVN/Log.pm @@ -116,7 +116,7 @@ sub run_pager { return; } open STDIN, '<&', $rfd or fatal "Can't redirect stdin: $!"; - $ENV{LESS} ||= 'FRSX'; + $ENV{LESS} ||= 'FRX'; $ENV{LV} ||= '-c'; exec $pager or fatal "Can't run pager: $! ($pager)"; } diff --git a/perl/Git/SVN/Migration.pm b/perl/Git/SVN/Migration.pm index 30daf35465..dc90f6a621 100644 --- a/perl/Git/SVN/Migration.pm +++ b/perl/Git/SVN/Migration.pm @@ -1,6 +1,6 @@ package Git::SVN::Migration; # these version numbers do NOT correspond to actual version numbers -# of git nor git-svn. They are just relative. +# of git or git-svn. They are just relative. # # v0 layout: .git/$id/info/url, refs/heads/$id-HEAD # @@ -44,7 +44,9 @@ use Git qw( command_noisy command_output_pipe command_close_pipe + command_oneline ); +use Git::SVN; sub migrate_from_v0 { my $git_dir = $ENV{GIT_DIR}; @@ -55,7 +57,9 @@ sub migrate_from_v0 { chomp; my ($id, $orig_ref) = ($_, $_); next unless $id =~ s#^refs/heads/(.+)-HEAD$#$1#; - next unless -f "$git_dir/$id/info/url"; + my $info_url = command_oneline(qw(rev-parse --git-path), + "$id/info/url"); + next unless -f $info_url; my $new_ref = "refs/remotes/$id"; if (::verify_ref("$new_ref^0")) { print STDERR "W: $orig_ref is probably an old ", @@ -82,7 +86,7 @@ sub migrate_from_v1 { my $git_dir = $ENV{GIT_DIR}; my $migrated = 0; return $migrated unless -d $git_dir; - my $svn_dir = "$git_dir/svn"; + my $svn_dir = Git::SVN::svn_dir(); # just in case somebody used 'svn' as their $id at some point... return $migrated if -d $svn_dir && ! -f "$svn_dir/info/url"; @@ -97,27 +101,28 @@ sub migrate_from_v1 { my $x = $_; next unless $x =~ s#^refs/remotes/##; chomp $x; - next unless -f "$git_dir/$x/info/url"; - my $u = eval { ::file_to_s("$git_dir/$x/info/url") }; + my $info_url = command_oneline(qw(rev-parse --git-path), + "$x/info/url"); + next unless -f $info_url; + my $u = eval { ::file_to_s($info_url) }; next unless $u; - my $dn = dirname("$git_dir/svn/$x"); + my $dn = dirname("$svn_dir/$x"); mkpath([$dn]) unless -d $dn; if ($x eq 'svn') { # they used 'svn' as GIT_SVN_ID: - mkpath(["$git_dir/svn/svn"]); + mkpath(["$svn_dir/svn"]); print STDERR " - $git_dir/$x/info => ", - "$git_dir/svn/$x/info\n"; - rename "$git_dir/$x/info", "$git_dir/svn/$x/info" or + "$svn_dir/$x/info\n"; + rename "$git_dir/$x/info", "$svn_dir/$x/info" or croak "$!: $x"; # don't worry too much about these, they probably # don't exist with repos this old (save for index, # and we can easily regenerate that) foreach my $f (qw/unhandled.log index .rev_db/) { - rename "$git_dir/$x/$f", "$git_dir/svn/$x/$f"; + rename "$git_dir/$x/$f", "$svn_dir/$x/$f"; } } else { - print STDERR " - $git_dir/$x => $git_dir/svn/$x\n"; - rename "$git_dir/$x", "$git_dir/svn/$x" or - croak "$!: $x"; + print STDERR " - $git_dir/$x => $svn_dir/$x\n"; + rename "$git_dir/$x", "$svn_dir/$x" or croak "$!: $x"; } $migrated++; } @@ -139,9 +144,10 @@ sub read_old_urls { push @dir, $_; } } + my $svn_dir = Git::SVN::svn_dir(); foreach (@dir) { my $x = $_; - $x =~ s!^\Q$ENV{GIT_DIR}\E/svn/!!o; + $x =~ s!^\Q$svn_dir\E/!!o; read_old_urls($l_map, $x, $_); } } @@ -150,7 +156,7 @@ sub migrate_from_v2 { my @cfg = command(qw/config -l/); return if grep /^svn-remote\..+\.url=/, @cfg; my %l_map; - read_old_urls(\%l_map, '', "$ENV{GIT_DIR}/svn"); + read_old_urls(\%l_map, '', Git::SVN::svn_dir()); my $migrated = 0; require Git::SVN; @@ -239,7 +245,8 @@ sub minimize_connections { } } if (@emptied) { - my $file = $ENV{GIT_CONFIG} || "$ENV{GIT_DIR}/config"; + my $file = $ENV{GIT_CONFIG} || + command_oneline(qw(rev-parse --git-path config)); print STDERR <<EOF; The following [svn-remote] sections in your config file ($file) are empty and can be safely removed: diff --git a/perl/Git/SVN/Ra.pm b/perl/Git/SVN/Ra.pm index a7b0119ee5..56ad9870bc 100644 --- a/perl/Git/SVN/Ra.pm +++ b/perl/Git/SVN/Ra.pm @@ -2,7 +2,7 @@ package Git::SVN::Ra; use vars qw/@ISA $config_dir $_ignore_refs_regex $_log_window_size/; use strict; use warnings; -use SVN::Client; +use Memoize; use Git::SVN::Utils qw( canonicalize_url canonicalize_path @@ -41,6 +41,7 @@ END { } sub _auth_providers () { + require SVN::Client; my @rv = ( SVN::Client::get_simple_provider(), SVN::Client::get_ssl_server_trust_file_provider(), @@ -76,6 +77,44 @@ sub _auth_providers () { \@rv; } +sub prepare_config_once { + SVN::_Core::svn_config_ensure($config_dir, undef); + my ($baton, $callbacks) = SVN::Core::auth_open_helper(_auth_providers); + my $config = SVN::Core::config_get_config($config_dir); + my $conf_t = $config->{'config'}; + + no warnings 'once'; + # The usage of $SVN::_Core::SVN_CONFIG_* variables + # produces warnings that variables are used only once. + # I had not found the better way to shut them up, so + # the warnings of type 'once' are disabled in this block. + if (SVN::_Core::svn_config_get_bool($conf_t, + $SVN::_Core::SVN_CONFIG_SECTION_AUTH, + $SVN::_Core::SVN_CONFIG_OPTION_STORE_PASSWORDS, + 1) == 0) { + my $val = '1'; + if (::compare_svn_version('1.9.0') < 0) { # pre-SVN r1553823 + my $dont_store_passwords = 1; + $val = bless \$dont_store_passwords, "_p_void"; + } + SVN::_Core::svn_auth_set_parameter($baton, + $SVN::_Core::SVN_AUTH_PARAM_DONT_STORE_PASSWORDS, + $val); + } + if (SVN::_Core::svn_config_get_bool($conf_t, + $SVN::_Core::SVN_CONFIG_SECTION_AUTH, + $SVN::_Core::SVN_CONFIG_OPTION_STORE_AUTH_CREDS, + 1) == 0) { + $Git::SVN::Prompt::_no_auth_cache = 1; + } + + return ($config, $baton, $callbacks); +} # no warnings 'once' + +INIT { + Memoize::memoize '_auth_providers'; + Memoize::memoize 'prepare_config_once'; +} sub new { my ($class, $url) = @_; @@ -84,34 +123,8 @@ sub new { ::_req_svn(); - SVN::_Core::svn_config_ensure($config_dir, undef); - my ($baton, $callbacks) = SVN::Core::auth_open_helper(_auth_providers); - my $config = SVN::Core::config_get_config($config_dir); $RA = undef; - my $dont_store_passwords = 1; - my $conf_t = ${$config}{'config'}; - { - no warnings 'once'; - # The usage of $SVN::_Core::SVN_CONFIG_* variables - # produces warnings that variables are used only once. - # I had not found the better way to shut them up, so - # the warnings of type 'once' are disabled in this block. - if (SVN::_Core::svn_config_get_bool($conf_t, - $SVN::_Core::SVN_CONFIG_SECTION_AUTH, - $SVN::_Core::SVN_CONFIG_OPTION_STORE_PASSWORDS, - 1) == 0) { - SVN::_Core::svn_auth_set_parameter($baton, - $SVN::_Core::SVN_AUTH_PARAM_DONT_STORE_PASSWORDS, - bless (\$dont_store_passwords, "_p_void")); - } - if (SVN::_Core::svn_config_get_bool($conf_t, - $SVN::_Core::SVN_CONFIG_SECTION_AUTH, - $SVN::_Core::SVN_CONFIG_OPTION_STORE_AUTH_CREDS, - 1) == 0) { - $Git::SVN::Prompt::_no_auth_cache = 1; - } - } # no warnings 'once' - + my ($config, $baton, $callbacks) = prepare_config_once(); my $self = SVN::Ra->new(url => $url, auth => $baton, config => $config, pool => SVN::Pool->new, @@ -166,7 +179,17 @@ sub get_dir { } } my $pool = SVN::Pool->new; - my ($d, undef, $props) = $self->SUPER::get_dir($dir, $r, $pool); + my ($d, undef, $props); + + if (::compare_svn_version('1.4.0') >= 0) { + # n.b. in addition to being potentially more efficient, + # this works around what appears to be a bug in some + # SVN 1.8 versions + my $kind = 1; # SVN_DIRENT_KIND + ($d, undef, $props) = $self->get_dir2($dir, $r, $kind, $pool); + } else { + ($d, undef, $props) = $self->SUPER::get_dir($dir, $r, $pool); + } my %dirents = map { $_ => { kind => $d->{$_}->kind } } keys %$d; $pool->clear; if ($r != $cache->{r}) { @@ -177,10 +200,6 @@ sub get_dir { wantarray ? (\%dirents, $r, $props) : \%dirents; } -sub DESTROY { - # do not call the real DESTROY since we store ourselves in $RA -} - # get_log(paths, start, end, limit, # discover_changed_paths, strict_node_history, receiver) sub get_log { @@ -232,7 +251,10 @@ sub get_log { $ret; } +# uncommon, only for ancient SVN (<= 1.4.2) sub trees_match { + require IO::File; + require SVN::Client; my ($self, $url1, $rev1, $url2, $rev2) = @_; my $ctx = SVN::Client->new(auth => _auth_providers); my $out = IO::File->new_tmpfile; @@ -376,10 +398,22 @@ sub longest_common_path { sub gs_fetch_loop_common { my ($self, $base, $head, $gsv, $globs) = @_; return if ($base > $head); + # Make sure the cat_blob open2 FileHandle is created before calling + # SVN::Pool::new_default so that it does not incorrectly end up in the pool. + $::_repository->_open_cat_blob_if_needed; + my $gpool = SVN::Pool->new_default; + my $ra_url = $self->url; + my $reload_ra = sub { + $_[0] = undef; + $self = undef; + $RA = undef; + $gpool->clear; + $self = Git::SVN::Ra->new($ra_url); + $ra_invalid = undef; + }; my $inc = $_log_window_size; my ($min, $max) = ($base, $head < $base + $inc ? $head : $base + $inc); my $longest_path = longest_common_path($gsv, $globs); - my $ra_url = $self->url; my $find_trailing_edge; while (1) { my %revs; @@ -426,7 +460,7 @@ sub gs_fetch_loop_common { my %exists = map { $_->path => $_ } @$gsv; foreach my $r (sort {$a <=> $b} keys %revs) { - my ($paths, $logged) = @{$revs{$r}}; + my ($paths, $logged) = @{delete $revs{$r}}; foreach my $gs ($self->match_globs(\%exists, $paths, $globs, $r)) { @@ -449,13 +483,7 @@ sub gs_fetch_loop_common { "$g->{t}-maxRev"; Git::SVN::tmp_config($k, $r); } - if ($ra_invalid) { - $_[0] = undef; - $self = undef; - $RA = undef; - $self = Git::SVN::Ra->new($ra_url); - $ra_invalid = undef; - } + $reload_ra->() if $ra_invalid; } # pre-fill the .rev_db since it'll eventually get filled in # with '0' x40 if something new gets committed @@ -472,6 +500,8 @@ sub gs_fetch_loop_common { $min = $max + 1; $max += $inc; $max = $head if ($max > $head); + + $reload_ra->(); } Git::SVN::gc(); } @@ -576,7 +606,7 @@ sub minimize_url { my $latest = $ra->get_latest_revnum; $ra->get_log("", $latest, 0, 1, 0, 1, sub {}); }; - } while ($@ && ($c = shift @components)); + } while ($@ && defined($c = shift @components)); return canonicalize_url($url); } |