Add missing -z to git check-attr usage text for consistency with man page
[git.git] / git-svn.perl
index 15e5f3c0feda0dc362322662b8e1f042c6afa4f6..828b8f0c8e6de81593db108495565e591cd91363 100755 (executable)
@@ -10,9 +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 {
@@ -66,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),
-                       __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,
@@ -777,6 +777,44 @@ sub populate_merge_info {
        return undef;
 }
 
+sub dcommit_rebase {
+       my ($is_last, $current, $fetched_ref, $svn_error) = @_;
+       my @diff;
+
+       if ($svn_error) {
+               print STDERR "\nERROR from SVN:\n",
+                               $svn_error->expanded_message, "\n";
+       }
+       unless ($_no_rebase) {
+               # we always want to rebase against the current HEAD,
+               # not any head that was passed to us
+               @diff = command('diff-tree', $current,
+                          $fetched_ref, '--');
+               my @finish;
+               if (@diff) {
+                       @finish = rebase_cmd();
+                       print STDERR "W: $current and ", $fetched_ref,
+                                    " differ, using @finish:\n",
+                                    join("\n", @diff), "\n";
+               } elsif ($is_last) {
+                       print "No changes between ", $current, " and ",
+                             $fetched_ref,
+                             "\nResetting to the latest ",
+                             $fetched_ref, "\n";
+                       @finish = qw/reset --mixed/;
+               }
+               command_noisy(@finish, $fetched_ref) if @finish;
+       }
+       if ($svn_error) {
+               die "ERROR: Not all changes have been committed into SVN"
+                       .($_no_rebase ? ".\n" : ", however the committed\n"
+                       ."ones (if any) seem to be successfully integrated "
+                       ."into the working tree.\n")
+                       ."Please see the above messages for details.\n";
+       }
+       return @diff;
+}
+
 sub cmd_dcommit {
        my $head = shift;
        command_noisy(qw/update-index --refresh/);
@@ -904,6 +942,7 @@ sub cmd_dcommit {
        }
 
        my $rewritten_parent;
+       my $current_head = command_oneline(qw/rev-parse HEAD/);
        Git::SVN::remove_username($expect_url);
        if (defined($_merge_info)) {
                $_merge_info =~ tr{ }{\n};
@@ -943,6 +982,14 @@ sub cmd_dcommit {
                                        },
                                        mergeinfo => $_merge_info,
                                        svn_path => '');
+
+                       my $err_handler = $SVN::Error::handler;
+                       $SVN::Error::handler = sub {
+                               my $err = shift;
+                               dcommit_rebase(1, $current_head, $gs->refname,
+                                       $err);
+                       };
+
                        if (!Git::SVN::Editor->new(\%ed_opts)->apply_diff) {
                                print "No changes\n$d~1 == $d\n";
                        } elsif ($parents->{$d} && @{$parents->{$d}}) {
@@ -950,31 +997,19 @@ sub cmd_dcommit {
                                                               $parents->{$d};
                        }
                        $_fetch_all ? $gs->fetch_all : $gs->fetch;
+                       $SVN::Error::handler = $err_handler;
                        $last_rev = $cmt_rev;
                        next if $_no_rebase;
 
-                       # we always want to rebase against the current HEAD,
-                       # not any head that was passed to us
-                       my @diff = command('diff-tree', $d,
-                                          $gs->refname, '--');
-                       my @finish;
-                       if (@diff) {
-                               @finish = rebase_cmd();
-                               print STDERR "W: $d and ", $gs->refname,
-                                            " differ, using @finish:\n",
-                                            join("\n", @diff), "\n";
-                       } else {
-                               print "No changes between current HEAD and ",
-                                     $gs->refname,
-                                     "\nResetting to the latest ",
-                                     $gs->refname, "\n";
-                               @finish = qw/reset --mixed/;
-                       }
-                       command_noisy(@finish, $gs->refname);
+                       my @diff = dcommit_rebase(@$linear_refs == 0, $d,
+                                               $gs->refname, undef);
 
-                       $rewritten_parent = command_oneline(qw/rev-parse HEAD/);
+                       $rewritten_parent = command_oneline(qw/rev-parse/,
+                                                       $gs->refname);
 
                        if (@diff) {
+                               $current_head = command_oneline(qw/rev-parse
+                                                               HEAD/);
                                @refs = ();
                                my ($url_, $rev_, $uuid_, $gs_) =
                                              working_head_info('HEAD', \@refs);
@@ -1019,6 +1054,7 @@ sub cmd_dcommit {
                                }
                                $parents = \%p;
                                $linear_refs = \@l;
+                               undef $last_rev;
                        }
                }
        }
@@ -2039,343 +2075,6 @@ sub gc_directory {
        }
 }
 
-
-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: