diff options
-rwxr-xr-x | git-svn.perl | 795 | ||||
-rw-r--r-- | perl/Git/IndexInfo.pm | 33 | ||||
-rw-r--r-- | perl/Git/SVN.pm | 2 | ||||
-rw-r--r-- | perl/Git/SVN/Fetcher.pm | 1 | ||||
-rw-r--r-- | perl/Git/SVN/GlobSpec.pm | 59 | ||||
-rw-r--r-- | perl/Git/SVN/Log.pm | 395 | ||||
-rw-r--r-- | perl/Git/SVN/Migration.pm | 258 | ||||
-rw-r--r-- | perl/Makefile | 4 | ||||
-rw-r--r-- | t/Git-SVN/00compile.t | 9 |
9 files changed, 795 insertions, 761 deletions
diff --git a/git-svn.perl b/git-svn.perl index 9269d80a6..5711c5719 100755 --- a/git-svn.perl +++ b/git-svn.perl @@ -10,8 +10,42 @@ use vars qw/ $AUTHOR $VERSION $AUTHOR = 'Eric Wong <normalperson@yhbt.net>'; $VERSION = '@@GIT_VERSION@@'; +use Carp qw/croak/; +use Digest::MD5; +use IO::File qw//; +use File::Basename qw/dirname basename/; +use File::Path qw/mkpath/; +use File::Spec; +use File::Find; +use Getopt::Long qw/:config gnu_getopt no_ignore_case auto_abbrev/; +use IPC::Open3; +use Memoize; + use Git::SVN; +use Git::SVN::Editor; +use Git::SVN::Fetcher; +use Git::SVN::Ra; +use Git::SVN::Prompt; +use Git::SVN::Log; +use Git::SVN::Migration; + use Git::SVN::Utils qw(fatal can_compress); +use Git qw( + git_cmd_try + command + command_oneline + command_noisy + command_output_pipe + command_close_pipe + command_bidi_pipe + command_close_bidi_pipe +); + +BEGIN { + Memoize::memoize 'Git::config'; + Memoize::memoize 'Git::config_bool'; +} + # From which subdir have we been invoked? my $cmd_dir_prefix = eval { @@ -65,39 +99,6 @@ sub _req_svn { } } -use Carp qw/croak/; -use Digest::MD5; -use IO::File qw//; -use File::Basename qw/dirname basename/; -use File::Path qw/mkpath/; -use File::Spec; -use File::Find; -use Getopt::Long qw/:config gnu_getopt no_ignore_case auto_abbrev/; -use IPC::Open3; -use Git; -use Git::SVN::Editor qw//; -use Git::SVN::Fetcher qw//; -use Git::SVN::Ra qw//; -use Git::SVN::Prompt qw//; -use Memoize; # core since 5.8.0, Jul 2002 - -BEGIN { - # import functions from Git into our packages, en masse - no strict 'refs'; - foreach (qw/command command_oneline command_noisy command_output_pipe - command_input_pipe command_close_pipe - command_bidi_pipe command_close_bidi_pipe/) { - for my $package ( qw(Git::SVN::Migration Git::SVN::Log), - __PACKAGE__) { - *{"${package}::$_"} = \&{"Git::$_"}; - } - } - Memoize::memoize 'Git::config'; - Memoize::memoize 'Git::config_bool'; -} - -my ($SVN); - $sha1 = qr/[a-f\d]{40}/; $sha1_short = qr/[a-f\d]{4,40}/; my ($_stdin, $_help, $_edit, @@ -106,7 +107,7 @@ my ($_stdin, $_help, $_edit, $_version, $_fetch_all, $_no_rebase, $_fetch_parent, $_merge, $_strategy, $_preserve_merges, $_dry_run, $_local, $_prefix, $_no_checkout, $_url, $_verbose, - $_git_format, $_commit_url, $_tag, $_merge_info, $_interactive); + $_commit_url, $_tag, $_merge_info, $_interactive); # This is a refactoring artifact so Git::SVN can get at this git-svn switch. sub opt_prefix { return $_prefix || '' } @@ -270,7 +271,7 @@ my %cmd = ( { 'url' => \$_url, } ], 'blame' => [ \&Git::SVN::Log::cmd_blame, "Show what revision and author last modified each line of a file", - { 'git-format' => \$_git_format } ], + { 'git-format' => \$Git::SVN::Log::_git_format } ], 'reset' => [ \&cmd_reset, "Undo fetches back to the specified SVN revision", { 'revision|r=s' => \$_revision, @@ -2038,730 +2039,6 @@ sub gc_directory { } } - -package Git::SVN::Log; -use strict; -use warnings; -use Git::SVN::Utils qw(fatal); -use POSIX qw/strftime/; -use constant commit_log_separator => ('-' x 72) . "\n"; -use vars qw/$TZ $limit $color $pager $non_recursive $verbose $oneline - %rusers $show_commit $incremental/; -my $l_fmt; - -sub cmt_showable { - my ($c) = @_; - return 1 if defined $c->{r}; - - # big commit message got truncated by the 16k pretty buffer in rev-list - if ($c->{l} && $c->{l}->[-1] eq "...\n" && - $c->{a_raw} =~ /\@([a-f\d\-]+)>$/) { - @{$c->{l}} = (); - my @log = command(qw/cat-file commit/, $c->{c}); - - # shift off the headers - shift @log while ($log[0] ne ''); - shift @log; - - # TODO: make $c->{l} not have a trailing newline in the future - @{$c->{l}} = map { "$_\n" } grep !/^git-svn-id: /, @log; - - (undef, $c->{r}, undef) = ::extract_metadata( - (grep(/^git-svn-id: /, @log))[-1]); - } - return defined $c->{r}; -} - -sub log_use_color { - return $color || Git->repository->get_colorbool('color.diff'); -} - -sub git_svn_log_cmd { - my ($r_min, $r_max, @args) = @_; - my $head = 'HEAD'; - my (@files, @log_opts); - foreach my $x (@args) { - if ($x eq '--' || @files) { - push @files, $x; - } else { - if (::verify_ref("$x^0")) { - $head = $x; - } else { - push @log_opts, $x; - } - } - } - - my ($url, $rev, $uuid, $gs) = ::working_head_info($head); - $gs ||= Git::SVN->_new; - my @cmd = (qw/log --abbrev-commit --pretty=raw --default/, - $gs->refname); - push @cmd, '-r' unless $non_recursive; - push @cmd, qw/--raw --name-status/ if $verbose; - push @cmd, '--color' if log_use_color(); - push @cmd, @log_opts; - if (defined $r_max && $r_max == $r_min) { - push @cmd, '--max-count=1'; - if (my $c = $gs->rev_map_get($r_max)) { - push @cmd, $c; - } - } elsif (defined $r_max) { - if ($r_max < $r_min) { - ($r_min, $r_max) = ($r_max, $r_min); - } - my (undef, $c_max) = $gs->find_rev_before($r_max, 1, $r_min); - my (undef, $c_min) = $gs->find_rev_after($r_min, 1, $r_max); - # If there are no commits in the range, both $c_max and $c_min - # will be undefined. If there is at least 1 commit in the - # range, both will be defined. - return () if !defined $c_min || !defined $c_max; - if ($c_min eq $c_max) { - push @cmd, '--max-count=1', $c_min; - } else { - push @cmd, '--boundary', "$c_min..$c_max"; - } - } - return (@cmd, @files); -} - -# adapted from pager.c -sub config_pager { - if (! -t *STDOUT) { - $ENV{GIT_PAGER_IN_USE} = 'false'; - $pager = undef; - return; - } - chomp($pager = command_oneline(qw(var GIT_PAGER))); - if ($pager eq 'cat') { - $pager = undef; - } - $ENV{GIT_PAGER_IN_USE} = defined($pager); -} - -sub run_pager { - return unless defined $pager; - pipe my ($rfd, $wfd) or return; - defined(my $pid = fork) or fatal "Can't fork: $!"; - if (!$pid) { - open STDOUT, '>&', $wfd or - fatal "Can't redirect to stdout: $!"; - return; - } - open STDIN, '<&', $rfd or fatal "Can't redirect stdin: $!"; - $ENV{LESS} ||= 'FRSX'; - exec $pager or fatal "Can't run pager: $! ($pager)"; -} - -sub format_svn_date { - my $t = shift || time; - my $gmoff = Git::SVN::get_tz($t); - return strftime("%Y-%m-%d %H:%M:%S $gmoff (%a, %d %b %Y)", localtime($t)); -} - -sub parse_git_date { - my ($t, $tz) = @_; - # Date::Parse isn't in the standard Perl distro :( - if ($tz =~ s/^\+//) { - $t += tz_to_s_offset($tz); - } elsif ($tz =~ s/^\-//) { - $t -= tz_to_s_offset($tz); - } - return $t; -} - -sub set_local_timezone { - if (defined $TZ) { - $ENV{TZ} = $TZ; - } else { - delete $ENV{TZ}; - } -} - -sub tz_to_s_offset { - my ($tz) = @_; - $tz =~ s/(\d\d)$//; - return ($1 * 60) + ($tz * 3600); -} - -sub get_author_info { - my ($dest, $author, $t, $tz) = @_; - $author =~ s/(?:^\s*|\s*$)//g; - $dest->{a_raw} = $author; - my $au; - if ($::_authors) { - $au = $rusers{$author} || undef; - } - if (!$au) { - ($au) = ($author =~ /<([^>]+)\@[^>]+>$/); - } - $dest->{t} = $t; - $dest->{tz} = $tz; - $dest->{a} = $au; - $dest->{t_utc} = parse_git_date($t, $tz); -} - -sub process_commit { - my ($c, $r_min, $r_max, $defer) = @_; - if (defined $r_min && defined $r_max) { - if ($r_min == $c->{r} && $r_min == $r_max) { - show_commit($c); - return 0; - } - return 1 if $r_min == $r_max; - if ($r_min < $r_max) { - # we need to reverse the print order - return 0 if (defined $limit && --$limit < 0); - push @$defer, $c; - return 1; - } - if ($r_min != $r_max) { - return 1 if ($r_min < $c->{r}); - return 1 if ($r_max > $c->{r}); - } - } - return 0 if (defined $limit && --$limit < 0); - show_commit($c); - return 1; -} - -sub show_commit { - my $c = shift; - if ($oneline) { - my $x = "\n"; - if (my $l = $c->{l}) { - while ($l->[0] =~ /^\s*$/) { shift @$l } - $x = $l->[0]; - } - $l_fmt ||= 'A' . length($c->{r}); - print 'r',pack($l_fmt, $c->{r}),' | '; - print "$c->{c} | " if $show_commit; - print $x; - } else { - show_commit_normal($c); - } -} - -sub show_commit_changed_paths { - my ($c) = @_; - return unless $c->{changed}; - print "Changed paths:\n", @{$c->{changed}}; -} - -sub show_commit_normal { - my ($c) = @_; - print commit_log_separator, "r$c->{r} | "; - print "$c->{c} | " if $show_commit; - print "$c->{a} | ", format_svn_date($c->{t_utc}), ' | '; - my $nr_line = 0; - - if (my $l = $c->{l}) { - while ($l->[$#$l] eq "\n" && $#$l > 0 - && $l->[($#$l - 1)] eq "\n") { - pop @$l; - } - $nr_line = scalar @$l; - if (!$nr_line) { - print "1 line\n\n\n"; - } else { - if ($nr_line == 1) { - $nr_line = '1 line'; - } else { - $nr_line .= ' lines'; - } - print $nr_line, "\n"; - show_commit_changed_paths($c); - print "\n"; - print $_ foreach @$l; - } - } else { - print "1 line\n"; - show_commit_changed_paths($c); - print "\n"; - - } - foreach my $x (qw/raw stat diff/) { - if ($c->{$x}) { - print "\n"; - print $_ foreach @{$c->{$x}} - } - } -} - -sub cmd_show_log { - my (@args) = @_; - my ($r_min, $r_max); - my $r_last = -1; # prevent dupes - set_local_timezone(); - if (defined $::_revision) { - if ($::_revision =~ /^(\d+):(\d+)$/) { - ($r_min, $r_max) = ($1, $2); - } elsif ($::_revision =~ /^\d+$/) { - $r_min = $r_max = $::_revision; - } else { - fatal "-r$::_revision is not supported, use ", - "standard 'git log' arguments instead"; - } - } - - config_pager(); - @args = git_svn_log_cmd($r_min, $r_max, @args); - if (!@args) { - print commit_log_separator unless $incremental || $oneline; - return; - } - my $log = command_output_pipe(@args); - run_pager(); - my (@k, $c, $d, $stat); - my $esc_color = qr/(?:\033\[(?:(?:\d+;)*\d*)?m)*/; - while (<$log>) { - if (/^${esc_color}commit (?:- )?($::sha1_short)/o) { - my $cmt = $1; - if ($c && cmt_showable($c) && $c->{r} != $r_last) { - $r_last = $c->{r}; - process_commit($c, $r_min, $r_max, \@k) or - goto out; - } - $d = undef; - $c = { c => $cmt }; - } elsif (/^${esc_color}author (.+) (\d+) ([\-\+]?\d+)$/o) { - get_author_info($c, $1, $2, $3); - } elsif (/^${esc_color}(?:tree|parent|committer) /o) { - # ignore - } elsif (/^${esc_color}:\d{6} \d{6} $::sha1_short/o) { - push @{$c->{raw}}, $_; - } elsif (/^${esc_color}[ACRMDT]\t/) { - # we could add $SVN->{svn_path} here, but that requires - # remote access at the moment (repo_path_split)... - s#^(${esc_color})([ACRMDT])\t#$1 $2 #o; - push @{$c->{changed}}, $_; - } elsif (/^${esc_color}diff /o) { - $d = 1; - push @{$c->{diff}}, $_; - } elsif ($d) { - push @{$c->{diff}}, $_; - } elsif (/^\ .+\ \|\s*\d+\ $esc_color[\+\-]* - $esc_color*[\+\-]*$esc_color$/x) { - $stat = 1; - push @{$c->{stat}}, $_; - } elsif ($stat && /^ \d+ files changed, \d+ insertions/) { - push @{$c->{stat}}, $_; - $stat = undef; - } elsif (/^${esc_color} (git-svn-id:.+)$/o) { - ($c->{url}, $c->{r}, undef) = ::extract_metadata($1); - } elsif (s/^${esc_color} //o) { - push @{$c->{l}}, $_; - } - } - if ($c && defined $c->{r} && $c->{r} != $r_last) { - $r_last = $c->{r}; - process_commit($c, $r_min, $r_max, \@k); - } - if (@k) { - ($r_min, $r_max) = ($r_max, $r_min); - process_commit($_, $r_min, $r_max) foreach reverse @k; - } -out: - close $log; - print commit_log_separator unless $incremental || $oneline; -} - -sub cmd_blame { - my $path = pop; - - config_pager(); - run_pager(); - - my ($fh, $ctx, $rev); - - if ($_git_format) { - ($fh, $ctx) = command_output_pipe('blame', @_, $path); - while (my $line = <$fh>) { - if ($line =~ /^\^?([[:xdigit:]]+)\s/) { - # Uncommitted edits show up as a rev ID of - # all zeros, which we can't look up with - # cmt_metadata - if ($1 !~ /^0+$/) { - (undef, $rev, undef) = - ::cmt_metadata($1); - $rev = '0' if (!$rev); - } else { - $rev = '0'; - } - $rev = sprintf('%-10s', $rev); - $line =~ s/^\^?[[:xdigit:]]+(\s)/$rev$1/; - } - print $line; - } - } else { - ($fh, $ctx) = command_output_pipe('blame', '-p', @_, 'HEAD', - '--', $path); - my ($sha1); - my %authors; - my @buffer; - my %dsha; #distinct sha keys - - while (my $line = <$fh>) { - push @buffer, $line; - if ($line =~ /^([[:xdigit:]]{40})\s\d+\s\d+/) { - $dsha{$1} = 1; - } - } - - my $s2r = ::cmt_sha2rev_batch([keys %dsha]); - - foreach my $line (@buffer) { - if ($line =~ /^([[:xdigit:]]{40})\s\d+\s\d+/) { - $rev = $s2r->{$1}; - $rev = '0' if (!$rev) - } - elsif ($line =~ /^author (.*)/) { - $authors{$rev} = $1; - $authors{$rev} =~ s/\s/_/g; - } - elsif ($line =~ /^\t(.*)$/) { - printf("%6s %10s %s\n", $rev, $authors{$rev}, $1); - } - } - } - command_close_pipe($fh, $ctx); -} - -package Git::SVN::Migration; -# these version numbers do NOT correspond to actual version numbers -# of git nor git-svn. They are just relative. -# -# v0 layout: .git/$id/info/url, refs/heads/$id-HEAD -# -# v1 layout: .git/$id/info/url, refs/remotes/$id -# -# v2 layout: .git/svn/$id/info/url, refs/remotes/$id -# -# v3 layout: .git/svn/$id, refs/remotes/$id -# - info/url may remain for backwards compatibility -# - this is what we migrate up to this layout automatically, -# - this will be used by git svn init on single branches -# v3.1 layout (auto migrated): -# - .rev_db => .rev_db.$UUID, .rev_db will remain as a symlink -# for backwards compatibility -# -# v4 layout: .git/svn/$repo_id/$id, refs/remotes/$repo_id/$id -# - this is only created for newly multi-init-ed -# repositories. Similar in spirit to the -# --use-separate-remotes option in git-clone (now default) -# - we do not automatically migrate to this (following -# the example set by core git) -# -# v5 layout: .rev_db.$UUID => .rev_map.$UUID -# - newer, more-efficient format that uses 24-bytes per record -# with no filler space. -# - use xxd -c24 < .rev_map.$UUID to view and debug -# - This is a one-way migration, repositories updated to the -# new format will not be able to use old git-svn without -# rebuilding the .rev_db. Rebuilding the rev_db is not -# possible if noMetadata or useSvmProps are set; but should -# be no problem for users that use the (sensible) defaults. -use strict; -use warnings; -use Carp qw/croak/; -use File::Path qw/mkpath/; -use File::Basename qw/dirname basename/; -use vars qw/$_minimize/; - -sub migrate_from_v0 { - my $git_dir = $ENV{GIT_DIR}; - return undef unless -d $git_dir; - my ($fh, $ctx) = command_output_pipe(qw/rev-parse --symbolic --all/); - my $migrated = 0; - while (<$fh>) { - chomp; - my ($id, $orig_ref) = ($_, $_); - next unless $id =~ s#^refs/heads/(.+)-HEAD$#$1#; - next unless -f "$git_dir/$id/info/url"; - my $new_ref = "refs/remotes/$id"; - if (::verify_ref("$new_ref^0")) { - print STDERR "W: $orig_ref is probably an old ", - "branch used by an ancient version of ", - "git-svn.\n", - "However, $new_ref also exists.\n", - "We will not be able ", - "to use this branch until this ", - "ambiguity is resolved.\n"; - next; - } - print STDERR "Migrating from v0 layout...\n" if !$migrated; - print STDERR "Renaming ref: $orig_ref => $new_ref\n"; - command_noisy('update-ref', $new_ref, $orig_ref); - command_noisy('update-ref', '-d', $orig_ref, $orig_ref); - $migrated++; - } - command_close_pipe($fh, $ctx); - print STDERR "Done migrating from v0 layout...\n" if $migrated; - $migrated; -} - -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"; - - # just in case somebody used 'svn' as their $id at some point... - return $migrated if -d $svn_dir && ! -f "$svn_dir/info/url"; - - print STDERR "Migrating from a git-svn v1 layout...\n"; - mkpath([$svn_dir]); - print STDERR "Data from a previous version of git-svn exists, but\n\t", - "$svn_dir\n\t(required for this version ", - "($::VERSION) of git-svn) does not exist.\n"; - my ($fh, $ctx) = command_output_pipe(qw/rev-parse --symbolic --all/); - while (<$fh>) { - 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") }; - next unless $u; - my $dn = dirname("$git_dir/svn/$x"); - mkpath([$dn]) unless -d $dn; - if ($x eq 'svn') { # they used 'svn' as GIT_SVN_ID: - mkpath(["$git_dir/svn/svn"]); - print STDERR " - $git_dir/$x/info => ", - "$git_dir/svn/$x/info\n"; - rename "$git_dir/$x/info", "$git_dir/svn/$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"; - } - } else { - print STDERR " - $git_dir/$x => $git_dir/svn/$x\n"; - rename "$git_dir/$x", "$git_dir/svn/$x" or - croak "$!: $x"; - } - $migrated++; - } - command_close_pipe($fh, $ctx); - print STDERR "Done migrating from a git-svn v1 layout\n"; - $migrated; -} - -sub read_old_urls { - my ($l_map, $pfx, $path) = @_; - my @dir; - foreach (<$path/*>) { - if (-r "$_/info/url") { - $pfx .= '/' if $pfx && $pfx !~ m!/$!; - my $ref_id = $pfx . basename $_; - my $url = ::file_to_s("$_/info/url"); - $l_map->{$ref_id} = $url; - } elsif (-d $_) { - push @dir, $_; - } - } - foreach (@dir) { - my $x = $_; - $x =~ s!^\Q$ENV{GIT_DIR}\E/svn/!!o; - read_old_urls($l_map, $x, $_); - } -} - -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"); - my $migrated = 0; - - foreach my $ref_id (sort keys %l_map) { - eval { Git::SVN->init($l_map{$ref_id}, '', undef, $ref_id) }; - if ($@) { - Git::SVN->init($l_map{$ref_id}, '', $ref_id, $ref_id); - } - $migrated++; - } - $migrated; -} - -sub minimize_connections { - my $r = Git::SVN::read_all_remotes(); - my $new_urls = {}; - my $root_repos = {}; - foreach my $repo_id (keys %$r) { - my $url = $r->{$repo_id}->{url} or next; - my $fetch = $r->{$repo_id}->{fetch} or next; - my $ra = Git::SVN::Ra->new($url); - - # skip existing cases where we already connect to the root - if (($ra->{url} eq $ra->{repos_root}) || - ($ra->{repos_root} eq $repo_id)) { - $root_repos->{$ra->{url}} = $repo_id; - next; - } - - my $root_ra = Git::SVN::Ra->new($ra->{repos_root}); - my $root_path = $ra->{url}; - $root_path =~ s#^\Q$ra->{repos_root}\E(/|$)##; - foreach my $path (keys %$fetch) { - my $ref_id = $fetch->{$path}; - my $gs = Git::SVN->new($ref_id, $repo_id, $path); - - # make sure we can read when connecting to - # a higher level of a repository - my ($last_rev, undef) = $gs->last_rev_commit; - if (!defined $last_rev) { - $last_rev = eval { - $root_ra->get_latest_revnum; - }; - next if $@; - } - my $new = $root_path; - $new .= length $path ? "/$path" : ''; - eval { - $root_ra->get_log([$new], $last_rev, $last_rev, - 0, 0, 1, sub { }); - }; - next if $@; - $new_urls->{$ra->{repos_root}}->{$new} = - { ref_id => $ref_id, - old_repo_id => $repo_id, - old_path => $path }; - } - } - - my @emptied; - foreach my $url (keys %$new_urls) { - # see if we can re-use an existing [svn-remote "repo_id"] - # instead of creating a(n ugly) new section: - my $repo_id = $root_repos->{$url} || $url; - - my $fetch = $new_urls->{$url}; - foreach my $path (keys %$fetch) { - my $x = $fetch->{$path}; - Git::SVN->init($url, $path, $repo_id, $x->{ref_id}); - my $pfx = "svn-remote.$x->{old_repo_id}"; - - my $old_fetch = quotemeta("$x->{old_path}:". - "$x->{ref_id}"); - command_noisy(qw/config --unset/, - "$pfx.fetch", '^'. $old_fetch . '$'); - delete $r->{$x->{old_repo_id}}-> - {fetch}->{$x->{old_path}}; - if (!keys %{$r->{$x->{old_repo_id}}->{fetch}}) { - command_noisy(qw/config --unset/, - "$pfx.url"); - push @emptied, $x->{old_repo_id} - } - } - } - if (@emptied) { - my $file = $ENV{GIT_CONFIG} || "$ENV{GIT_DIR}/config"; - print STDERR <<EOF; -The following [svn-remote] sections in your config file ($file) are empty -and can be safely removed: -EOF - print STDERR "[svn-remote \"$_\"]\n" foreach @emptied; - } -} - -sub migration_check { - migrate_from_v0(); - migrate_from_v1(); - migrate_from_v2(); - minimize_connections() if $_minimize; -} - -package Git::IndexInfo; -use strict; -use warnings; -use Git qw/command_input_pipe command_close_pipe/; - -sub new { - my ($class) = @_; - my ($gui, $ctx) = command_input_pipe(qw/update-index -z --index-info/); - bless { gui => $gui, ctx => $ctx, nr => 0}, $class; -} - -sub remove { - my ($self, $path) = @_; - if (print { $self->{gui} } '0 ', 0 x 40, "\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}); -} - -package Git::SVN::GlobSpec; -use strict; -use warnings; - -sub new { - my ($class, $glob, $pattern_ok) = @_; - my $re = $glob; - $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"; - for my $part (split(m|/|, $glob)) { - if ($part =~ /\*/ && $part ne "*") { - die "Invalid pattern in '$glob': $part\n"; - } elsif ($pattern_ok && $part =~ /[{}]/ && - $part !~ /^\{[^{}]+\}/) { - die "Invalid pattern in '$glob': $part\n"; - } - if ($part eq "*") { - die $die_msg if $state eq "right"; - $state = "pattern"; - push(@patterns, "[^/]*"); - } elsif ($pattern_ok && $part =~ /^\{(.*)\}$/) { - die $die_msg if $state eq "right"; - $state = "pattern"; - my $p = quotemeta($1); - $p =~ s/\\,/|/g; - push(@patterns, "(?:$p)"); - } else { - if ($state eq "left") { - push(@left, $part); - } else { - push(@right, $part); - $state = "right"; - } - } - } - my $depth = @patterns; - if ($depth == 0) { - die "One '*' is needed in glob: '$glob'\n"; - } - my $left = join('/', @left); - my $right = join('/', @right); - $re = join('/', @patterns); - $re = join('\/', - grep(length, quotemeta($left), "($re)", quotemeta($right))); - my $left_re = qr/^\/\Q$left\E(\/|$)/; - bless { left => $left, right => $right, left_regex => $left_re, - regex => qr/$re/, glob => $glob, depth => $depth }, $class; -} - -sub full_path { - my ($self, $path) = @_; - return (length $self->{left} ? "$self->{left}/" : '') . - $path . (length $self->{right} ? "/$self->{right}" : ''); -} - __END__ Data structures: diff --git a/perl/Git/IndexInfo.pm b/perl/Git/IndexInfo.pm new file mode 100644 index 000000000..a43108c98 --- /dev/null +++ b/perl/Git/IndexInfo.pm @@ -0,0 +1,33 @@ +package Git::IndexInfo; +use strict; +use warnings; +use Git qw/command_input_pipe command_close_pipe/; + +sub new { + my ($class) = @_; + my ($gui, $ctx) = command_input_pipe(qw/update-index -z --index-info/); + bless { gui => $gui, ctx => $ctx, nr => 0}, $class; +} + +sub remove { + my ($self, $path) = @_; + if (print { $self->{gui} } '0 ', 0 x 40, "\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; diff --git a/perl/Git/SVN.pm b/perl/Git/SVN.pm index 2e0d7f037..b8b34744e 100644 --- a/perl/Git/SVN.pm +++ b/perl/Git/SVN.pm @@ -207,6 +207,8 @@ sub read_all_remotes { . "must start with 'refs/'\n") unless $remote_ref =~ m{^refs/}; $local_ref = uri_decode($local_ref); + + require Git::SVN::GlobSpec; my $rs = { t => $t, remote => $remote, diff --git a/perl/Git/SVN/Fetcher.pm b/perl/Git/SVN/Fetcher.pm index ef8e9ed2a..76fae9bce 100644 --- a/perl/Git/SVN/Fetcher.pm +++ b/perl/Git/SVN/Fetcher.pm @@ -57,6 +57,7 @@ sub new { $self->{file_prop} = {}; $self->{absent_dir} = {}; $self->{absent_file} = {}; + require Git::IndexInfo; $self->{gii} = $git_svn->tmp_index_do(sub { Git::IndexInfo->new }); $self->{pathnameencoding} = Git::config('svn.pathnameencoding'); $self; diff --git a/perl/Git/SVN/GlobSpec.pm b/perl/Git/SVN/GlobSpec.pm new file mode 100644 index 000000000..96cfd9896 --- /dev/null +++ b/perl/Git/SVN/GlobSpec.pm @@ -0,0 +1,59 @@ +package Git::SVN::GlobSpec; +use strict; +use warnings; + +sub new { + my ($class, $glob, $pattern_ok) = @_; + my $re = $glob; + $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"; + for my $part (split(m|/|, $glob)) { + if ($part =~ /\*/ && $part ne "*") { + die "Invalid pattern in '$glob': $part\n"; + } elsif ($pattern_ok && $part =~ /[{}]/ && + $part !~ /^\{[^{}]+\}/) { + die "Invalid pattern in '$glob': $part\n"; + } + if ($part eq "*") { + die $die_msg if $state eq "right"; + $state = "pattern"; + push(@patterns, "[^/]*"); + } elsif ($pattern_ok && $part =~ /^\{(.*)\}$/) { + die $die_msg if $state eq "right"; + $state = "pattern"; + my $p = quotemeta($1); + $p =~ s/\\,/|/g; + push(@patterns, "(?:$p)"); + } else { + if ($state eq "left") { + push(@left, $part); + } else { + push(@right, $part); + $state = "right"; + } + } + } + my $depth = @patterns; + if ($depth == 0) { + die "One '*' is needed in glob: '$glob'\n"; + } + my $left = join('/', @left); + my $right = join('/', @right); + $re = join('/', @patterns); + $re = join('\/', + grep(length, quotemeta($left), "($re)", quotemeta($right))); + my $left_re = qr/^\/\Q$left\E(\/|$)/; + bless { left => $left, right => $right, left_regex => $left_re, + regex => qr/$re/, glob => $glob, depth => $depth }, $class; +} + +sub full_path { + my ($self, $path) = @_; + return (length $self->{left} ? "$self->{left}/" : '') . + $path . (length $self->{right} ? "/$self->{right}" : ''); +} + +1; diff --git a/perl/Git/SVN/Log.pm b/perl/Git/SVN/Log.pm new file mode 100644 index 000000000..3cc1c6f08 --- /dev/null +++ b/perl/Git/SVN/Log.pm @@ -0,0 +1,395 @@ +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 POSIX qw/strftime/; +use constant commit_log_separator => ('-' x 72) . "\n"; +use vars qw/$TZ $limit $color $pager $non_recursive $verbose $oneline + %rusers $show_commit $incremental/; + +# Option set in git-svn +our $_git_format; + +sub cmt_showable { + my ($c) = @_; + return 1 if defined $c->{r}; + + # big commit message got truncated by the 16k pretty buffer in rev-list + if ($c->{l} && $c->{l}->[-1] eq "...\n" && + $c->{a_raw} =~ /\@([a-f\d\-]+)>$/) { + @{$c->{l}} = (); + my @log = command(qw/cat-file commit/, $c->{c}); + + # shift off the headers + shift @log while ($log[0] ne ''); + shift @log; + + # TODO: make $c->{l} not have a trailing newline in the future + @{$c->{l}} = map { "$_\n" } grep !/^git-svn-id: /, @log; + + (undef, $c->{r}, undef) = ::extract_metadata( + (grep(/^git-svn-id: /, @log))[-1]); + } + return defined $c->{r}; +} + +sub log_use_color { + return $color || Git->repository->get_colorbool('color.diff'); +} + +sub git_svn_log_cmd { + my ($r_min, $r_max, @args) = @_; + my $head = 'HEAD'; + my (@files, @log_opts); + foreach my $x (@args) { + if ($x eq '--' || @files) { + push @files, $x; + } else { + if (::verify_ref("$x^0")) { + $head = $x; + } else { + push @log_opts, $x; + } + } + } + + my ($url, $rev, $uuid, $gs) = ::working_head_info($head); + + require Git::SVN; + $gs ||= Git::SVN->_new; + my @cmd = (qw/log --abbrev-commit --pretty=raw --default/, + $gs->refname); + push @cmd, '-r' unless $non_recursive; + push @cmd, qw/--raw --name-status/ if $verbose; + push @cmd, '--color' if log_use_color(); + push @cmd, @log_opts; + if (defined $r_max && $r_max == $r_min) { + push @cmd, '--max-count=1'; + if (my $c = $gs->rev_map_get($r_max)) { + push @cmd, $c; + } + } elsif (defined $r_max) { + if ($r_max < $r_min) { + ($r_min, $r_max) = ($r_max, $r_min); + } + my (undef, $c_max) = $gs->find_rev_before($r_max, 1, $r_min); + my (undef, $c_min) = $gs->find_rev_after($r_min, 1, $r_max); + # If there are no commits in the range, both $c_max and $c_min + # will be undefined. If there is at least 1 commit in the + # range, both will be defined. + return () if !defined $c_min || !defined $c_max; + if ($c_min eq $c_max) { + push @cmd, '--max-count=1', $c_min; + } else { + push @cmd, '--boundary', "$c_min..$c_max"; + } + } + return (@cmd, @files); +} + +# adapted from pager.c +sub config_pager { + if (! -t *STDOUT) { + $ENV{GIT_PAGER_IN_USE} = 'false'; + $pager = undef; + return; + } + chomp($pager = command_oneline(qw(var GIT_PAGER))); + if ($pager eq 'cat') { + $pager = undef; + } + $ENV{GIT_PAGER_IN_USE} = defined($pager); +} + +sub run_pager { + return unless defined $pager; + pipe my ($rfd, $wfd) or return; + defined(my $pid = fork) or fatal "Can't fork: $!"; + if (!$pid) { + open STDOUT, '>&', $wfd or + fatal "Can't redirect to stdout: $!"; + return; + } + open STDIN, '<&', $rfd or fatal "Can't redirect stdin: $!"; + $ENV{LESS} ||= 'FRSX'; + 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); + return strftime("%Y-%m-%d %H:%M:%S $gmoff (%a, %d %b %Y)", localtime($t)); +} + +sub parse_git_date { + my ($t, $tz) = @_; + # Date::Parse isn't in the standard Perl distro :( + if ($tz =~ s/^\+//) { + $t += tz_to_s_offset($tz); + } elsif ($tz =~ s/^\-//) { + $t -= tz_to_s_offset($tz); + } + return $t; +} + +sub set_local_timezone { + if (defined $TZ) { + $ENV{TZ} = $TZ; + } else { + delete $ENV{TZ}; + } +} + +sub tz_to_s_offset { + my ($tz) = @_; + $tz =~ s/(\d\d)$//; + return ($1 * 60) + ($tz * 3600); +} + +sub get_author_info { + my ($dest, $author, $t, $tz) = @_; + $author =~ s/(?:^\s*|\s*$)//g; + $dest->{a_raw} = $author; + my $au; + if ($::_authors) { + $au = $rusers{$author} || undef; + } + if (!$au) { + ($au) = ($author =~ /<([^>]+)\@[^>]+>$/); + } + $dest->{t} = $t; + $dest->{tz} = $tz; + $dest->{a} = $au; + $dest->{t_utc} = parse_git_date($t, $tz); +} + +sub process_commit { + my ($c, $r_min, $r_max, $defer) = @_; + if (defined $r_min && defined $r_max) { + if ($r_min == $c->{r} && $r_min == $r_max) { + show_commit($c); + return 0; + } + return 1 if $r_min == $r_max; + if ($r_min < $r_max) { + # we need to reverse the print order + return 0 if (defined $limit && --$limit < 0); + push @$defer, $c; + return 1; + } + if ($r_min != $r_max) { + return 1 if ($r_min < $c->{r}); + return 1 if ($r_max > $c->{r}); + } + } + return 0 if (defined $limit && --$limit < 0); + show_commit($c); + return 1; +} + +my $l_fmt; +sub show_commit { + my $c = shift; + if ($oneline) { + my $x = "\n"; + if (my $l = $c->{l}) { + while ($l->[0] =~ /^\s*$/) { shift @$l } + $x = $l->[0]; + } + $l_fmt ||= 'A' . length($c->{r}); + print 'r',pack($l_fmt, $c->{r}),' | '; + print "$c->{c} | " if $show_commit; + print $x; + } else { + show_commit_normal($c); + } +} + +sub show_commit_changed_paths { + my ($c) = @_; + return unless $c->{changed}; + print "Changed paths:\n", @{$c->{changed}}; +} + +sub show_commit_normal { + my ($c) = @_; + print commit_log_separator, "r$c->{r} | "; + print "$c->{c} | " if $show_commit; + print "$c->{a} | ", format_svn_date($c->{t_utc}), ' | '; + my $nr_line = 0; + + if (my $l = $c->{l}) { + while ($l->[$#$l] eq "\n" && $#$l > 0 + && $l->[($#$l - 1)] eq "\n") { + pop @$l; + } + $nr_line = scalar @$l; + if (!$nr_line) { + print "1 line\n\n\n"; + } else { + if ($nr_line == 1) { + $nr_line = '1 line'; + } else { + $nr_line .= ' lines'; + } + print $nr_line, "\n"; + show_commit_changed_paths($c); + print "\n"; + print $_ foreach @$l; + } + } else { + print "1 line\n"; + show_commit_changed_paths($c); + print "\n"; + + } + foreach my $x (qw/raw stat diff/) { + if ($c->{$x}) { + print "\n"; + print $_ foreach @{$c->{$x}} + } + } +} + +sub cmd_show_log { + my (@args) = @_; + my ($r_min, $r_max); + my $r_last = -1; # prevent dupes + set_local_timezone(); + if (defined $::_revision) { + if ($::_revision =~ /^(\d+):(\d+)$/) { + ($r_min, $r_max) = ($1, $2); + } elsif ($::_revision =~ /^\d+$/) { + $r_min = $r_max = $::_revision; + } else { + fatal "-r$::_revision is not supported, use ", + "standard 'git log' arguments instead"; + } + } + + config_pager(); + @args = git_svn_log_cmd($r_min, $r_max, @args); + if (!@args) { + print commit_log_separator unless $incremental || $oneline; + return; + } + my $log = command_output_pipe(@args); + run_pager(); + my (@k, $c, $d, $stat); + my $esc_color = qr/(?:\033\[(?:(?:\d+;)*\d*)?m)*/; + while (<$log>) { + if (/^${esc_color}commit (?:- )?($::sha1_short)/o) { + my $cmt = $1; + if ($c && cmt_showable($c) && $c->{r} != $r_last) { + $r_last = $c->{r}; + process_commit($c, $r_min, $r_max, \@k) or + goto out; + } + $d = undef; + $c = { c => $cmt }; + } elsif (/^${esc_color}author (.+) (\d+) ([\-\+]?\d+)$/o) { + get_author_info($c, $1, $2, $3); + } elsif (/^${esc_color}(?:tree|parent|committer) /o) { + # ignore + } elsif (/^${esc_color}:\d{6} \d{6} $::sha1_short/o) { + push @{$c->{raw}}, $_; + } elsif (/^${esc_color}[ACRMDT]\t/) { + # we could add $SVN->{svn_path} here, but that requires + # remote access at the moment (repo_path_split)... + s#^(${esc_color})([ACRMDT])\t#$1 $2 #o; + push @{$c->{changed}}, $_; + } elsif (/^${esc_color}diff /o) { + $d = 1; + push @{$c->{diff}}, $_; + } elsif ($d) { + push @{$c->{diff}}, $_; + } elsif (/^\ .+\ \|\s*\d+\ $esc_color[\+\-]* + $esc_color*[\+\-]*$esc_color$/x) { + $stat = 1; + push @{$c->{stat}}, $_; + } elsif ($stat && /^ \d+ files changed, \d+ insertions/) { + push @{$c->{stat}}, $_; + $stat = undef; + } elsif (/^${esc_color} (git-svn-id:.+)$/o) { + ($c->{url}, $c->{r}, undef) = ::extract_metadata($1); + } elsif (s/^${esc_color} //o) { + push @{$c->{l}}, $_; + } + } + if ($c && defined $c->{r} && $c->{r} != $r_last) { + $r_last = $c->{r}; + process_commit($c, $r_min, $r_max, \@k); + } + if (@k) { + ($r_min, $r_max) = ($r_max, $r_min); + process_commit($_, $r_min, $r_max) foreach reverse @k; + } +out: + close $log; + print commit_log_separator unless $incremental || $oneline; +} + +sub cmd_blame { + my $path = pop; + + config_pager(); + run_pager(); + + my ($fh, $ctx, $rev); + + if ($_git_format) { + ($fh, $ctx) = command_output_pipe('blame', @_, $path); + while (my $line = <$fh>) { + if ($line =~ /^\^?([[:xdigit:]]+)\s/) { + # Uncommitted edits show up as a rev ID of + # all zeros, which we can't look up with + # cmt_metadata + if ($1 !~ /^0+$/) { + (undef, $rev, undef) = + ::cmt_metadata($1); + $rev = '0' if (!$rev); + } else { + $rev = '0'; + } + $rev = sprintf('%-10s', $rev); + $line =~ s/^\^?[[:xdigit:]]+(\s)/$rev$1/; + } + print $line; + } + } else { + ($fh, $ctx) = command_output_pipe('blame', '-p', @_, 'HEAD', + '--', $path); + my ($sha1); + my %authors; + my @buffer; + my %dsha; #distinct sha keys + + while (my $line = <$fh>) { + push @buffer, $line; + if ($line =~ /^([[:xdigit:]]{40})\s\d+\s\d+/) { + $dsha{$1} = 1; + } + } + + my $s2r = ::cmt_sha2rev_batch([keys %dsha]); + + foreach my $line (@buffer) { + if ($line =~ /^([[:xdigit:]]{40})\s\d+\s\d+/) { + $rev = $s2r->{$1}; + $rev = '0' if (!$rev) + } + elsif ($line =~ /^author (.*)/) { + $authors{$rev} = $1; + $authors{$rev} =~ s/\s/_/g; + } + elsif ($line =~ /^\t(.*)$/) { + printf("%6s %10s %s\n", $rev, $authors{$rev}, $1); + } + } + } + command_close_pipe($fh, $ctx); +} + +1; diff --git a/perl/Git/SVN/Migration.pm b/perl/Git/SVN/Migration.pm new file mode 100644 index 000000000..75d74298e --- /dev/null +++ b/perl/Git/SVN/Migration.pm @@ -0,0 +1,258 @@ +package Git::SVN::Migration; +# these version numbers do NOT correspond to actual version numbers +# of git nor git-svn. They are just relative. +# +# v0 layout: .git/$id/info/url, refs/heads/$id-HEAD +# +# v1 layout: .git/$id/info/url, refs/remotes/$id +# +# v2 layout: .git/svn/$id/info/url, refs/remotes/$id +# +# v3 layout: .git/svn/$id, refs/remotes/$id +# - info/url may remain for backwards compatibility +# - this is what we migrate up to this layout automatically, +# - this will be used by git svn init on single branches +# v3.1 layout (auto migrated): +# - .rev_db => .rev_db.$UUID, .rev_db will remain as a symlink +# for backwards compatibility +# +# v4 layout: .git/svn/$repo_id/$id, refs/remotes/$repo_id/$id +# - this is only created for newly multi-init-ed +# repositories. Similar in spirit to the +# --use-separate-remotes option in git-clone (now default) +# - we do not automatically migrate to this (following +# the example set by core git) +# +# v5 layout: .rev_db.$UUID => .rev_map.$UUID +# - newer, more-efficient format that uses 24-bytes per record +# with no filler space. +# - use xxd -c24 < .rev_map.$UUID to view and debug +# - This is a one-way migration, repositories updated to the +# new format will not be able to use old git-svn without +# rebuilding the .rev_db. Rebuilding the rev_db is not +# possible if noMetadata or useSvmProps are set; but should +# be no problem for users that use the (sensible) defaults. +use strict; +use warnings; +use Carp qw/croak/; +use File::Path qw/mkpath/; +use File::Basename qw/dirname basename/; + +our $_minimize; +use Git qw( + command + command_noisy + command_output_pipe + command_close_pipe +); + +sub migrate_from_v0 { + my $git_dir = $ENV{GIT_DIR}; + return undef unless -d $git_dir; + my ($fh, $ctx) = command_output_pipe(qw/rev-parse --symbolic --all/); + my $migrated = 0; + while (<$fh>) { + chomp; + my ($id, $orig_ref) = ($_, $_); + next unless $id =~ s#^refs/heads/(.+)-HEAD$#$1#; + next unless -f "$git_dir/$id/info/url"; + my $new_ref = "refs/remotes/$id"; + if (::verify_ref("$new_ref^0")) { + print STDERR "W: $orig_ref is probably an old ", + "branch used by an ancient version of ", + "git-svn.\n", + "However, $new_ref also exists.\n", + "We will not be able ", + "to use this branch until this ", + "ambiguity is resolved.\n"; + next; + } + print STDERR "Migrating from v0 layout...\n" if !$migrated; + print STDERR "Renaming ref: $orig_ref => $new_ref\n"; + command_noisy('update-ref', $new_ref, $orig_ref); + command_noisy('update-ref', '-d', $orig_ref, $orig_ref); + $migrated++; + } + command_close_pipe($fh, $ctx); + print STDERR "Done migrating from v0 layout...\n" if $migrated; + $migrated; +} + +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"; + + # just in case somebody used 'svn' as their $id at some point... + return $migrated if -d $svn_dir && ! -f "$svn_dir/info/url"; + + print STDERR "Migrating from a git-svn v1 layout...\n"; + mkpath([$svn_dir]); + print STDERR "Data from a previous version of git-svn exists, but\n\t", + "$svn_dir\n\t(required for this version ", + "($::VERSION) of git-svn) does not exist.\n"; + my ($fh, $ctx) = command_output_pipe(qw/rev-parse --symbolic --all/); + while (<$fh>) { + 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") }; + next unless $u; + my $dn = dirname("$git_dir/svn/$x"); + mkpath([$dn]) unless -d $dn; + if ($x eq 'svn') { # they used 'svn' as GIT_SVN_ID: + mkpath(["$git_dir/svn/svn"]); + print STDERR " - $git_dir/$x/info => ", + "$git_dir/svn/$x/info\n"; + rename "$git_dir/$x/info", "$git_dir/svn/$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"; + } + } else { + print STDERR " - $git_dir/$x => $git_dir/svn/$x\n"; + rename "$git_dir/$x", "$git_dir/svn/$x" or + croak "$!: $x"; + } + $migrated++; + } + command_close_pipe($fh, $ctx); + print STDERR "Done migrating from a git-svn v1 layout\n"; + $migrated; +} + +sub read_old_urls { + my ($l_map, $pfx, $path) = @_; + my @dir; + foreach (<$path/*>) { + if (-r "$_/info/url") { + $pfx .= '/' if $pfx && $pfx !~ m!/$!; + my $ref_id = $pfx . basename $_; + my $url = ::file_to_s("$_/info/url"); + $l_map->{$ref_id} = $url; + } elsif (-d $_) { + push @dir, $_; + } + } + foreach (@dir) { + my $x = $_; + $x =~ s!^\Q$ENV{GIT_DIR}\E/svn/!!o; + read_old_urls($l_map, $x, $_); + } +} + +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"); + my $migrated = 0; + + require Git::SVN; + foreach my $ref_id (sort keys %l_map) { + eval { Git::SVN->init($l_map{$ref_id}, '', undef, $ref_id) }; + if ($@) { + Git::SVN->init($l_map{$ref_id}, '', $ref_id, $ref_id); + } + $migrated++; + } + $migrated; +} + +sub minimize_connections { + require Git::SVN; + require Git::SVN::Ra; + + my $r = Git::SVN::read_all_remotes(); + my $new_urls = {}; + my $root_repos = {}; + foreach my $repo_id (keys %$r) { + my $url = $r->{$repo_id}->{url} or next; + my $fetch = $r->{$repo_id}->{fetch} or next; + my $ra = Git::SVN::Ra->new($url); + + # skip existing cases where we already connect to the root + if (($ra->{url} eq $ra->{repos_root}) || + ($ra->{repos_root} eq $repo_id)) { + $root_repos->{$ra->{url}} = $repo_id; + next; + } + + my $root_ra = Git::SVN::Ra->new($ra->{repos_root}); + my $root_path = $ra->{url}; + $root_path =~ s#^\Q$ra->{repos_root}\E(/|$)##; + foreach my $path (keys %$fetch) { + my $ref_id = $fetch->{$path}; + my $gs = Git::SVN->new($ref_id, $repo_id, $path); + + # make sure we can read when connecting to + # a higher level of a repository + my ($last_rev, undef) = $gs->last_rev_commit; + if (!defined $last_rev) { + $last_rev = eval { + $root_ra->get_latest_revnum; + }; + next if $@; + } + my $new = $root_path; + $new .= length $path ? "/$path" : ''; + eval { + $root_ra->get_log([$new], $last_rev, $last_rev, + 0, 0, 1, sub { }); + }; + next if $@; + $new_urls->{$ra->{repos_root}}->{$new} = + { ref_id => $ref_id, + old_repo_id => $repo_id, + old_path => $path }; + } + } + + my @emptied; + foreach my $url (keys %$new_urls) { + # see if we can re-use an existing [svn-remote "repo_id"] + # instead of creating a(n ugly) new section: + my $repo_id = $root_repos->{$url} || $url; + + my $fetch = $new_urls->{$url}; + foreach my $path (keys %$fetch) { + my $x = $fetch->{$path}; + Git::SVN->init($url, $path, $repo_id, $x->{ref_id}); + my $pfx = "svn-remote.$x->{old_repo_id}"; + + my $old_fetch = quotemeta("$x->{old_path}:". + "$x->{ref_id}"); + command_noisy(qw/config --unset/, + "$pfx.fetch", '^'. $old_fetch . '$'); + delete $r->{$x->{old_repo_id}}-> + {fetch}->{$x->{old_path}}; + if (!keys %{$r->{$x->{old_repo_id}}->{fetch}}) { + command_noisy(qw/config --unset/, + "$pfx.url"); + push @emptied, $x->{old_repo_id} + } + } + } + if (@emptied) { + my $file = $ENV{GIT_CONFIG} || "$ENV{GIT_DIR}/config"; + print STDERR <<EOF; +The following [svn-remote] sections in your config file ($file) are empty +and can be safely removed: +EOF + print STDERR "[svn-remote \"$_\"]\n" foreach @emptied; + } +} + +sub migration_check { + migrate_from_v0(); + migrate_from_v1(); + migrate_from_v2(); + minimize_connections() if $_minimize; +} + +1; diff --git a/perl/Makefile b/perl/Makefile index a628582bc..15d96fcc7 100644 --- a/perl/Makefile +++ b/perl/Makefile @@ -29,10 +29,14 @@ instdir_SQ = $(subst ','\'',$(prefix)/lib) modules += Git modules += Git/I18N +modules += Git/IndexInfo modules += Git/SVN modules += Git/SVN/Memoize/YAML modules += Git/SVN/Fetcher modules += Git/SVN/Editor +modules += Git/SVN/GlobSpec +modules += Git/SVN/Log +modules += Git/SVN/Migration modules += Git/SVN/Prompt modules += Git/SVN/Ra modules += Git/SVN/Utils diff --git a/t/Git-SVN/00compile.t b/t/Git-SVN/00compile.t index 97475d920..c92fee453 100644 --- a/t/Git-SVN/00compile.t +++ b/t/Git-SVN/00compile.t @@ -3,7 +3,12 @@ use strict; use warnings; -use Test::More tests => 2; +use Test::More tests => 7; -require_ok 'Git::SVN::Utils'; require_ok 'Git::SVN'; +require_ok 'Git::SVN::Utils'; +require_ok 'Git::SVN::Ra'; +require_ok 'Git::SVN::Log'; +require_ok 'Git::SVN::Migration'; +require_ok 'Git::IndexInfo'; +require_ok 'Git::SVN::GlobSpec'; |