]> git.ipfire.org Git - thirdparty/git.git/blobdiff - git-svn.perl
Don't fflush(stdout) when it's not helpful
[thirdparty/git.git] / git-svn.perl
index 6657e100fbbc3bd83e805b2440b1a7b61780c5f4..50128d72850714b80a765ad9c5ffa9588b8da505 100755 (executable)
@@ -38,14 +38,16 @@ use IPC::Open3;
 use Git;
 
 BEGIN {
-       my $s;
+       # 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/) {
-               $s .= "*SVN::Git::Editor::$_ = *SVN::Git::Fetcher::$_ = ".
-                     "*Git::SVN::Migration::$_ = ".
-                     "*Git::SVN::Log::$_ = *Git::SVN::$_ = *$_ = *Git::$_; ";
+               for my $package ( qw(SVN::Git::Editor SVN::Git::Fetcher
+                       Git::SVN::Migration Git::SVN::Log Git::SVN),
+                       __PACKAGE__) {
+                       *{"${package}::$_"} = \&{"Git::$_"};
+               }
        }
-       eval $s;
 }
 
 my ($SVN);
@@ -55,7 +57,7 @@ $sha1_short = qr/[a-f\d]{4,40}/;
 my ($_stdin, $_help, $_edit,
        $_message, $_file,
        $_template, $_shared,
-       $_version, $_fetch_all,
+       $_version, $_fetch_all, $_no_rebase,
        $_merge, $_strategy, $_dry_run, $_local,
        $_prefix, $_no_checkout, $_verbose);
 $Git::SVN::_follow_parent = 1;
@@ -80,6 +82,7 @@ my %icv;
 my %init_opts = ( 'template=s' => \$_template, 'shared:s' => \$_shared,
                   'trunk|T=s' => \$_trunk, 'tags|t=s' => \$_tags,
                   'branches|b=s' => \$_branches, 'prefix=s' => \$_prefix,
+                  'minimize-url|m' => \$Git::SVN::_minimize_url,
                  'no-metadata' => sub { $icv{noMetadata} = 1 },
                  'use-svm-props' => sub { $icv{useSvmProps} = 1 },
                  'use-svnsync-props' => sub { $icv{useSvnsyncProps} = 1 },
@@ -114,6 +117,7 @@ my %cmd = (
                          'verbose|v' => \$_verbose,
                          'dry-run|n' => \$_dry_run,
                          'fetch-all|all' => \$_fetch_all,
+                         'no-rebase' => \$_no_rebase,
                        %cmt_opts, %fc_opts } ],
        'set-tree' => [ \&cmd_set_tree,
                        "Set an SVN repository to a git tree-ish",
@@ -392,7 +396,7 @@ sub cmd_dcommit {
                } else {
                        my %ed_opts = ( r => $last_rev,
                                        log => get_commit_entry($d)->{log},
-                                       ra => Git::SVN::Ra->new($url),
+                                       ra => Git::SVN::Ra->new($gs->full_url),
                                        tree_a => "$d~1",
                                        tree_b => $d,
                                        editor_cb => sub {
@@ -413,21 +417,23 @@ sub cmd_dcommit {
                return;
        }
        $_fetch_all ? $gs->fetch_all : $gs->fetch;
-       # we always want to rebase against the current HEAD, not any
-       # head that was passed to us
-       my @diff = command('diff-tree', 'HEAD', $gs->refname, '--');
-       my @finish;
-       if (@diff) {
-               @finish = rebase_cmd();
-               print STDERR "W: HEAD and ", $gs->refname, " differ, ",
-                            "using @finish:\n", "@diff";
-       } else {
-               print "No changes between current HEAD and ",
-                     $gs->refname, "\nResetting to the latest ",
-                     $gs->refname, "\n";
-               @finish = qw/reset --mixed/;
+       unless ($_no_rebase) {
+               # we always want to rebase against the current HEAD, not any
+               # head that was passed to us
+               my @diff = command('diff-tree', 'HEAD', $gs->refname, '--');
+               my @finish;
+               if (@diff) {
+                       @finish = rebase_cmd();
+                       print STDERR "W: HEAD and ", $gs->refname, " differ, ",
+                                    "using @finish:\n", "@diff";
+               } 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);
        }
-       command_noisy(@finish, $gs->refname);
 }
 
 sub cmd_find_rev {
@@ -481,6 +487,11 @@ sub cmd_multi_init {
        unless (defined $_trunk || defined $_branches || defined $_tags) {
                usage(1);
        }
+
+       # there are currently some bugs that prevent multi-init/multi-fetch
+       # setups from working well without this.
+       $Git::SVN::_minimize_url = 1;
+
        $_prefix = '' unless defined $_prefix;
        if (defined $url) {
                $url =~ s#/+$##;
@@ -817,7 +828,7 @@ use strict;
 use warnings;
 use vars qw/$default_repo_id $default_ref_id $_no_metadata $_follow_parent
             $_repack $_repack_flags $_use_svm_props $_head
-            $_use_svnsync_props $no_reuse_existing/;
+            $_use_svnsync_props $no_reuse_existing $_minimize_url/;
 use Carp qw/croak/;
 use File::Path qw/mkpath/;
 use File::Copy qw/copy/;
@@ -837,26 +848,26 @@ BEGIN {
        # some options are read globally, but can be overridden locally
        # per [svn-remote "..."] section.  Command-line options will *NOT*
        # override options set in an [svn-remote "..."] section
-       my $e;
-       foreach (qw/follow_parent no_metadata use_svm_props
-                   use_svnsync_props/) {
-               my $key = $_;
+       no strict 'refs';
+       for my $option (qw/follow_parent no_metadata use_svm_props
+                          use_svnsync_props/) {
+               my $key = $option;
                $key =~ tr/_//d;
-               $e .= "sub $_ {
-                       my (\$self) = \@_;
-                       return \$self->{-$_} if exists \$self->{-$_};
-                       my \$k = \"svn-remote.\$self->{repo_id}\.$key\";
-                       eval { command_oneline(qw/config --get/, \$k) };
-                       if (\$@) {
-                               \$self->{-$_} = \$Git::SVN::_$_;
+               my $prop = "-$option";
+               *$option = sub {
+                       my ($self) = @_;
+                       return $self->{$prop} if exists $self->{$prop};
+                       my $k = "svn-remote.$self->{repo_id}.$key";
+                       eval { command_oneline(qw/config --get/, $k) };
+                       if ($@) {
+                               $self->{$prop} = ${"Git::SVN::_$option"};
                        } else {
-                               my \$v = command_oneline(qw/config --bool/,\$k);
-                               \$self->{-$_} = \$v eq 'false' ? 0 : 1;
+                               my $v = command_oneline(qw/config --bool/,$k);
+                               $self->{$prop} = $v eq 'false' ? 0 : 1;
                        }
-                       return \$self->{-$_} }\n";
+                       return $self->{$prop};
+               }
        }
-       $e .= "1;\n";
-       eval $e or die $@;
 }
 
 my %LOCKFILES;
@@ -1034,7 +1045,7 @@ sub init_remote_config {
                                     "[svn-remote \"$existing\"]\n";
                }
                $self->{repo_id} = $existing;
-       } else {
+       } elsif ($_minimize_url) {
                my $min_url = Git::SVN::Ra->new($url)->minimize_url;
                $existing = find_existing_remote($min_url, $r);
                if ($existing) {
@@ -1387,7 +1398,7 @@ sub traverse_ignore {
                }
        }
        foreach (sort keys %$dirent) {
-               next if $dirent->{$_}->kind != $SVN::Node::dir;
+               next if $dirent->{$_}->{kind} != $SVN::Node::dir;
                $self->traverse_ignore($fh, "$path/$_", $r);
        }
 }
@@ -1448,7 +1459,7 @@ sub tmp_config {
        my (@args) = @_;
        my $old_def_config = "$ENV{GIT_DIR}/svn/config";
        my $config = "$ENV{GIT_DIR}/svn/.metadata";
-       if (-e $old_def_config && ! -e $config) {
+       if (! -f $config && -f $old_def_config) {
                rename $old_def_config, $config or
                       die "Failed rename $old_def_config => $config: $!\n";
        }
@@ -2463,12 +2474,16 @@ sub close_file {
        my $hash;
        my $path = $self->git_path($fb->{path});
        if (my $fh = $fb->{fh}) {
-               seek($fh, 0, 0) or croak $!;
-               my $md5 = Digest::MD5->new;
-               $md5->addfile($fh);
-               my $got = $md5->hexdigest;
-               die "Checksum mismatch: $path\n",
-                   "expected: $exp\n    got: $got\n" if ($got ne $exp);
+               if (defined $exp) {
+                       seek($fh, 0, 0) or croak $!;
+                       my $md5 = Digest::MD5->new;
+                       $md5->addfile($fh);
+                       my $got = $md5->hexdigest;
+                       if ($got ne $exp) {
+                               die "Checksum mismatch: $path\n",
+                                   "expected: $exp\n    got: $got\n";
+                       }
+               }
                sysseek($fh, 0, 0) or croak $!;
                if ($fb->{mode_b} == 120000) {
                        sysread($fh, my $buf, 5) == 5 or croak $!;
@@ -2837,8 +2852,10 @@ sub close_edit {
        my ($self) = @_;
        my ($p,$bat) = ($self->{pool}, $self->{bat});
        foreach (sort { $b =~ tr#/#/# <=> $a =~ tr#/#/# } keys %$bat) {
+               next if $_ eq '';
                $self->close_directory($bat->{$_}, $p);
        }
+       $self->close_directory($bat->{''}, $p);
        $self->SUPER::close_edit($p);
        $p->clear;
 }
@@ -2884,46 +2901,23 @@ my ($can_do_switch, %ignored_err, $RA);
 
 BEGIN {
        # enforce temporary pool usage for some simple functions
-       my $e;
-       foreach (qw/get_latest_revnum get_uuid get_repos_root/) {
-               $e .= "sub $_ {
-                       my \$self = shift;
-                       my \$pool = SVN::Pool->new;
-                       my \@ret = \$self->SUPER::$_(\@_,\$pool);
-                       \$pool->clear;
-                       wantarray ? \@ret : \$ret[0]; }\n";
-       }
-
-       # get_dir needs $pool held in cache for dirents to work,
-       # check_path is cacheable and rev_proplist is close enough
-       # for our purposes.
-       foreach (qw/check_path get_dir rev_proplist/) {
-               $e .= "my \%${_}_cache; my \$${_}_rev = 0; sub $_ {
-                       my \$self = shift;
-                       my \$r = pop;
-                       my \$k = join(\"\\0\", \@_);
-                       if (my \$x = \$${_}_cache{\$r}->{\$k}) {
-                               return wantarray ? \@\$x : \$x->[0];
-                       }
-                       my \$pool = SVN::Pool->new;
-                       my \@ret = \$self->SUPER::$_(\@_, \$r, \$pool);
-                       if (\$r != \$${_}_rev) {
-                               \%${_}_cache = ( pool => [] );
-                               \$${_}_rev = \$r;
-                       }
-                       \$${_}_cache{\$r}->{\$k} = \\\@ret;
-                       push \@{\$${_}_cache{pool}}, \$pool;
-                       wantarray ? \@ret : \$ret[0]; }\n";
+       no strict 'refs';
+       for my $f (qw/rev_proplist get_latest_revnum get_uuid get_repos_root/) {
+               my $SUPER = "SUPER::$f";
+               *$f = sub {
+                       my $self = shift;
+                       my $pool = SVN::Pool->new;
+                       my @ret = $self->$SUPER(@_,$pool);
+                       $pool->clear;
+                       wantarray ? @ret : $ret[0];
+               };
        }
-       $e .= "\n1;";
-       eval $e or die $@;
 }
 
 sub new {
        my ($class, $url) = @_;
        $url =~ s!/+$!!;
        return $RA if ($RA && $RA->{url} eq $url);
-       $RA->{pool}->clear if $RA;
 
        SVN::_Core::svn_config_ensure($config_dir, undef);
        my ($baton, $callbacks) = SVN::Core::auth_open_helper([
@@ -2949,9 +2943,47 @@ sub new {
        $self->{svn_path} = $url;
        $self->{repos_root} = $self->get_repos_root;
        $self->{svn_path} =~ s#^\Q$self->{repos_root}\E(/|$)##;
+       $self->{cache} = { check_path => { r => 0, data => {} },
+                          get_dir => { r => 0, data => {} } };
        $RA = bless $self, $class;
 }
 
+sub check_path {
+       my ($self, $path, $r) = @_;
+       my $cache = $self->{cache}->{check_path};
+       if ($r == $cache->{r} && exists $cache->{data}->{$path}) {
+               return $cache->{data}->{$path};
+       }
+       my $pool = SVN::Pool->new;
+       my $t = $self->SUPER::check_path($path, $r, $pool);
+       $pool->clear;
+       if ($r != $cache->{r}) {
+               %{$cache->{data}} = ();
+               $cache->{r} = $r;
+       }
+       $cache->{data}->{$path} = $t;
+}
+
+sub get_dir {
+       my ($self, $dir, $r) = @_;
+       my $cache = $self->{cache}->{get_dir};
+       if ($r == $cache->{r}) {
+               if (my $x = $cache->{data}->{$dir}) {
+                       return wantarray ? @$x : $x->[0];
+               }
+       }
+       my $pool = SVN::Pool->new;
+       my ($d, undef, $props) = $self->SUPER::get_dir($dir, $r, $pool);
+       my %dirents = map { $_ => { kind => $d->{$_}->kind } } keys %$d;
+       $pool->clear;
+       if ($r != $cache->{r}) {
+               %{$cache->{data}} = ();
+               $cache->{r} = $r;
+       }
+       $cache->{data}->{$dir} = [ \%dirents, $r, $props ];
+       wantarray ? (\%dirents, $r, $props) : \%dirents;
+}
+
 sub DESTROY {
        # do not call the real DESTROY since we store ourselves in $RA
 }
@@ -3042,11 +3074,8 @@ sub gs_do_switch {
        $editor->{git_commit_ok};
 }
 
-sub gs_fetch_loop_common {
-       my ($self, $base, $head, $gsv, $globs) = @_;
-       return if ($base > $head);
-       my $inc = $_log_window_size;
-       my ($min, $max) = ($base, $head < $base + $inc ? $head : $base + $inc);
+sub longest_common_path {
+       my ($gsv, $globs) = @_;
        my %common;
        my $common_max = scalar @$gsv;
 
@@ -3078,6 +3107,15 @@ sub gs_fetch_loop_common {
                        last;
                }
        }
+       $longest_path;
+}
+
+sub gs_fetch_loop_common {
+       my ($self, $base, $head, $gsv, $globs) = @_;
+       return if ($base > $head);
+       my $inc = $_log_window_size;
+       my ($min, $max) = ($base, $head < $base + $inc ? $head : $base + $inc);
+       my $longest_path = longest_common_path($gsv, $globs);
        while (1) {
                my %revs;
                my $err;
@@ -3166,7 +3204,7 @@ sub match_globs {
                return unless scalar @x == 3;
                my $dirents = $x[0];
                foreach my $de (keys %$dirents) {
-                       next if $dirents->{$de}->kind != $SVN::Node::dir;
+                       next if $dirents->{$de}->{kind} != $SVN::Node::dir;
                        my $p = $g->{path}->full_path($de);
                        next if $exists->{$p};
                        next if (length $g->{path}->{right} &&