"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;
}
};
-# 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, ",
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;
$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,
$parents = \%p;
$linear_refs = \@l;
}
- $last_rev = $cmt_rev;
}
}
unlink $gs->{index};
}
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;
"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";
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;
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 {
}
}
-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) = @_;
($base, $head) = parse_revision_argument($base, $head);
$ra->gs_fetch_loop_common($base, $head, \@gs, \@globs);
- unlink $_->{index} foreach @gs;
}
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";
}
}
$remotes->{$repo_id}->{$_});
}
my $p = $path;
+ my $rwr = rewrite_root({repo_id => $repo_id});
unless (defined $p) {
$p = $full_url;
- $p =~ s#^\Q$u\E(?:/|$)## or next;
+ my $z = $u;
+ if ($rwr) {
+ $z = $rwr;
+ }
+ $p =~ s#^\Q$z\E(?:/|$)## or next;
}
foreach my $f (keys %$fetch) {
next if $f ne $p;
# 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;
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}";
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;
foreach (sort keys %$dirent) {
next if $dirent->{$_}->{kind} != $SVN::Node::dir;
- $self->prop_walk($path . '/' . $_, $rev, $sub);
+ $self->prop_walk($p . $_, $rev, $sub);
}
}
}
}
+sub gc {
+ command_noisy('gc', '--auto');
+};
+
sub do_git_commit {
my ($self, $log_entry) = @_;
my $lr = $self->last_rev;
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;
}
# 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) {
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;
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($_);
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";
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";
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";
}
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) {
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(),
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);
if ($log_entry) {
$gs->do_git_commit($log_entry);
}
+ $INDEX_FILES{$gs->{index}} = 1;
}
foreach my $g (@$globs) {
my $k = "svn-remote.$g->{remote}." .
$max += $inc;
$max = $head if ($max > $head);
}
+ Git::SVN::gc();
}
sub match_globs {
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;
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.