diff options
Diffstat (limited to 'perl/Git')
-rw-r--r-- | perl/Git/I18N.pm | 21 | ||||
-rw-r--r-- | perl/Git/LoadCPAN.pm | 104 | ||||
-rw-r--r-- | perl/Git/LoadCPAN/Error.pm | 10 | ||||
-rw-r--r-- | perl/Git/LoadCPAN/Mail/Address.pm | 10 | ||||
-rw-r--r-- | perl/Git/Packet.pm | 173 | ||||
-rw-r--r-- | perl/Git/SVN.pm | 85 | ||||
-rw-r--r-- | perl/Git/SVN/Editor.pm | 12 | ||||
-rw-r--r-- | perl/Git/SVN/Fetcher.pm | 15 | ||||
-rw-r--r-- | perl/Git/SVN/Migration.pm | 37 | ||||
-rw-r--r-- | perl/Git/SVN/Ra.pm | 2 |
10 files changed, 405 insertions, 64 deletions
diff --git a/perl/Git/I18N.pm b/perl/Git/I18N.pm index f889fd6da9..bfb4fb67a1 100644 --- a/perl/Git/I18N.pm +++ b/perl/Git/I18N.pm @@ -13,12 +13,12 @@ BEGIN { } } -our @EXPORT = qw(__); +our @EXPORT = qw(__ __n N__); our @EXPORT_OK = @EXPORT; sub __bootstrap_locale_messages { our $TEXTDOMAIN = 'git'; - our $TEXTDOMAINDIR = $ENV{GIT_TEXTDOMAINDIR} || '++LOCALEDIR++'; + our $TEXTDOMAINDIR ||= $ENV{GIT_TEXTDOMAINDIR} || '@@LOCALEDIR@@'; require POSIX; POSIX->import(qw(setlocale)); @@ -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("committed %d file\n", "committed %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/LoadCPAN.pm b/perl/Git/LoadCPAN.pm new file mode 100644 index 0000000000..e5585e75e8 --- /dev/null +++ b/perl/Git/LoadCPAN.pm @@ -0,0 +1,104 @@ +package Git::LoadCPAN; +use 5.008; +use strict; +use warnings; + +=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[@@NO_PERL_CPAN_FALLBACKS@@] ne '' + and + q[@@NO_PERL_CPAN_FALLBACKS@@] 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; diff --git a/perl/Git/LoadCPAN/Error.pm b/perl/Git/LoadCPAN/Error.pm new file mode 100644 index 0000000000..c6d2c45d80 --- /dev/null +++ b/perl/Git/LoadCPAN/Error.pm @@ -0,0 +1,10 @@ +package Git::LoadCPAN::Error; +use 5.008; +use strict; +use warnings; +use Git::LoadCPAN ( + module => 'Error', + import => 1, +); + +1; diff --git a/perl/Git/LoadCPAN/Mail/Address.pm b/perl/Git/LoadCPAN/Mail/Address.pm new file mode 100644 index 0000000000..f70a4f064c --- /dev/null +++ b/perl/Git/LoadCPAN/Mail/Address.pm @@ -0,0 +1,10 @@ +package Git::LoadCPAN::Mail::Address; +use 5.008; +use strict; +use warnings; +use Git::LoadCPAN ( + module => 'Mail::Address', + import => 0, +); + +1; diff --git a/perl/Git/Packet.pm b/perl/Git/Packet.pm new file mode 100644 index 0000000000..b75738bed4 --- /dev/null +++ b/perl/Git/Packet.pm @@ -0,0 +1,173 @@ +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_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; diff --git a/perl/Git/SVN.pm b/perl/Git/SVN.pm index b2c14e2ff5..76b2965905 100644 --- a/perl/Git/SVN.pm +++ b/perl/Git/SVN.pm @@ -98,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) { @@ -485,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* @@ -802,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"; @@ -1395,7 +1405,7 @@ sub parse_svn_date { $ENV{TZ} = 'UTC'; my $epoch_in_UTC = - Time::Local::timelocal($S, $M, $H, $d, $m - 1, $Y - 1900); + Time::Local::timelocal($S, $M, $H, $d, $m - 1, $Y); # Determine our local timezone (including DST) at the # time of $epoch_in_UTC. $Git::SVN::Log::TZ stored the @@ -1406,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, @@ -1472,7 +1482,6 @@ sub call_authors_prog { } if ($author =~ /^\s*(.+?)\s*<(.*)>\s*$/) { my ($name, $email) = ($1, $2); - $email = undef if length $2 == 0; return [$name, $email]; } else { die "Author: $orig_author: $::_authors_prog returned " @@ -1653,7 +1662,17 @@ sub tie_for_persistent_memoization { 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'; } } @@ -1666,7 +1685,7 @@ 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; @@ -1707,7 +1726,7 @@ sub tie_for_persistent_memoization { 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", @@ -1904,15 +1923,22 @@ sub make_log_entry { my @parents = @$parents; my $props = $ed->{dir_prop}{$self->path}; - if ( $props->{"svk:merge"} ) { - $self->find_extra_svk_parents($props->{"svk:merge"}, \@parents); - } - if ( $props->{"svn:mergeinfo"} ) { - my $mi_changes = $self->mergeinfo_changes - ($parent_path, $parent_rev, - $self->path, $rev, - $props->{"svn:mergeinfo"}); - $self->find_extra_svn_parents($mi_changes, \@parents); + if ($self->follow_parent) { + my $tickets = $props->{"svk:merge"}; + if ($tickets) { + $self->find_extra_svk_parents($tickets, \@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); + } } open my $un, '>>', "$self->{dir}/unhandled.log" or croak $!; @@ -1993,8 +2019,8 @@ sub make_log_entry { remove_username($full_url); $log_entry{metadata} = "$full_url\@$r $uuid"; $log_entry{svm_revision} = $r; - $email ||= "$author\@$uuid"; - $commit_email ||= "$author\@$uuid"; + $email = "$author\@$uuid" unless defined $email; + $commit_email = "$author\@$uuid" unless defined $commit_email; } elsif ($self->use_svnsync_props) { my $full_url = canonicalize_url( add_path_to_url( $self->svnsync->{url}, $self->path ) @@ -2002,15 +2028,15 @@ sub make_log_entry { remove_username($full_url); my $uuid = $self->svnsync->{uuid}; $log_entry{metadata} = "$full_url\@$rev $uuid"; - $email ||= "$author\@$uuid"; - $commit_email ||= "$author\@$uuid"; + $email = "$author\@$uuid" unless defined $email; + $commit_email = "$author\@$uuid" unless defined $commit_email; } else { my $url = $self->metadata_url; remove_username($url); my $uuid = $self->rewrite_uuid || $self->ra->get_uuid; $log_entry{metadata} = "$url\@$rev " . $uuid; - $email ||= "$author\@" . $uuid; - $commit_email ||= "$author\@" . $uuid; + $email = "$author\@$uuid" unless defined $email; + $commit_email = "$author\@$uuid" unless defined $commit_email; } $log_entry{name} = $name; $log_entry{email} = $email; @@ -2434,12 +2460,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 + # 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 = "$ENV{GIT_DIR}/svn/$1"; + my $old_dir = "$svn_dir/$1"; if (-d $old_dir && ! -d $dir) { $dir = $old_dir; } @@ -2449,7 +2476,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 4c4199afec..0df16ed726 100644 --- a/perl/Git/SVN/Editor.pm +++ b/perl/Git/SVN/Editor.pm @@ -7,7 +7,9 @@ use SVN::Delta; use Carp qw/croak/; 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); } @@ -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) { @@ -173,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}; diff --git a/perl/Git/SVN/Fetcher.pm b/perl/Git/SVN/Fetcher.pm index d8c21ad915..64e900a0e9 100644 --- a/perl/Git/SVN/Fetcher.pm +++ b/perl/Git/SVN/Fetcher.pm @@ -9,7 +9,8 @@ use Carp qw/croak/; use File::Basename qw/dirname/; 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); } @@ -86,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, ", @@ -179,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; @@ -247,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; diff --git a/perl/Git/SVN/Migration.pm b/perl/Git/SVN/Migration.pm index cf6ffa7581..dc90f6a621 100644 --- a/perl/Git/SVN/Migration.pm +++ b/perl/Git/SVN/Migration.pm @@ -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 e764696801..56ad9870bc 100644 --- a/perl/Git/SVN/Ra.pm +++ b/perl/Git/SVN/Ra.pm @@ -606,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); } |