X-Git-Url: https://asedeno.scripts.mit.edu/gitweb/?a=blobdiff_plain;f=git-svn.perl;h=9e2faf90aa1676974234882a2f557c17f7bc59f4;hb=f830d45b9fdb04a5d79c25bb3a3d891d8d3b58e9;hp=3aa7f8cb408402305df316d2ff90b69a3267c5a0;hpb=3157dd9e89a71e80673d0bc21b5c0630f3b1fe68;p=git.git diff --git a/git-svn.perl b/git-svn.perl index 3aa7f8cb4..9e2faf90a 100755 --- a/git-svn.perl +++ b/git-svn.perl @@ -186,6 +186,9 @@ my %cmd = ( "Show info about the latest SVN revision on the current branch", { 'url' => \$_url, } ], + 'blame' => [ \&Git::SVN::Log::cmd_blame, + "Show what revision and author last modified each line of a file", + {} ], ); my $cmd; @@ -197,8 +200,8 @@ for (my $i = 0; $i < @ARGV; $i++) { } }; -# make sure we're always running -unless ($cmd =~ /(?:clone|init|multi-init)$/) { +# make sure we're always running at the top-level working directory +unless ($cmd && $cmd =~ /(?:clone|init|multi-init)$/) { unless (-d $ENV{GIT_DIR}) { if ($git_dir_user_set) { die "GIT_DIR=$ENV{GIT_DIR} explicitly set, ", @@ -418,7 +421,7 @@ sub cmd_dcommit { warn "Attempting to commit more than one change while ", "--no-rebase is enabled.\n", "If these changes depend on each other, re-running ", - "without --no-rebase will be required." + "without --no-rebase may be required." } while (1) { my $d = shift @$linear_refs or last; @@ -453,6 +456,7 @@ sub cmd_dcommit { $parents->{$d}; } $_fetch_all ? $gs->fetch_all : $gs->fetch; + $last_rev = $cmt_rev; next if $_no_rebase; # we always want to rebase against the current HEAD, @@ -512,7 +516,6 @@ sub cmd_dcommit { $parents = \%p; $linear_refs = \@l; } - $last_rev = $cmt_rev; } } unlink $gs->{index}; @@ -1247,7 +1250,8 @@ use File::Path qw/mkpath/; use File::Copy qw/copy/; use IPC::Open3; -my $_repack_nr; +my ($_gc_nr, $_gc_period); + # properties that we do not log: my %SKIP_PROP; BEGIN { @@ -1283,8 +1287,11 @@ BEGIN { } } -my %LOCKFILES; -END { unlink keys %LOCKFILES if %LOCKFILES } +my (%LOCKFILES, %INDEX_FILES); +END { + unlink keys %LOCKFILES if %LOCKFILES; + unlink keys %INDEX_FILES if %INDEX_FILES; +} sub resolve_local_globs { my ($url, $fetch, $glob_spec) = @_; @@ -1376,7 +1383,6 @@ sub fetch_all { ($base, $head) = parse_revision_argument($base, $head); $ra->gs_fetch_loop_common($base, $head, \@gs, \@globs); - unlink $_->{index} foreach @gs; } sub read_all_remotes { @@ -1406,10 +1412,9 @@ sub read_all_remotes { } sub init_vars { - if (defined $_repack) { - $_repack = 1000 if ($_repack <= 0); - $_repack_nr = $_repack; - $_repack_flags ||= '-d'; + $_gc_nr = $_gc_period = 1000; + if (defined $_repack || defined $_repack_flags) { + warn "Repack options are obsolete; they have no effect.\n"; } } @@ -1756,10 +1761,16 @@ sub svnsync { # see if we have it in our config, first: eval { my $section = "svn-remote.$self->{repo_id}"; - $svnsync = { - url => tmp_config('--get', "$section.svnsync-url"), - uuid => tmp_config('--get', "$section.svnsync-uuid"), - } + + my $url = tmp_config('--get', "$section.svnsync-url"); + ($url) = ($url =~ m{^([a-z\+]+://\S+)$}) or + die "doesn't look right - svn:sync-from-url is '$url'\n"; + + my $uuid = tmp_config('--get', "$section.svnsync-uuid"); + ($uuid) = ($uuid =~ m{^([0-9a-f\-]{30,})$}) or + die "doesn't look right - svn:sync-from-uuid is '$uuid'\n"; + + $svnsync = { url => $url, uuid => $uuid } }; if ($svnsync && $svnsync->{url} && $svnsync->{uuid}) { return $self->{svnsync} = $svnsync; @@ -1770,11 +1781,11 @@ sub svnsync { my $rp = $self->ra->rev_proplist(0); my $url = $rp->{'svn:sync-from-url'} or die $err . "url\n"; - $url =~ m{^[a-z\+]+://} or + ($url) = ($url =~ m{^([a-z\+]+://\S+)$}) or die "doesn't look right - svn:sync-from-url is '$url'\n"; my $uuid = $rp->{'svn:sync-from-uuid'} or die $err . "uuid\n"; - $uuid =~ m{^[0-9a-f\-]{30,}$} or + ($uuid) = ($uuid =~ m{^([0-9a-f\-]{30,})$}) or die "doesn't look right - svn:sync-from-uuid is '$uuid'\n"; my $section = "svn-remote.$self->{repo_id}"; @@ -1856,6 +1867,7 @@ sub rel_path { sub prop_walk { my ($self, $path, $rev, $sub) = @_; + $path =~ s#^/##; my ($dirent, undef, $props) = $self->ra->get_dir($path, $rev); $path =~ s#^/*#/#g; my $p = $path; @@ -2052,18 +2064,16 @@ sub full_url { $self->{url} . (length $self->{path} ? '/' . $self->{path} : ''); } -sub do_git_commit { - my ($self, $log_entry) = @_; - my $lr = $self->last_rev; - if (defined $lr && $lr >= $log_entry->{revision}) { - die "Last fetched revision of ", $self->refname, - " was r$lr, but we are about to fetch: ", - "r$log_entry->{revision}!\n"; - } - if (my $c = $self->rev_map_get($log_entry->{revision})) { - croak "$log_entry->{revision} = $c already exists! ", - "Why are we refetching it?\n"; + +sub set_commit_header_env { + my ($log_entry) = @_; + my %env; + foreach my $ned (qw/NAME EMAIL DATE/) { + foreach my $ac (qw/AUTHOR COMMITTER/) { + $env{"GIT_${ac}_${ned}"} = $ENV{"GIT_${ac}_${ned}"}; + } } + $ENV{GIT_AUTHOR_NAME} = $log_entry->{name}; $ENV{GIT_AUTHOR_EMAIL} = $log_entry->{email}; $ENV{GIT_AUTHOR_DATE} = $ENV{GIT_COMMITTER_DATE} = $log_entry->{date}; @@ -2074,7 +2084,40 @@ sub do_git_commit { $ENV{GIT_COMMITTER_EMAIL} = (defined $log_entry->{commit_email}) ? $log_entry->{commit_email} : $log_entry->{email}; + \%env; +} +sub restore_commit_header_env { + my ($env) = @_; + foreach my $ned (qw/NAME EMAIL DATE/) { + foreach my $ac (qw/AUTHOR COMMITTER/) { + my $k = "GIT_${ac}_${ned}"; + if (defined $env->{$k}) { + $ENV{$k} = $env->{$k}; + } else { + delete $ENV{$k}; + } + } + } +} + +sub gc { + command_noisy('gc', '--auto'); +}; + +sub do_git_commit { + my ($self, $log_entry) = @_; + my $lr = $self->last_rev; + if (defined $lr && $lr >= $log_entry->{revision}) { + die "Last fetched revision of ", $self->refname, + " was r$lr, but we are about to fetch: ", + "r$log_entry->{revision}!\n"; + } + if (my $c = $self->rev_map_get($log_entry->{revision})) { + croak "$log_entry->{revision} = $c already exists! ", + "Why are we refetching it?\n"; + } + my $old_env = set_commit_header_env($log_entry); my $tree = $log_entry->{tree}; if (!defined $tree) { $tree = $self->tmp_index_do(sub { @@ -2089,6 +2132,7 @@ sub do_git_commit { defined(my $pid = open3(my $msg_fh, my $out_fh, '>&STDERR', @exec)) or croak $!; print $msg_fh $log_entry->{log} or croak $!; + restore_commit_header_env($old_env); unless ($self->no_metadata) { print $msg_fh "\ngit-svn-id: $log_entry->{metadata}\n" or croak $!; @@ -2114,12 +2158,9 @@ sub do_git_commit { 0, $self->svm_uuid); } print " = $commit ($self->{ref_id})\n"; - if (defined $_repack && (--$_repack_nr == 0)) { - $_repack_nr = $_repack; - # repack doesn't use any arguments with spaces in them, does it? - print "Running git repack $_repack_flags ...\n"; - command_noisy('repack', split(/\s+/, $_repack_flags)); - print "Done repacking\n"; + if (--$_gc_nr == 0) { + $_gc_nr = $_gc_period; + gc(); } return $commit; } @@ -2191,7 +2232,12 @@ sub find_parent_branch { # just grow a tail if we're not unique enough :x $ref_id .= '-' while find_ref($ref_id); print STDERR "Initializing parent: $ref_id\n"; - $gs = Git::SVN->init($new_url, '', $ref_id, $ref_id, 1); + my ($u, $p) = ($new_url, ''); + if ($u =~ s#^\Q$url\E(/|$)##) { + $p = $u; + $u = $url; + } + $gs = Git::SVN->init($u, $p, $self->{repo_id}, $ref_id, 1); } my ($r0, $parent) = $gs->find_rev_before($r, 1); if (!defined $r0 || !defined $parent) { @@ -3045,6 +3091,20 @@ sub add_file { sub add_directory { my ($self, $path, $cp_path, $cp_rev) = @_; + my $gpath = $self->git_path($path); + if ($gpath eq '') { + my ($ls, $ctx) = command_output_pipe(qw/ls-tree + -r --name-only -z/, + $self->{c}); + local $/ = "\0"; + while (<$ls>) { + chomp; + $self->{gii}->remove($_); + print "\tD\t$_\n" unless $::_q; + } + command_close_pipe($ls, $ctx); + $self->{empty}->{$path} = 0; + } my ($dir, $file) = ($path =~ m#^(.*?)/?([^/]+)$#); delete $self->{empty}->{$dir}; $self->{empty}->{$path} = 1; @@ -3135,9 +3195,15 @@ sub close_file { } sysseek($fh, 0, 0) or croak $!; if ($fb->{mode_b} == 120000) { - sysread($fh, my $buf, 5) == 5 or croak $!; - $buf eq 'link ' or die "$path has mode 120000", - "but is not a link\n"; + eval { + sysread($fh, my $buf, 5) == 5 or croak $!; + $buf eq 'link ' or die "$path has mode 120000", + " but is not a link"; + }; + if ($@) { + warn "$@\n"; + sysseek($fh, 0, 0) or croak $!; + } } defined(my $pid = open my $out,'-|') or die "Can't fork: $!\n"; if (!$pid) { @@ -3577,6 +3643,7 @@ sub _auth_providers () { SVN::Client::get_ssl_client_cert_file_provider(), SVN::Client::get_ssl_client_cert_prompt_provider( \&Git::SVN::Prompt::ssl_client_cert, 2), + SVN::Client::get_ssl_client_cert_pw_file_provider(), SVN::Client::get_ssl_client_cert_pw_prompt_provider( \&Git::SVN::Prompt::ssl_client_cert_pw, 2), SVN::Client::get_username_provider(), @@ -3897,6 +3964,7 @@ sub gs_fetch_loop_common { if ($log_entry) { $gs->do_git_commit($log_entry); } + $INDEX_FILES{$gs->{index}} = 1; } foreach my $g (@$globs) { my $k = "svn-remote.$g->{remote}." . @@ -3927,6 +3995,7 @@ sub gs_fetch_loop_common { $max += $inc; $max = $head if ($max > $head); } + Git::SVN::gc(); } sub match_globs { @@ -4034,6 +4103,10 @@ sub skip_unknown_revs { warn "W: Ignoring error from SVN, path probably ", "does not exist: ($errno): ", $err->expanded_message,"\n"; + warn "W: Do not be alarmed at the above message ", + "git-svn is just searching aggressively for ", + "old history.\n", + "This may take a while on large repositories\n"; $ignored_err{$err_key} = 1; } return; @@ -4379,6 +4452,24 @@ out: print commit_log_separator unless $incremental || $oneline; } +sub cmd_blame { + my $path = shift; + + config_pager(); + run_pager(); + + my ($fh, $ctx) = command_output_pipe('blame', @_, $path); + while (my $line = <$fh>) { + if ($line =~ /^\^?([[:xdigit:]]+)\s/) { + my (undef, $rev, undef) = ::cmt_metadata($1); + $rev = sprintf('%-10s', $rev); + $line =~ s/^\^?[[:xdigit:]]+(\s)/$rev$1/; + } + print $line; + } + 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.