]> asedeno.scripts.mit.edu Git - git.git/blobdiff - git-svn.perl
Merge branch 'lw/perlish'
[git.git] / git-svn.perl
index 29f39c0831227a2a7c7b482cdf8277e95cf63245..4c9c59bc3ffb9ed2f8e808cf6849562669adfd18 100755 (executable)
@@ -4,7 +4,7 @@
 use warnings;
 use strict;
 use vars qw/   $AUTHOR $VERSION
-               $sha1 $sha1_short $_revision
+               $sha1 $sha1_short $_revision $_repository
                $_q $_authors %users/;
 $AUTHOR = 'Eric Wong <normalperson@yhbt.net>';
 $VERSION = '@@GIT_VERSION@@';
@@ -65,7 +65,8 @@ my ($_stdin, $_help, $_edit,
        $_template, $_shared,
        $_version, $_fetch_all, $_no_rebase,
        $_merge, $_strategy, $_dry_run, $_local,
-       $_prefix, $_no_checkout, $_url, $_verbose);
+       $_prefix, $_no_checkout, $_url, $_verbose,
+       $_git_format);
 $Git::SVN::_follow_parent = 1;
 my %remote_opts = ( 'username=s' => \$Git::SVN::Prompt::_username,
                     'config-dir=s' => \$Git::SVN::Ra::config_dir,
@@ -82,6 +83,7 @@ my %fc_opts = ( 'follow-parent|follow!' => \$Git::SVN::_follow_parent,
                'repack-flags|repack-args|repack-opts=s' =>
                   \$Git::SVN::_repack_flags,
                'use-log-author' => \$Git::SVN::_use_log_author,
+               'add-author-from' => \$Git::SVN::_add_author_from,
                %remote_opts );
 
 my ($_trunk, $_tags, $_branches, $_stdlayout);
@@ -175,6 +177,7 @@ my %cmd = (
                          'strategy|s=s' => \$_strategy,
                          'local|l' => \$_local,
                          'fetch-all|all' => \$_fetch_all,
+                         'dry-run|n' => \$_dry_run,
                          %fc_opts } ],
        'commit-diff' => [ \&cmd_commit_diff,
                           'Commit a diff between two trees',
@@ -186,6 +189,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",
+                   { 'git-format' => \$_git_format } ],
 );
 
 my $cmd;
@@ -217,12 +223,13 @@ unless ($cmd && $cmd =~ /(?:clone|init|multi-init)$/) {
                }
                $ENV{GIT_DIR} = $git_dir;
        }
+       $_repository = Git->repository(Repository => $ENV{GIT_DIR});
 }
 
 my %opts = %{$cmd{$cmd}->[2]} if (defined $cmd);
 
 read_repo_config(\%opts);
-Getopt::Long::Configure('pass_through') if ($cmd && $cmd eq 'log');
+Getopt::Long::Configure('pass_through') if ($cmd && ($cmd eq 'log' || $cmd eq 'blame'));
 my $rv = GetOptions(%opts, 'help|H|h' => \$_help, 'version|V' => \$_version,
                     'minimize-connections' => \$Git::SVN::Migration::_minimize,
                     'id|i=s' => \$Git::SVN::default_ref_id,
@@ -298,6 +305,7 @@ sub do_git_init_db {
                        }
                }
                command_noisy(@init_db);
+               $_repository = Git->repository(Repository => ".git");
        }
        my $set;
        my $pfx = "svn-remote.$Git::SVN::default_repo_id";
@@ -314,6 +322,7 @@ sub init_subdir {
        mkpath([$repo_path]) unless -d $repo_path;
        chdir $repo_path or die "Couldn't chdir to $repo_path: $!\n";
        $ENV{GIT_DIR} = '.git';
+       $_repository = Git->repository(Repository => $ENV{GIT_DIR});
 }
 
 sub cmd_clone {
@@ -407,10 +416,12 @@ sub cmd_dcommit {
        $head ||= 'HEAD';
        my @refs;
        my ($url, $rev, $uuid, $gs) = working_head_info($head, \@refs);
-       print "Committing to $url ...\n";
+       if ($url) {
+               print "Committing to $url ...\n";
+       }
        unless ($gs) {
                die "Unable to determine upstream SVN information from ",
-                   "$head history\n";
+                   "$head history.\nPerhaps the repository is empty.";
        }
        my $last_rev;
        my ($linear_refs, $parents) = linearize_history($gs, \@refs);
@@ -519,7 +530,8 @@ sub cmd_dcommit {
 }
 
 sub cmd_find_rev {
-       my $revision_or_hash = shift;
+       my $revision_or_hash = shift or die "SVN or git revision required ",
+                                           "as a command-line argument\n";
        my $result;
        if ($revision_or_hash =~ /^r\d+$/) {
                my $head = shift;
@@ -546,6 +558,11 @@ sub cmd_rebase {
                die "Unable to determine upstream SVN information from ",
                    "working tree history\n";
        }
+       if ($_dry_run) {
+               print "Remote Branch: " . $gs->refname . "\n";
+               print "SVN URL: " . $url . "\n";
+               return;
+       }
        if (command(qw/diff-index HEAD --/)) {
                print STDERR "Cannot rebase with uncommited changes:\n";
                command_noisy('status');
@@ -608,7 +625,7 @@ sub cmd_create_ignore {
                print GITIGNORE "$s\n";
                close(GITIGNORE)
                  or fatal("Failed to close `$ignore': $!");
-               command_noisy('add', $ignore);
+               command_noisy('add', '-f', $ignore);
        });
 }
 
@@ -734,7 +751,7 @@ sub cmd_commit_diff {
        my $usage = "Usage: $0 commit-diff -r<revision> ".
                    "<tree-ish> <tree-ish> [<URL>]";
        fatal($usage) if (!defined $ta || !defined $tb);
-       my $svn_path;
+       my $svn_path = '';
        if (!defined $url) {
                my $gs = eval { Git::SVN->new };
                if (!$gs) {
@@ -758,7 +775,6 @@ sub cmd_commit_diff {
                $_message ||= get_commit_entry($tb)->{log};
        }
        my $ra ||= Git::SVN::Ra->new($url);
-       $svn_path ||= $ra->{svn_path};
        my $r = $_revision;
        if ($r eq 'HEAD') {
                $r = $ra->get_latest_revnum;
@@ -954,9 +970,10 @@ sub complete_url_ls_init {
                    "wanted to set to: $gs->{url}\n";
        }
        command_oneline('config', $k, $gs->{url}) unless $orig_url;
-       my $remote_path = "$ra->{svn_path}/$repo_path/*";
+       my $remote_path = "$ra->{svn_path}/$repo_path";
        $remote_path =~ s#/+#/#g;
        $remote_path =~ s#^/##g;
+       $remote_path .= "/*" if $remote_path !~ /\*/;
        my ($n) = ($switch =~ /^--(\w+)/);
        if (length $pfx && $pfx !~ m#/$#) {
                die "--prefix='$pfx' must have a trailing slash '/'\n";
@@ -1004,17 +1021,30 @@ sub get_commit_entry {
                my ($msg_fh, $ctx) = command_output_pipe('cat-file',
                                                         $type, $treeish);
                my $in_msg = 0;
+               my $author;
+               my $saw_from = 0;
+               my $msgbuf = "";
                while (<$msg_fh>) {
                        if (!$in_msg) {
                                $in_msg = 1 if (/^\s*$/);
+                               $author = $1 if (/^author (.*>)/);
                        } elsif (/^git-svn-id: /) {
                                # skip this for now, we regenerate the
                                # correct one on re-fetch anyways
                                # TODO: set *:merge properties or like...
                        } else {
-                               print $log_fh $_ or croak $!;
+                               if (/^From:/ || /^Signed-off-by:/) {
+                                       $saw_from = 1;
+                               }
+                               $msgbuf .= $_;
                        }
                }
+               $msgbuf =~ s/\s+$//s;
+               if ($Git::SVN::_add_author_from && defined($author)
+                   && !$saw_from) {
+                       $msgbuf .= "\n\nFrom: $author";
+               }
+               print $log_fh $msgbuf or croak $!;
                command_close_pipe($msg_fh, $ctx);
        }
        close $log_fh or croak $!;
@@ -1115,7 +1145,7 @@ sub cmt_metadata {
 
 sub working_head_info {
        my ($head, $refs) = @_;
-       my @args = ('log', '--no-color', '--first-parent');
+       my @args = ('log', '--no-color', '--first-parent', '--pretty=medium');
        my ($fh, $ctx) = command_output_pipe(@args, $head);
        my $hash;
        my %max;
@@ -1241,13 +1271,14 @@ use constant rev_map_fmt => 'NH40';
 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 $_minimize_url
-           $_use_log_author/;
+           $_use_log_author $_add_author_from/;
 use Carp qw/croak/;
 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 {
@@ -1408,9 +1439,10 @@ sub read_all_remotes {
 }
 
 sub init_vars {
-       $_repack = 1000 unless (defined $_repack && $_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";
+       }
 }
 
 sub verify_remotes_sanity {
@@ -1893,7 +1925,7 @@ sub prop_walk {
 
        foreach (sort keys %$dirent) {
                next if $dirent->{$_}->{kind} != $SVN::Node::dir;
-               $self->prop_walk($path . '/' . $_, $rev, $sub);
+               $self->prop_walk($self->{path} . $p . $_, $rev, $sub);
        }
 }
 
@@ -2101,6 +2133,10 @@ sub restore_commit_header_env {
        }
 }
 
+sub gc {
+       command_noisy('gc', '--auto');
+};
+
 sub do_git_commit {
        my ($self, $log_entry) = @_;
        my $lr = $self->last_rev;
@@ -2154,12 +2190,9 @@ sub do_git_commit {
                                   0, $self->svm_uuid);
        }
        print " = $commit ($self->{ref_id})\n";
-       if ($_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;
 }
@@ -2231,7 +2264,13 @@ 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, $repo_id) = ($new_url, '', $ref_id);
+               if ($u =~ s#^\Q$url\E(/|$)##) {
+                       $p = $u;
+                       $u = $url;
+                       $repo_id = $self->{repo_id};
+               }
+               $gs = Git::SVN->init($u, $p, $repo_id, $ref_id, 1);
        }
        my ($r0, $parent) = $gs->find_rev_before($r, 1);
        if (!defined $r0 || !defined $parent) {
@@ -2361,8 +2400,7 @@ sub check_author {
        my ($author) = @_;
        if (!defined $author || length $author == 0) {
                $author = '(no author)';
-       }
-       if (defined $::_authors && ! defined $::users{$author}) {
+       } elsif (defined $::_authors && ! defined $::users{$author}) {
                die "Author: $author not defined in $::_authors file\n";
        }
        $author;
@@ -2413,13 +2451,15 @@ sub make_log_entry {
                        $name_field = $1;
                }
                if (!defined $name_field) {
-                       #
+                       if (!defined $email) {
+                               $email = $name;
+                       }
                } elsif ($name_field =~ /(.*?)\s+<(.*)>/) {
                        ($name, $email) = ($1, $2);
                } elsif ($name_field =~ /(.*)@/) {
                        ($name, $email) = ($1, $name_field);
                } else {
-                       ($name, $email) = ($name_field, 'unknown');
+                       ($name, $email) = ($name_field, $name_field);
                }
        }
        if (defined $headrev && $self->use_svm_props) {
@@ -2505,6 +2545,7 @@ sub rebuild_from_rev_db {
        my ($self, $path) = @_;
        my $r = -1;
        open my $fh, '<', $path or croak "open: $!";
+       binmode $fh or croak "binmode: $!";
        while (<$fh>) {
                length($_) == 41 or croak "inconsistent size in ($_) != 41";
                chomp($_);
@@ -2536,8 +2577,8 @@ sub rebuild {
        my ($log, $ctx) =
            command_output_pipe(qw/rev-list --pretty=raw --no-color --reverse/,
                                $self->refname, '--');
-       my $full_url = $self->full_url;
-       remove_username($full_url);
+       my $metadata_url = $self->metadata_url;
+       remove_username($metadata_url);
        my $svn_uuid = $self->ra_uuid;
        my $c;
        while (<$log>) {
@@ -2555,7 +2596,7 @@ sub rebuild {
                # if we merged or otherwise started elsewhere, this is
                # how we break out of it
                if (($uuid ne $svn_uuid) ||
-                   ($full_url && $url && ($url ne $full_url))) {
+                   ($metadata_url && $url && ($url ne $metadata_url))) {
                        next;
                }
 
@@ -2602,6 +2643,7 @@ sub rebuild {
 sub _rev_map_set {
        my ($fh, $rev, $commit) = @_;
 
+       binmode $fh or croak "binmode: $!";
        my $size = (stat($fh))[7];
        ($size % 24) == 0 or croak "inconsistent size: $size";
 
@@ -2705,6 +2747,7 @@ sub rev_map_max {
        my $map_path = $self->map_path;
        stat $map_path or return $want_commit ? (0, undef) : 0;
        sysopen(my $fh, $map_path, O_RDONLY) or croak "open: $!";
+       binmode $fh or croak "binmode: $!";
        my $size = (stat($fh))[7];
        ($size % 24) == 0 or croak "inconsistent size: $size";
 
@@ -2737,6 +2780,7 @@ sub rev_map_get {
        return undef unless -e $map_path;
 
        sysopen(my $fh, $map_path, O_RDONLY) or croak "open: $!";
+       binmode $fh or croak "binmode: $!";
        my $size = (stat($fh))[7];
        ($size % 24) == 0 or croak "inconsistent size: $size";
 
@@ -2996,6 +3040,7 @@ use vars qw/@ISA/;
 use strict;
 use warnings;
 use Carp qw/croak/;
+use File::Temp qw/tempfile/;
 use IO::File qw//;
 
 # file baton members: path, mode_a, mode_b, pool, fh, blob, base
@@ -3151,14 +3196,9 @@ sub apply_textdelta {
        my $base = IO::File->new_tmpfile;
        $base->autoflush(1);
        if ($fb->{blob}) {
-               defined (my $pid = fork) or croak $!;
-               if (!$pid) {
-                       open STDOUT, '>&', $base or croak $!;
-                       print STDOUT 'link ' if ($fb->{mode_a} == 120000);
-                       exec qw/git-cat-file blob/, $fb->{blob} or croak $!;
-               }
-               waitpid $pid, 0;
-               croak $? if $?;
+               print $base 'link ' if ($fb->{mode_a} == 120000);
+               my $size = $::_repository->cat_blob($fb->{blob}, $base);
+               die "Failed to read object $fb->{blob}" if ($size < 0);
 
                if (defined $exp) {
                        seek $base, 0, 0 or croak $!;
@@ -3199,14 +3239,18 @@ sub close_file {
                                sysseek($fh, 0, 0) or croak $!;
                        }
                }
-               defined(my $pid = open my $out,'-|') or die "Can't fork: $!\n";
-               if (!$pid) {
-                       open STDIN, '<&', $fh or croak $!;
-                       exec qw/git-hash-object -w --stdin/ or croak $!;
+
+               my ($tmp_fh, $tmp_filename) = File::Temp::tempfile(UNLINK => 1);
+               my $result;
+               while ($result = sysread($fh, my $string, 1024)) {
+                       syswrite($tmp_fh, $string, $result);
                }
-               chomp($hash = do { local $/; <$out> });
-               close $out or croak $!;
+               defined $result or croak $!;
+               close $tmp_fh or croak $!;
+
                close $fh or croak $!;
+
+               $hash = $::_repository->hash_and_insert_object($tmp_filename);
                $hash =~ /^[a-f\d]{40}$/ or die "not a sha1: $hash\n";
                close $fb->{base} or croak $!;
        } else {
@@ -3532,13 +3576,8 @@ sub chg_file {
        } elsif ($m->{mode_a} =~ /^120/ && $m->{mode_b} !~ /^120/) {
                $self->change_file_prop($fbat,'svn:special',undef);
        }
-       defined(my $pid = fork) or croak $!;
-       if (!$pid) {
-               open STDOUT, '>&', $fh or croak $!;
-               exec qw/git-cat-file blob/, $m->{sha1_b} or croak $!;
-       }
-       waitpid $pid, 0;
-       croak $? if $?;
+       my $size = $::_repository->cat_blob($m->{sha1_b}, $fh);
+       croak "Failed to read object $m->{sha1_b}" if ($size < 0);
        $fh->flush == 0 or croak $!;
        seek $fh, 0, 0 or croak $!;
 
@@ -3652,7 +3691,7 @@ sub escape_uri_only {
        my ($uri) = @_;
        my @tmp;
        foreach (split m{/}, $uri) {
-               s/([^\w.-])/sprintf("%%%02X",ord($1))/eg;
+               s/([^\w.%+-]|%(?![a-fA-F0-9]{2}))/sprintf("%%%02X",ord($1))/eg;
                push @tmp, $_;
        }
        join('/', @tmp);
@@ -3989,6 +4028,7 @@ sub gs_fetch_loop_common {
                $max += $inc;
                $max = $head if ($max > $head);
        }
+       Git::SVN::gc();
 }
 
 sub match_globs {
@@ -4445,6 +4485,56 @@ out:
        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;
+               while (my $line = <$fh>) {
+                       if ($line =~ /^([[:xdigit:]]{40})\s\d+\s\d+/) {
+                               $sha1 = $1;
+                               (undef, $rev, undef) = ::cmt_metadata($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.