#!/usr/bin/env perl
# Copyright (C) 2006, Eric Wong <normalperson@yhbt.net>
# License: GPL v2 or later
+use 5.008;
use warnings;
use strict;
use vars qw/ $AUTHOR $VERSION
$Git::SVN::Ra::_log_window_size = 100;
$Git::SVN::_minimize_url = 'unset';
-if (! exists $ENV{SVN_SSH}) {
- if (exists $ENV{GIT_SSH}) {
- $ENV{SVN_SSH} = $ENV{GIT_SSH};
- if ($^O eq 'msys') {
- $ENV{SVN_SSH} =~ s/\\/\\\\/g;
- }
- }
+if (! exists $ENV{SVN_SSH} && exists $ENV{GIT_SSH}) {
+ $ENV{SVN_SSH} = $ENV{GIT_SSH};
+}
+
+if (exists $ENV{SVN_SSH} && $^O eq 'msys') {
+ $ENV{SVN_SSH} =~ s/\\/\\\\/g;
+ $ENV{SVN_SSH} =~ s/(.*)/"$1"/;
}
$Git::SVN::Log::TZ = $ENV{TZ};
$| = 1; # unbuffer STDOUT
sub fatal (@) { print STDERR "@_\n"; exit 1 }
-require SVN::Core; # use()-ing this causes segfaults for me... *shrug*
-require SVN::Ra;
-require SVN::Delta;
-if ($SVN::Core::VERSION lt '1.1.0') {
- fatal "Need SVN::Core 1.1.0 or better (got $SVN::Core::VERSION)";
+sub _req_svn {
+ require SVN::Core; # use()-ing this causes segfaults for me... *shrug*
+ require SVN::Ra;
+ require SVN::Delta;
+ if ($SVN::Core::VERSION lt '1.1.0') {
+ fatal "Need SVN::Core 1.1.0 or better (got $SVN::Core::VERSION)";
+ }
}
my $can_compress = eval { require Compress::Zlib; 1};
push @Git::SVN::Ra::ISA, 'SVN::Ra';
use Getopt::Long qw/:config gnu_getopt no_ignore_case auto_abbrev/;
use IPC::Open3;
use Git;
+use Memoize; # core since 5.8.0, Jul 2002
BEGIN {
# import functions from Git into our packages, en masse
*{"${package}::$_"} = \&{"Git::$_"};
}
}
+ Memoize::memoize 'Git::config';
+ Memoize::memoize 'Git::config_bool';
}
my ($SVN);
$_version, $_fetch_all, $_no_rebase, $_fetch_parent,
$_merge, $_strategy, $_dry_run, $_local,
$_prefix, $_no_checkout, $_url, $_verbose,
- $_git_format, $_commit_url, $_tag);
+ $_git_format, $_commit_url, $_tag, $_merge_info, $_interactive);
$Git::SVN::_follow_parent = 1;
+$SVN::Git::Fetcher::_placeholder_filename = ".gitignore";
$_q ||= 0;
my %remote_opts = ( 'username=s' => \$Git::SVN::Prompt::_username,
'config-dir=s' => \$Git::SVN::Ra::config_dir,
'no-auth-cache' => \$Git::SVN::Prompt::_no_auth_cache,
- 'ignore-paths=s' => \$SVN::Git::Fetcher::_ignore_regex );
+ 'ignore-paths=s' => \$SVN::Git::Fetcher::_ignore_regex,
+ 'ignore-refs=s' => \$Git::SVN::Ra::_ignore_refs_regex );
my %fc_opts = ( 'follow-parent|follow!' => \$Git::SVN::_follow_parent,
'authors-file|A=s' => \$_authors,
'authors-prog=s' => \$_authors_prog,
'use-svm-props' => sub { $icv{useSvmProps} = 1 },
'use-svnsync-props' => sub { $icv{useSvnsyncProps} = 1 },
'rewrite-root=s' => sub { $icv{rewriteRoot} = $_[1] },
+ 'rewrite-uuid=s' => sub { $icv{rewriteUUID} = $_[1] },
%remote_opts );
my %cmt_opts = ( 'edit|e' => \$_edit,
'rmdir' => \$SVN::Git::Editor::_rmdir,
%fc_opts } ],
clone => [ \&cmd_clone, "Initialize and fetch revisions",
{ 'revision|r=s' => \$_revision,
+ 'preserve-empty-dirs' =>
+ \$SVN::Git::Fetcher::_preserve_empty_dirs,
+ 'placeholder-filename=s' =>
+ \$SVN::Git::Fetcher::_placeholder_filename,
%fc_opts, %init_opts } ],
init => [ \&cmd_init, "Initialize a repo for tracking" .
" (requires URL argument)",
'commit-url=s' => \$_commit_url,
'revision|r=i' => \$_revision,
'no-rebase' => \$_no_rebase,
+ 'mergeinfo=s' => \$_merge_info,
+ 'interactive|i' => \$_interactive,
%cmt_opts, %fc_opts } ],
branch => [ \&cmd_branch,
'Create a branch in the SVN repository',
{ 'message|m=s' => \$_message,
'destination|d=s' => \$_branch_dest,
'dry-run|n' => \$_dry_run,
- 'tag|t' => \$_tag } ],
+ 'tag|t' => \$_tag,
+ 'username=s' => \$Git::SVN::Prompt::_username,
+ 'commit-url=s' => \$_commit_url } ],
tag => [ sub { $_tag = 1; cmd_branch(@_) },
'Create a tag in the SVN repository',
{ 'message|m=s' => \$_message,
'destination|d=s' => \$_branch_dest,
- 'dry-run|n' => \$_dry_run } ],
+ 'dry-run|n' => \$_dry_run,
+ 'username=s' => \$Git::SVN::Prompt::_username,
+ 'commit-url=s' => \$_commit_url } ],
'set-tree' => [ \&cmd_set_tree,
"Set an SVN repository to a git tree-ish",
{ 'stdin' => \$_stdin, %cmt_opts, %fc_opts, } ],
'Create a .gitignore per svn:ignore',
{ 'revision|r=i' => \$_revision
} ],
+ 'mkdirs' => [ \&cmd_mkdirs ,
+ "recreate empty directories after a checkout",
+ { 'revision|r=i' => \$_revision } ],
'propget' => [ \&cmd_propget,
'Print the value of a property on a file or directory',
{ 'revision|r=i' => \$_revision } ],
{} ],
);
+use Term::ReadLine;
+package FakeTerm;
+sub new {
+ my ($class, $reason) = @_;
+ return bless \$reason, shift;
+}
+sub readline {
+ my $self = shift;
+ die "Cannot use readline on FakeTerm: $$self";
+}
+package main;
+
+my $term = eval {
+ $ENV{"GIT_SVN_NOTTY"}
+ ? new Term::ReadLine 'git-svn', \*STDIN, \*STDOUT
+ : new Term::ReadLine 'git-svn';
+};
+if ($@) {
+ $term = new FakeTerm "$@: going non-interactive";
+}
+
my $cmd;
for (my $i = 0; $i < @ARGV; $i++) {
if (defined $cmd{$ARGV[$i]}) {
my %opts = %{$cmd{$cmd}->[2]} if (defined $cmd);
-read_repo_config(\%opts);
+read_git_config(\%opts);
if ($cmd && ($cmd eq 'log' || $cmd eq 'blame')) {
Getopt::Long::Configure('pass_through');
}
-my $rv = GetOptions(%opts, 'help|H|h' => \$_help, 'version|V' => \$_version,
+my $rv = GetOptions(%opts, 'h|H' => \$_help, 'version|V' => \$_version,
'minimize-connections' => \$Git::SVN::Migration::_minimize,
'id|i=s' => \$Git::SVN::default_ref_id,
'svn-remote|remote|R=s' => sub {
}
sub version {
+ ::_req_svn();
print "git-svn version $VERSION (svn $SVN::Core::VERSION)\n";
exit 0;
}
+sub ask {
+ my ($prompt, %arg) = @_;
+ my $valid_re = $arg{valid_re};
+ my $default = $arg{default};
+ my $resp;
+ my $i = 0;
+
+ if ( !( defined($term->IN)
+ && defined( fileno($term->IN) )
+ && defined( $term->OUT )
+ && defined( fileno($term->OUT) ) ) ){
+ return defined($default) ? $default : undef;
+ }
+
+ while ($i++ < 10) {
+ $resp = $term->readline($prompt);
+ if (!defined $resp) { # EOF
+ print "\n";
+ return defined $default ? $default : undef;
+ }
+ if ($resp eq '' and defined $default) {
+ return $default;
+ }
+ if (!defined $valid_re or $resp =~ /$valid_re/) {
+ return $resp;
+ }
+ }
+ return undef;
+}
+
sub do_git_init_db {
unless (-d $ENV{GIT_DIR}) {
my @init_db = ('init');
command_noisy(@init_db);
$_repository = Git->repository(Repository => ".git");
}
- command_noisy('config', 'core.autocrlf', 'false');
my $set;
my $pfx = "svn-remote.$Git::SVN::default_repo_id";
foreach my $i (keys %icv) {
command_noisy('config', "$pfx.$i", $icv{$i});
$set = $i;
}
- my $ignore_regex = \$SVN::Git::Fetcher::_ignore_regex;
- command_noisy('config', "$pfx.ignore-paths", $$ignore_regex)
- if defined $$ignore_regex;
+ my $ignore_paths_regex = \$SVN::Git::Fetcher::_ignore_regex;
+ command_noisy('config', "$pfx.ignore-paths", $$ignore_paths_regex)
+ if defined $$ignore_paths_regex;
+ my $ignore_refs_regex = \$Git::SVN::Ra::_ignore_refs_regex;
+ command_noisy('config', "$pfx.ignore-refs", $$ignore_refs_regex)
+ if defined $$ignore_refs_regex;
+
+ if (defined $SVN::Git::Fetcher::_preserve_empty_dirs) {
+ my $fname = \$SVN::Git::Fetcher::_placeholder_filename;
+ command_noisy('config', "$pfx.preserve-empty-dirs", 'true');
+ command_noisy('config', "$pfx.placeholder-filename", $$fname);
+ }
}
sub init_subdir {
$path = $url;
}
$path = basename($url) if !defined $path || !length $path;
+ my $authors_absolute = $_authors ? File::Spec->rel2abs($_authors) : "";
cmd_init($url, $path);
+ command_oneline('config', 'svn.authorsfile', $authors_absolute)
+ if $_authors;
Git::SVN::fetch_all($Git::SVN::default_repo_id);
- command_oneline('config', 'svn.authorsfile', $_authors) if $_authors;
}
sub cmd_init {
if (@_ > 1) {
die "Usage: $0 fetch [--all] [--parent] [svn-remote]\n";
}
+ $Git::SVN::no_reuse_existing = undef;
if ($_fetch_parent) {
my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
unless ($gs) {
unlink $gs->{index};
}
+sub split_merge_info_range {
+ my ($range) = @_;
+ if ($range =~ /(\d+)-(\d+)/) {
+ return (int($1), int($2));
+ } else {
+ return (int($range), int($range));
+ }
+}
+
+sub combine_ranges {
+ my ($in) = @_;
+
+ my @fnums = ();
+ my @arr = split(/,/, $in);
+ for my $element (@arr) {
+ my ($start, $end) = split_merge_info_range($element);
+ push @fnums, $start;
+ }
+
+ my @sorted = @arr [ sort {
+ $fnums[$a] <=> $fnums[$b]
+ } 0..$#arr ];
+
+ my @return = ();
+ my $last = -1;
+ my $first = -1;
+ for my $element (@sorted) {
+ my ($start, $end) = split_merge_info_range($element);
+
+ if ($last == -1) {
+ $first = $start;
+ $last = $end;
+ next;
+ }
+ if ($start <= $last+1) {
+ if ($end > $last) {
+ $last = $end;
+ }
+ next;
+ }
+ if ($first == $last) {
+ push @return, "$first";
+ } else {
+ push @return, "$first-$last";
+ }
+ $first = $start;
+ $last = $end;
+ }
+
+ if ($first != -1) {
+ if ($first == $last) {
+ push @return, "$first";
+ } else {
+ push @return, "$first-$last";
+ }
+ }
+
+ return join(',', @return);
+}
+
+sub merge_revs_into_hash {
+ my ($hash, $minfo) = @_;
+ my @lines = split(' ', $minfo);
+
+ for my $line (@lines) {
+ my ($branchpath, $revs) = split(/:/, $line);
+
+ if (exists($hash->{$branchpath})) {
+ # Merge the two revision sets
+ my $combined = "$hash->{$branchpath},$revs";
+ $hash->{$branchpath} = combine_ranges($combined);
+ } else {
+ # Just do range combining for consolidation
+ $hash->{$branchpath} = combine_ranges($revs);
+ }
+ }
+}
+
+sub merge_merge_info {
+ my ($mergeinfo_one, $mergeinfo_two) = @_;
+ my %result_hash = ();
+
+ merge_revs_into_hash(\%result_hash, $mergeinfo_one);
+ merge_revs_into_hash(\%result_hash, $mergeinfo_two);
+
+ my $result = '';
+ # Sort below is for consistency's sake
+ for my $branchname (sort keys(%result_hash)) {
+ my $revlist = $result_hash{$branchname};
+ $result .= "$branchname:$revlist\n"
+ }
+ return $result;
+}
+
+sub populate_merge_info {
+ my ($d, $gs, $uuid, $linear_refs, $rewritten_parent) = @_;
+
+ my %parentshash;
+ read_commit_parents(\%parentshash, $d);
+ my @parents = @{$parentshash{$d}};
+ if ($#parents > 0) {
+ # Merge commit
+ my $all_parents_ok = 1;
+ my $aggregate_mergeinfo = '';
+ my $rooturl = $gs->repos_root;
+
+ if (defined($rewritten_parent)) {
+ # Replace first parent with newly-rewritten version
+ shift @parents;
+ unshift @parents, $rewritten_parent;
+ }
+
+ foreach my $parent (@parents) {
+ my ($branchurl, $svnrev, $paruuid) =
+ cmt_metadata($parent);
+
+ unless (defined($svnrev)) {
+ # Should have been caught be preflight check
+ fatal "merge commit $d has ancestor $parent, but that change "
+ ."does not have git-svn metadata!";
+ }
+ unless ($branchurl =~ /^\Q$rooturl\E(.*)/) {
+ fatal "commit $parent git-svn metadata changed mid-run!";
+ }
+ my $branchpath = $1;
+
+ my $ra = Git::SVN::Ra->new($branchurl);
+ my (undef, undef, $props) =
+ $ra->get_dir(canonicalize_path("."), $svnrev);
+ my $par_mergeinfo = $props->{'svn:mergeinfo'};
+ unless (defined $par_mergeinfo) {
+ $par_mergeinfo = '';
+ }
+ # Merge previous mergeinfo values
+ $aggregate_mergeinfo =
+ merge_merge_info($aggregate_mergeinfo,
+ $par_mergeinfo, 0);
+
+ next if $parent eq $parents[0]; # Skip first parent
+ # Add new changes being placed in tree by merge
+ my @cmd = (qw/rev-list --reverse/,
+ $parent, qw/--not/);
+ foreach my $par (@parents) {
+ unless ($par eq $parent) {
+ push @cmd, $par;
+ }
+ }
+ my @revsin = ();
+ my ($revlist, $ctx) = command_output_pipe(@cmd);
+ while (<$revlist>) {
+ my $irev = $_;
+ chomp $irev;
+ my (undef, $csvnrev, undef) =
+ cmt_metadata($irev);
+ unless (defined $csvnrev) {
+ # A child is missing SVN annotations...
+ # this might be OK, or might not be.
+ warn "W:child $irev is merged into revision "
+ ."$d but does not have git-svn metadata. "
+ ."This means git-svn cannot determine the "
+ ."svn revision numbers to place into the "
+ ."svn:mergeinfo property. You must ensure "
+ ."a branch is entirely committed to "
+ ."SVN before merging it in order for "
+ ."svn:mergeinfo population to function "
+ ."properly";
+ }
+ push @revsin, $csvnrev;
+ }
+ command_close_pipe($revlist, $ctx);
+
+ last unless $all_parents_ok;
+
+ # We now have a list of all SVN revnos which are
+ # merged by this particular parent. Integrate them.
+ next if $#revsin == -1;
+ my $newmergeinfo = "$branchpath:" . join(',', @revsin);
+ $aggregate_mergeinfo =
+ merge_merge_info($aggregate_mergeinfo,
+ $newmergeinfo, 1);
+ }
+ if ($all_parents_ok and $aggregate_mergeinfo) {
+ return $aggregate_mergeinfo;
+ }
+ }
+
+ return undef;
+}
+
sub cmd_dcommit {
my $head = shift;
+ command_noisy(qw/update-index --refresh/);
git_cmd_try { command_oneline(qw/diff-index --quiet HEAD/) }
'Cannot dcommit with a dirty index. Commit your changes first, '
. "or stash them with `git stash'.\n";
$url = eval { command_oneline('config', '--get',
"svn-remote.$gs->{repo_id}.commiturl") };
if (!$url) {
- $url = $gs->full_url
+ $url = $gs->full_pushurl
}
}
"If these changes depend on each other, re-running ",
"without --no-rebase may be required."
}
+
+ if (defined $_interactive){
+ my $ask_default = "y";
+ foreach my $d (@$linear_refs){
+ my ($fh, $ctx) = command_output_pipe(qw(show --summary), "$d");
+ while (<$fh>){
+ print $_;
+ }
+ command_close_pipe($fh, $ctx);
+ $_ = ask("Commit this patch to SVN? ([y]es (default)|[n]o|[q]uit|[a]ll): ",
+ valid_re => qr/^(?:yes|y|no|n|quit|q|all|a)/i,
+ default => $ask_default);
+ die "Commit this patch reply required" unless defined $_;
+ if (/^[nq]/i) {
+ exit(0);
+ } elsif (/^a/i) {
+ last;
+ }
+ }
+ }
+
my $expect_url = $url;
+
+ my $push_merge_info = eval {
+ command_oneline(qw/config --get svn.pushmergeinfo/)
+ };
+ if (not defined($push_merge_info)
+ or $push_merge_info eq "false"
+ or $push_merge_info eq "no"
+ or $push_merge_info eq "never") {
+ $push_merge_info = 0;
+ }
+
+ unless (defined($_merge_info) || ! $push_merge_info) {
+ # Preflight check of changes to ensure no issues with mergeinfo
+ # This includes check for uncommitted-to-SVN parents
+ # (other than the first parent, which we will handle),
+ # information from different SVN repos, and paths
+ # which are not underneath this repository root.
+ my $rooturl = $gs->repos_root;
+ foreach my $d (@$linear_refs) {
+ my %parentshash;
+ read_commit_parents(\%parentshash, $d);
+ my @realparents = @{$parentshash{$d}};
+ if ($#realparents > 0) {
+ # Merge commit
+ shift @realparents; # Remove/ignore first parent
+ foreach my $parent (@realparents) {
+ my ($branchurl, $svnrev, $paruuid) = cmt_metadata($parent);
+ unless (defined $paruuid) {
+ # A parent is missing SVN annotations...
+ # abort the whole operation.
+ fatal "$parent is merged into revision $d, "
+ ."but does not have git-svn metadata. "
+ ."Either dcommit the branch or use a "
+ ."local cherry-pick, FF merge, or rebase "
+ ."instead of an explicit merge commit.";
+ }
+
+ unless ($paruuid eq $uuid) {
+ # Parent has SVN metadata from different repository
+ fatal "merge parent $parent for change $d has "
+ ."git-svn uuid $paruuid, while current change "
+ ."has uuid $uuid!";
+ }
+
+ unless ($branchurl =~ /^\Q$rooturl\E(.*)/) {
+ # This branch is very strange indeed.
+ fatal "merge parent $parent for $d is on branch "
+ ."$branchurl, which is not under the "
+ ."git-svn root $rooturl!";
+ }
+ }
+ }
+ }
+ }
+
+ my $rewritten_parent;
Git::SVN::remove_username($expect_url);
+ if (defined($_merge_info)) {
+ $_merge_info =~ tr{ }{\n};
+ }
while (1) {
my $d = shift @$linear_refs or last;
unless (defined $last_rev) {
print "diff-tree $d~1 $d\n";
} else {
my $cmt_rev;
+
+ unless (defined($_merge_info) || ! $push_merge_info) {
+ $_merge_info = populate_merge_info($d, $gs,
+ $uuid,
+ $linear_refs,
+ $rewritten_parent);
+ }
+
my %ed_opts = ( r => $last_rev,
log => get_commit_entry($d)->{log},
ra => Git::SVN::Ra->new($url),
print "Committed r$_[0]\n";
$cmt_rev = $_[0];
},
+ mergeinfo => $_merge_info,
svn_path => '');
if (!SVN::Git::Editor->new(\%ed_opts)->apply_diff) {
print "No changes\n$d~1 == $d\n";
@finish = qw/reset --mixed/;
}
command_noisy(@finish, $gs->refname);
+
+ $rewritten_parent = command_oneline(qw/rev-parse HEAD/);
+
if (@diff) {
@refs = ();
my ($url_, $rev_, $uuid_, $gs_) =
}
$head ||= 'HEAD';
- my ($src, $rev, undef, $gs) = working_head_info($head);
+ my (undef, $rev, undef, $gs) = working_head_info($head);
+ my $src = $gs->full_pushurl;
my $remote = Git::SVN::read_all_remotes()->{$gs->{repo_id}};
my $allglobs = $remote->{ $_tag ? 'tags' : 'branches' };
}
}
my ($lft, $rgt) = @{ $glob->{path} }{qw/left right/};
- my $dst = join '/', $remote->{url}, $lft, $branch_name, ($rgt || ());
+ my $url;
+ if (defined $_commit_url) {
+ $url = $_commit_url;
+ } else {
+ $url = eval { command_oneline('config', '--get',
+ "svn-remote.$gs->{repo_id}.commiturl") };
+ if (!$url) {
+ $url = $remote->{pushurl} || $remote->{url};
+ }
+ }
+ my $dst = join '/', $url, $lft, $branch_name, ($rgt || ());
+
+ if ($dst =~ /^https:/ && $src =~ /^http:/) {
+ $src=~s/^http:/https:/;
+ }
+
+ ::_req_svn();
my $ctx = SVN::Client->new(
auth => Git::SVN::Ra::_auth_providers(),
print "$result\n" if $result;
}
+sub auto_create_empty_directories {
+ my ($gs) = @_;
+ my $var = eval { command_oneline('config', '--get', '--bool',
+ "svn-remote.$gs->{repo_id}.automkdirs") };
+ # By default, create empty directories by consulting the unhandled log,
+ # but allow setting it to 'false' to skip it.
+ return !($var && $var eq 'false');
+}
+
sub cmd_rebase {
command_noisy(qw/update-index --refresh/);
my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
$_fetch_all ? $gs->fetch_all : $gs->fetch;
}
command_noisy(rebase_cmd(), $gs->refname);
+ if (auto_create_empty_directories($gs)) {
+ $gs->mkemptydirs;
+ }
}
sub cmd_show_ignore {
});
}
+sub cmd_mkdirs {
+ my ($url, $rev, $uuid, $gs) = working_head_info('HEAD');
+ $gs ||= Git::SVN->new;
+ $gs->mkemptydirs($_revision);
+}
+
sub canonicalize_path {
my ($path) = @_;
my $dot_slash_added = 0;
}
do_git_init_db();
if (defined $_trunk) {
+ $_trunk =~ s#^/+##;
my $trunk_ref = 'refs/remotes/' . $_prefix . 'trunk';
# try both old-style and new-style lookups:
my $gs_trunk = eval { Git::SVN->new($trunk_ref) };
}
sub cmd_multi_fetch {
+ $Git::SVN::no_reuse_existing = undef;
my $remotes = Git::SVN::read_all_remotes();
foreach my $repo_id (sort keys %$remotes) {
if ($remotes->{$repo_id}->{url}) {
if ($@) {
$result .= "Repository Root: (offline)\n";
}
+ ::_req_svn();
$result .= "Repository UUID: $uuid\n" unless $diff_status eq "A" &&
($SVN::Core::VERSION le '1.5.4' || $file_type ne "dir");
$result .= "Revision: " . ($diff_status eq "A" ? 0 : $rev) . "\n";
"history\n";
}
my ($r, $c) = $gs->find_rev_before($target, not $_fetch_parent);
+ die "Cannot find SVN revision $target\n" unless defined($c);
$gs->rev_map_set($r, $c, 'reset', $uuid);
print "r$r = $c ($gs->{ref_id})\n";
}
command_noisy(qw/read-tree -m -u -v HEAD HEAD/);
print STDERR "Checked out HEAD:\n ",
$gs->full_url, " r", $gs->last_rev, "\n";
+ if (auto_create_empty_directories($gs)) {
+ $gs->mkemptydirs($gs->last_rev);
+ }
}
sub complete_svn_url {
close $log_fh or croak $!;
if ($_edit || ($type eq 'tree')) {
- my $editor = $ENV{VISUAL} || $ENV{EDITOR} || 'vi';
- # TODO: strip out spaces, comments, like git-commit.sh
- system($editor, $commit_editmsg);
+ chomp(my $editor = command_oneline(qw(var GIT_EDITOR)));
+ system('sh', '-c', $editor.' "$@"', $editor, $commit_editmsg);
}
rename $commit_editmsg, $commit_msg or croak $!;
{
}
# convert GetOpt::Long specs for use by git-config
-sub read_repo_config {
- return unless -d $ENV{GIT_DIR};
+sub read_git_config {
my $opts = shift;
my @config_only;
foreach my $o (keys %$opts) {
sub working_head_info {
my ($head, $refs) = @_;
- my @args = ('log', '--no-color', '--first-parent', '--pretty=medium');
+ my @args = qw/rev-list --first-parent --pretty=medium/;
my ($fh, $ctx) = command_output_pipe(@args, $head);
my $hash;
my %max;
use File::Path qw/mkpath/;
use File::Copy qw/copy/;
use IPC::Open3;
+use Time::Local;
+use Memoize; # core since 5.8.0, Jul 2002
+use Memoize::Storable;
my ($_gc_nr, $_gc_period);
my $ra = Git::SVN::Ra->new($url);
my $uuid = $ra->get_uuid;
my $head = $ra->get_latest_revnum;
- $ra->get_log("", $head, 0, 1, 0, 1, sub { $head = $_[1] });
+
+ # ignore errors, $head revision may not even exist anymore
+ eval { $ra->get_log("", $head, 0, 1, 0, 1, sub { $head = $_[1] }) };
+ warn "W: $@\n" if $@;
+
my $base = defined $fetch ? $head : 0;
# read the max revs for wildcard expansion (branches/*, tags/*)
my $use_svm_props = eval { command_oneline(qw/config --bool
svn.useSvmProps/) };
$use_svm_props = $use_svm_props eq 'true' if $use_svm_props;
- my $svn_refspec = qr{\s*/?(.*?)\s*:\s*(.+?)\s*};
+ my $svn_refspec = qr{\s*(.*?)\s*:\s*(.+?)\s*};
foreach (grep { s/^svn-remote\.// } command(qw/config -l/)) {
if (m!^(.+)\.fetch=$svn_refspec$!) {
my ($remote, $local_ref, $remote_ref) = ($1, $2, $3);
die("svn-remote.$remote: remote ref '$remote_ref' "
. "must start with 'refs/'\n")
unless $remote_ref =~ m{^refs/};
+ $local_ref = uri_decode($local_ref);
$r->{$remote}->{fetch}->{$local_ref} = $remote_ref;
$r->{$remote}->{svm} = {} if $use_svm_props;
} elsif (m!^(.+)\.usesvmprops=\s*(.*)\s*$!) {
$r->{$1}->{svm} = {};
} elsif (m!^(.+)\.url=\s*(.*)\s*$!) {
$r->{$1}->{url} = $2;
+ } elsif (m!^(.+)\.pushurl=\s*(.*)\s*$!) {
+ $r->{$1}->{pushurl} = $2;
+ } elsif (m!^(.+)\.ignore-refs=\s*(.*)\s*$!) {
+ $r->{$1}->{ignore_refs_regex} = $2;
} elsif (m!^(.+)\.(branches|tags)=$svn_refspec$!) {
my ($remote, $t, $local_ref, $remote_ref) =
($1, $2, $3, $4);
die("svn-remote.$remote: remote ref '$remote_ref' ($t) "
. "must start with 'refs/'\n")
unless $remote_ref =~ m{^refs/};
+ $local_ref = uri_decode($local_ref);
my $rs = {
t => $t,
remote => $remote,
- path => Git::SVN::GlobSpec->new($local_ref),
- ref => Git::SVN::GlobSpec->new($remote_ref) };
+ path => Git::SVN::GlobSpec->new($local_ref, 1),
+ ref => Git::SVN::GlobSpec->new($remote_ref, 0) };
if (length($rs->{ref}->{right}) != 0) {
die "The '*' glob character must be the last ",
"character of '$remote_ref'\n";
}
} keys %$r;
+ foreach my $remote (keys %$r) {
+ foreach ( grep { defined $_ }
+ map { $r->{$remote}->{$_} } qw(branches tags) ) {
+ foreach my $rs ( @$_ ) {
+ $rs->{ignore_refs_regex} =
+ $r->{$remote}->{ignore_refs_regex};
+ }
+ }
+ }
+
$r;
}
my ($ref_id) = @_;
foreach (command(qw/config -l/)) {
next unless m!^svn-remote\.(.+)\.fetch=
- \s*/?(.*?)\s*:\s*(.+?)\s*$!x;
+ \s*(.*?)\s*:\s*(.+?)\s*$!x;
my ($repo_id, $path, $ref) = ($1, $2, $3);
if ($ref eq $ref_id) {
$path = '' if ($path =~ m#^\./?#);
"\":$ref_id\$\" in config\n";
($self->{path}, undef) = split(/\s*:\s*/, $fetch);
}
+ $self->{path} =~ s{/+}{/}g;
+ $self->{path} =~ s{\A/}{};
+ $self->{path} =~ s{/\z}{};
$self->{url} = command_oneline('config', '--get',
"svn-remote.$repo_id.url") or
die "Failed to read \"svn-remote.$repo_id.url\" in config\n";
+ $self->{pushurl} = eval { command_oneline('config', '--get',
+ "svn-remote.$repo_id.pushurl") };
$self->rebuild;
$self;
}
# .. becomes %2E%2E
$refname =~ s{\.\.}{%2E%2E}g;
+ # trailing dots and .lock are not allowed
+ # .$ becomes %2E and .lock becomes %2Elock
+ $refname =~ s{\.(?=$|lock$)}{%2E};
+
+ # the sequence @{ is used to access the reflog
+ # @{ becomes %40{
+ $refname =~ s{\@\{}{%40\{}g;
+
return $refname;
}
die "Can't have both 'useSvnsyncProps' and 'rewriteRoot' ",
"options set!\n";
}
+ if ($self->rewrite_uuid) {
+ die "Can't have both 'useSvnsyncProps' and 'rewriteUUID' ",
+ "options set!\n";
+ }
my $svnsync;
# see if we have it in our config, first:
next if $seen{$p};
$seen{$p} = 1;
push @ret, $p;
- # MAXPARENT is defined to 16 in commit-tree.c:
- last if @ret >= 16;
- }
- if (@tmp) {
- die "r$log_entry->{revision}: No room for parents:\n\t",
- join("\n\t", @tmp), "\n";
}
@ret;
}
$self->{-rewrite_root} = $rwr;
}
+sub rewrite_uuid {
+ my ($self) = @_;
+ return $self->{-rewrite_uuid} if exists $self->{-rewrite_uuid};
+ my $k = "svn-remote.$self->{repo_id}.rewriteUUID";
+ my $rwid = eval { command_oneline(qw/config --get/, $k) };
+ if ($rwid) {
+ $rwid =~ s#/+$##;
+ if ($rwid !~ m#^[a-f0-9]{8}-(?:[a-f0-9]{4}-){3}[a-f0-9]{12}$#) {
+ die "$rwid is not a valid UUID (key: $k)\n";
+ }
+ }
+ $self->{-rewrite_uuid} = $rwid;
+}
+
sub metadata_url {
my ($self) = @_;
($self->rewrite_root || $self->{url}) .
$self->{url} . (length $self->{path} ? '/' . $self->{path} : '');
}
+sub full_pushurl {
+ my ($self) = @_;
+ if ($self->{pushurl}) {
+ return $self->{pushurl} . (length $self->{path} ? '/' .
+ $self->{path} : '');
+ } else {
+ return $self->full_url;
+ }
+}
sub set_commit_header_env {
my ($log_entry) = @_;
$self->make_log_entry($rev, \@parents, $ed);
}
+sub mkemptydirs {
+ my ($self, $r) = @_;
+
+ sub scan {
+ my ($r, $empty_dirs, $line) = @_;
+ if (defined $r && $line =~ /^r(\d+)$/) {
+ return 0 if $1 > $r;
+ } elsif ($line =~ /^ \+empty_dir: (.+)$/) {
+ $empty_dirs->{$1} = 1;
+ } elsif ($line =~ /^ \-empty_dir: (.+)$/) {
+ my @d = grep {m[^\Q$1\E(/|$)]} (keys %$empty_dirs);
+ delete @$empty_dirs{@d};
+ }
+ 1; # continue
+ };
+
+ my %empty_dirs = ();
+ my $gz_file = "$self->{dir}/unhandled.log.gz";
+ if (-f $gz_file) {
+ if (!$can_compress) {
+ warn "Compress::Zlib could not be found; ",
+ "empty directories in $gz_file will not be read\n";
+ } else {
+ my $gz = Compress::Zlib::gzopen($gz_file, "rb") or
+ die "Unable to open $gz_file: $!\n";
+ my $line;
+ while ($gz->gzreadline($line) > 0) {
+ scan($r, \%empty_dirs, $line) or last;
+ }
+ $gz->gzclose;
+ }
+ }
+
+ if (open my $fh, '<', "$self->{dir}/unhandled.log") {
+ binmode $fh or croak "binmode: $!";
+ while (<$fh>) {
+ scan($r, \%empty_dirs, $_) or last;
+ }
+ close $fh;
+ }
+
+ my $strip = qr/\A\Q$self->{path}\E(?:\/|$)/;
+ foreach my $d (sort keys %empty_dirs) {
+ $d = uri_decode($d);
+ $d =~ s/$strip//;
+ next unless length($d);
+ next if -d $d;
+ if (-e $d) {
+ warn "$d exists but is not a directory\n";
+ } else {
+ print "creating empty directory: $d\n";
+ mkpath([$d]);
+ }
+ }
+}
+
sub get_untracked {
my ($self, $ed) = @_;
my @out;
\@out;
}
+sub get_tz {
+ # some systmes don't handle or mishandle %z, so be creative.
+ my $t = shift || time;
+ my $gm = timelocal(gmtime($t));
+ my $sign = qw( + + - )[ $t <=> $gm ];
+ return sprintf("%s%02d%02d", $sign, (gmtime(abs($t - $gm)))[2,1]);
+}
+
# parse_svn_date(DATE)
# --------------------
# Given a date (in UTC) from Subversion, return a string in the format
delete $ENV{TZ};
}
- my $our_TZ =
- POSIX::strftime('%Z', $S, $M, $H, $d, $m - 1, $Y - 1900);
+ my $our_TZ = get_tz();
# This converts $epoch_in_UTC into our local timezone.
my ($sec, $min, $hour, $mday, $mon, $year,
my $gs = Git::SVN->find_by_url($new_url, $url, $branch_from);
unless ($gs) {
my $ref_id = $old_ref_id;
- $ref_id =~ s/\@\d+$//;
+ $ref_id =~ s/\@\d+-*$//;
$ref_id .= "\@$r";
# 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" unless $::_q > 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);
+ while (1) {
+ # It is possible to tag two different subdirectories at
+ # the same revision. If the url for an existing ref
+ # does not match, we must either find a ref with a
+ # matching url or create a new ref by growing a tail.
+ $gs = Git::SVN->init($u, $p, $repo_id, $ref_id, 1);
+ my (undef, $max_commit) = $gs->rev_map_max(1);
+ last if (!$max_commit);
+ my ($url) = ::cmt_metadata($max_commit);
+ last if ($url eq $gs->metadata_url);
+ $ref_id .= '-';
+ }
+ print STDERR "Initializing parent: $ref_id\n" unless $::_q > 1;
}
$gs
}
$author;
}
+sub find_extra_svk_parents {
+ my ($self, $ed, $tickets, $parents) = @_;
+ # aha! svk:merge property changed...
+ my @tickets = split "\n", $tickets;
+ my @known_parents;
+ for my $ticket ( @tickets ) {
+ my ($uuid, $path, $rev) = split /:/, $ticket;
+ if ( $uuid eq $self->ra_uuid ) {
+ my $url = $self->{url};
+ my $repos_root = $url;
+ my $branch_from = $path;
+ $branch_from =~ s{^/}{};
+ my $gs = $self->other_gs($repos_root."/".$branch_from,
+ $url,
+ $branch_from,
+ $rev,
+ $self->{ref_id});
+ if ( my $commit = $gs->rev_map_get($rev, $uuid) ) {
+ # wahey! we found it, but it might be
+ # an old one (!)
+ push @known_parents, [ $rev, $commit ];
+ }
+ }
+ }
+ # Ordering matters; highest-numbered commit merge tickets
+ # first, as they may account for later merge ticket additions
+ # or changes.
+ @known_parents = map {$_->[1]} sort {$b->[0] <=> $a->[0]} @known_parents;
+ for my $parent ( @known_parents ) {
+ my @cmd = ('rev-list', $parent, map { "^$_" } @$parents );
+ my ($msg_fh, $ctx) = command_output_pipe(@cmd);
+ my $new;
+ while ( <$msg_fh> ) {
+ $new=1;last;
+ }
+ command_close_pipe($msg_fh, $ctx);
+ if ( $new ) {
+ print STDERR
+ "Found merge parent (svk:merge ticket): $parent\n";
+ push @$parents, $parent;
+ }
+ }
+}
+
+sub lookup_svn_merge {
+ my $uuid = shift;
+ my $url = shift;
+ my $merge = shift;
+
+ my ($source, $revs) = split ":", $merge;
+ my $path = $source;
+ $path =~ s{^/}{};
+ my $gs = Git::SVN->find_by_url($url.$source, $url, $path);
+ if ( !$gs ) {
+ warn "Couldn't find revmap for $url$source\n";
+ return;
+ }
+ my @ranges = split ",", $revs;
+ my ($tip, $tip_commit);
+ my @merged_commit_ranges;
+ # find the tip
+ for my $range ( @ranges ) {
+ my ($bottom, $top) = split "-", $range;
+ $top ||= $bottom;
+ my $bottom_commit = $gs->find_rev_after( $bottom, 1, $top );
+ my $top_commit = $gs->find_rev_before( $top, 1, $bottom );
+
+ unless ($top_commit and $bottom_commit) {
+ warn "W:unknown path/rev in svn:mergeinfo "
+ ."dirprop: $source:$range\n";
+ next;
+ }
+
+ if (scalar(command('rev-parse', "$bottom_commit^@"))) {
+ push @merged_commit_ranges,
+ "$bottom_commit^..$top_commit";
+ } else {
+ push @merged_commit_ranges, "$top_commit";
+ }
+
+ if ( !defined $tip or $top > $tip ) {
+ $tip = $top;
+ $tip_commit = $top_commit;
+ }
+ }
+ return ($tip_commit, @merged_commit_ranges);
+}
+
+sub _rev_list {
+ my ($msg_fh, $ctx) = command_output_pipe(
+ "rev-list", @_,
+ );
+ my @rv;
+ while ( <$msg_fh> ) {
+ chomp;
+ push @rv, $_;
+ }
+ command_close_pipe($msg_fh, $ctx);
+ @rv;
+}
+
+sub check_cherry_pick {
+ my $base = shift;
+ my $tip = shift;
+ my $parents = shift;
+ my @ranges = @_;
+ my %commits = map { $_ => 1 }
+ _rev_list("--no-merges", $tip, "--not", $base, @$parents, "--");
+ for my $range ( @ranges ) {
+ delete @commits{_rev_list($range, "--")};
+ }
+ for my $commit (keys %commits) {
+ if (has_no_changes($commit)) {
+ delete $commits{$commit};
+ }
+ }
+ return (keys %commits);
+}
+
+sub has_no_changes {
+ my $commit = shift;
+
+ my @revs = split / /, command_oneline(
+ qw(rev-list --parents -1 -m), $commit);
+
+ # Commits with no parents, e.g. the start of a partial branch,
+ # have changes by definition.
+ return 1 if (@revs < 2);
+
+ # Commits with multiple parents, e.g a merge, have no changes
+ # by definition.
+ return 0 if (@revs > 2);
+
+ return (command_oneline("rev-parse", "$commit^{tree}") eq
+ command_oneline("rev-parse", "$commit~1^{tree}"));
+}
+
+# The GIT_DIR environment variable is not always set until after the command
+# line arguments are processed, so we can't memoize in a BEGIN block.
+{
+ my $memoized = 0;
+
+ sub memoize_svn_mergeinfo_functions {
+ return if $memoized;
+ $memoized = 1;
+
+ my $cache_path = "$ENV{GIT_DIR}/svn/.caches/";
+ mkpath([$cache_path]) unless -d $cache_path;
+
+ tie my %lookup_svn_merge_cache => 'Memoize::Storable',
+ "$cache_path/lookup_svn_merge.db", 'nstore';
+ memoize 'lookup_svn_merge',
+ SCALAR_CACHE => 'FAULT',
+ LIST_CACHE => ['HASH' => \%lookup_svn_merge_cache],
+ ;
+
+ tie my %check_cherry_pick_cache => 'Memoize::Storable',
+ "$cache_path/check_cherry_pick.db", 'nstore';
+ memoize 'check_cherry_pick',
+ SCALAR_CACHE => 'FAULT',
+ LIST_CACHE => ['HASH' => \%check_cherry_pick_cache],
+ ;
+
+ tie my %has_no_changes_cache => 'Memoize::Storable',
+ "$cache_path/has_no_changes.db", 'nstore';
+ memoize 'has_no_changes',
+ SCALAR_CACHE => ['HASH' => \%has_no_changes_cache],
+ LIST_CACHE => 'FAULT',
+ ;
+ }
+
+ sub unmemoize_svn_mergeinfo_functions {
+ return if not $memoized;
+ $memoized = 0;
+
+ Memoize::unmemoize 'lookup_svn_merge';
+ Memoize::unmemoize 'check_cherry_pick';
+ Memoize::unmemoize 'has_no_changes';
+ }
+
+ Memoize::memoize 'Git::SVN::repos_root';
+}
+
+END {
+ # Force cache writeout explicitly instead of waiting for
+ # global destruction to avoid segfault in Storable:
+ # http://rt.cpan.org/Public/Bug/Display.html?id=36087
+ unmemoize_svn_mergeinfo_functions();
+}
+
+sub parents_exclude {
+ my $parents = shift;
+ my @commits = @_;
+ return unless @commits;
+
+ my @excluded;
+ my $excluded;
+ do {
+ my @cmd = ('rev-list', "-1", @commits, "--not", @$parents );
+ $excluded = command_oneline(@cmd);
+ if ( $excluded ) {
+ my @new;
+ my $found;
+ for my $commit ( @commits ) {
+ if ( $commit eq $excluded ) {
+ push @excluded, $commit;
+ $found++;
+ last;
+ }
+ else {
+ push @new, $commit;
+ }
+ }
+ die "saw commit '$excluded' in rev-list output, "
+ ."but we didn't ask for that commit (wanted: @commits --not @$parents)"
+ unless $found;
+ @commits = @new;
+ }
+ }
+ while ($excluded and @commits);
+
+ return @excluded;
+}
+
+
+# note: this function should only be called if the various dirprops
+# have actually changed
+sub find_extra_svn_parents {
+ my ($self, $ed, $mergeinfo, $parents) = @_;
+ # aha! svk:merge property changed...
+
+ memoize_svn_mergeinfo_functions();
+
+ # We first search for merged tips which are not in our
+ # history. Then, we figure out which git revisions are in
+ # that tip, but not this revision. If all of those revisions
+ # are now marked as merge, we can add the tip as a parent.
+ my @merges = split "\n", $mergeinfo;
+ my @merge_tips;
+ my $url = $self->{url};
+ my $uuid = $self->ra_uuid;
+ my %ranges;
+ for my $merge ( @merges ) {
+ my ($tip_commit, @ranges) =
+ lookup_svn_merge( $uuid, $url, $merge );
+ unless (!$tip_commit or
+ grep { $_ eq $tip_commit } @$parents ) {
+ push @merge_tips, $tip_commit;
+ $ranges{$tip_commit} = \@ranges;
+ } else {
+ push @merge_tips, undef;
+ }
+ }
+
+ my %excluded = map { $_ => 1 }
+ parents_exclude($parents, grep { defined } @merge_tips);
+
+ # check merge tips for new parents
+ my @new_parents;
+ for my $merge_tip ( @merge_tips ) {
+ my $spec = shift @merges;
+ next unless $merge_tip and $excluded{$merge_tip};
+
+ my $ranges = $ranges{$merge_tip};
+
+ # check out 'new' tips
+ my $merge_base;
+ eval {
+ $merge_base = command_oneline(
+ "merge-base",
+ @$parents, $merge_tip,
+ );
+ };
+ if ($@) {
+ die "An error occurred during merge-base"
+ unless $@->isa("Git::Error::Command");
+
+ warn "W: Cannot find common ancestor between ".
+ "@$parents and $merge_tip. Ignoring merge info.\n";
+ next;
+ }
+
+ # double check that there are no missing non-merge commits
+ my (@incomplete) = check_cherry_pick(
+ $merge_base, $merge_tip,
+ $parents,
+ @$ranges,
+ );
+
+ if ( @incomplete ) {
+ warn "W:svn cherry-pick ignored ($spec) - missing "
+ .@incomplete." commit(s) (eg $incomplete[0])\n";
+ } else {
+ warn
+ "Found merge parent (svn:mergeinfo prop): ",
+ $merge_tip, "\n";
+ push @new_parents, $merge_tip;
+ }
+ }
+
+ # cater for merges which merge commits from multiple branches
+ if ( @new_parents > 1 ) {
+ for ( my $i = 0; $i <= $#new_parents; $i++ ) {
+ for ( my $j = 0; $j <= $#new_parents; $j++ ) {
+ next if $i == $j;
+ next unless $new_parents[$i];
+ next unless $new_parents[$j];
+ my $revs = command_oneline(
+ "rev-list", "-1",
+ "$new_parents[$i]..$new_parents[$j]",
+ );
+ if ( !$revs ) {
+ undef($new_parents[$j]);
+ }
+ }
+ }
+ }
+ push @$parents, grep { defined } @new_parents;
+}
+
sub make_log_entry {
my ($self, $rev, $parents, $ed) = @_;
my $untracked = $self->get_untracked($ed);
+ my @parents = @$parents;
+ my $ps = $ed->{path_strip} || "";
+ for my $path ( grep { m/$ps/ } %{$ed->{dir_prop}} ) {
+ my $props = $ed->{dir_prop}{$path};
+ if ( $props->{"svk:merge"} ) {
+ $self->find_extra_svk_parents
+ ($ed, $props->{"svk:merge"}, \@parents);
+ }
+ if ( $props->{"svn:mergeinfo"} ) {
+ $self->find_extra_svn_parents
+ ($ed,
+ $props->{"svn:mergeinfo"},
+ \@parents);
+ }
+ }
+
open my $un, '>>', "$self->{dir}/unhandled.log" or croak $!;
print $un "r$rev\n" or croak $!;
print $un $_, "\n" foreach @$untracked;
- my %log_entry = ( parents => $parents || [], revision => $rev,
+ my %log_entry = ( parents => \@parents, revision => $rev,
log => '');
my $headrev;
die "Can't have both 'useSvmProps' and 'rewriteRoot' ",
"options set!\n";
}
+ if ($self->rewrite_uuid) {
+ die "Can't have both 'useSvmProps' and 'rewriteUUID' ",
+ "options set!\n";
+ }
my ($uuid, $r) = $headrev =~ m{^([a-f\d\-]{30,}):(\d+)$}i;
# we don't want "SVM: initializing mirror for junk" ...
return undef if $r == 0;
} else {
my $url = $self->metadata_url;
remove_username($url);
- $log_entry{metadata} = "$url\@$rev " .
- $self->ra->get_uuid;
- $email ||= "$author\@" . $self->ra->get_uuid;
- $commit_email ||= "$author\@" . $self->ra->get_uuid;
+ my $uuid = $self->rewrite_uuid || $self->ra->get_uuid;
+ $log_entry{metadata} = "$url\@$rev " . $uuid;
+ $email ||= "$author\@" . $uuid;
+ $commit_email ||= "$author\@" . $uuid;
}
$log_entry{name} = $name;
$log_entry{email} = $email;
my ($base_rev, $head) = ($partial ? $self->rev_map_max_norebuild(1) :
(undef, undef));
my ($log, $ctx) =
- command_output_pipe(qw/rev-list --pretty=raw --no-color --reverse/,
+ command_output_pipe(qw/rev-list --pretty=raw --reverse/,
($head ? "$head.." : "") . $self->refname,
'--');
my $metadata_url = $self->metadata_url;
remove_username($metadata_url);
- my $svn_uuid = $self->ra_uuid;
+ my $svn_uuid = $self->rewrite_uuid || $self->ra_uuid;
my $c;
while (<$log>) {
if ( m{^commit ($::sha1)$} ) {
sub rev_map_set {
my ($self, $rev, $commit, $update_ref, $uuid) = @_;
+ defined $commit or die "missing arg3\n";
length $commit == 40 or die "arg3 must be a full SHA1 hexsum\n";
my $db = $self->map_path($uuid);
my $db_lock = "$db.lock";
$f
}
+sub uri_decode {
+ my ($f) = @_;
+ $f =~ s#%([0-9a-fA-F]{2})#chr(hex($1))#eg;
+ $f
+}
+
sub remove_username {
$_[0] =~ s{^([^:]*://)[^@]+@}{$1};
}
sub _read_password {
my ($prompt, $realm) = @_;
- print STDERR $prompt;
- STDERR->flush;
- require Term::ReadKey;
- Term::ReadKey::ReadMode('noecho');
my $password = '';
- while (defined(my $key = Term::ReadKey::ReadKey(0))) {
- last if $key =~ /[\012\015]/; # \n\r
- $password .= $key;
+ if (exists $ENV{GIT_ASKPASS}) {
+ open(PH, "-|", $ENV{GIT_ASKPASS}, $prompt);
+ $password = <PH>;
+ $password =~ s/[\012\015]//; # \n\r
+ close(PH);
+ } else {
+ print STDERR $prompt;
+ STDERR->flush;
+ require Term::ReadKey;
+ Term::ReadKey::ReadMode('noecho');
+ while (defined(my $key = Term::ReadKey::ReadKey(0))) {
+ last if $key =~ /[\012\015]/; # \n\r
+ $password .= $key;
+ }
+ Term::ReadKey::ReadMode('restore');
+ print STDERR "\n";
+ STDERR->flush;
}
- Term::ReadKey::ReadMode('restore');
- print STDERR "\n";
- STDERR->flush;
$password;
}
package SVN::Git::Fetcher;
-use vars qw/@ISA/;
+use vars qw/@ISA $_ignore_regex $_preserve_empty_dirs $_placeholder_filename
+ @deleted_gpath %added_placeholder $repo_id/;
use strict;
use warnings;
use Carp qw/croak/;
-use File::Temp qw/tempfile/;
+use File::Basename qw/dirname/;
use IO::File qw//;
-use vars qw/$_ignore_regex/;
# file baton members: path, mode_a, mode_b, pool, fh, blob, base
sub new {
$self->{empty_symlinks} =
_mark_empty_symlinks($git_svn, $switch_path);
}
- $self->{ignore_regex} = eval { command_oneline('config', '--get',
- "svn-remote.$git_svn->{repo_id}.ignore-paths") };
+
+ # 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
+ $repo_id = $git_svn->{repo_id};
+ my $k = "svn-remote.$repo_id.ignore-paths";
+ my $v = eval { command_oneline('config', '--get', $k) };
+ $self->{ignore_regex} = $v;
+
+ $k = "svn-remote.$repo_id.preserve-empty-dirs";
+ $v = eval { command_oneline('config', '--get', '--bool', $k) };
+ if ($v && $v eq 'true') {
+ $_preserve_empty_dirs = 1;
+ $k = "svn-remote.$repo_id.placeholder-filename";
+ $v = eval { command_oneline('config', '--get', $k) };
+ $_placeholder_filename = $v;
+ }
+
+ # Load the list of placeholder files added during previous invocations.
+ $k = "svn-remote.$repo_id.added-placeholder";
+ $v = eval { command_oneline('config', '--get-all', $k) };
+ if ($_preserve_empty_dirs && $v) {
+ # command() prints errors to stderr, so we only call it if
+ # command_oneline() succeeded.
+ my @v = command('config', '--get-all', $k);
+ $added_placeholder{ dirname($_) } = $_ foreach @v;
+ }
+
$self->{empty} = {};
$self->{dir_prop} = {};
$self->{file_prop} = {};
$self->{absent_dir} = {};
$self->{absent_file} = {};
$self->{gii} = $git_svn->tmp_index_do(sub { Git::IndexInfo->new });
+ $self->{pathnameencoding} = Git::config('svn.pathnameencoding');
$self;
}
sub git_path {
my ($self, $path) = @_;
+ if (my $enc = $self->{pathnameencoding}) {
+ require Encode;
+ Encode::from_to($path, 'UTF-8', $enc);
+ }
if ($self->{path_strip}) {
$path =~ s!$self->{path_strip}!! or
die "Failed to strip path '$path' ($self->{path_strip})\n";
}
print "\tD\t$gpath/\n" unless $::_q;
command_close_pipe($ls, $ctx);
- $self->{empty}->{$path} = 0
} else {
$self->{gii}->remove($gpath);
print "\tD\t$gpath\n" unless $::_q;
}
+ # Don't add to @deleted_gpath if we're deleting a placeholder file.
+ push @deleted_gpath, $gpath unless $added_placeholder{dirname($path)};
+ $self->{empty}->{$path} = 0;
undef;
}
my ($dir, $file) = ($path =~ m#^(.*?)/?([^/]+)$#);
delete $self->{empty}->{$dir};
$mode = '100644';
+
+ if ($added_placeholder{$dir}) {
+ # Remove our placeholder file, if we created one.
+ delete_entry($self, $added_placeholder{$dir})
+ unless $path eq $added_placeholder{$dir};
+ delete $added_placeholder{$dir}
+ }
}
+
{ path => $path, mode_a => $mode, mode_b => $mode,
pool => SVN::Pool->new, action => 'A' };
}
chomp;
$self->{gii}->remove($_);
print "\tD\t$_\n" unless $::_q;
+ push @deleted_gpath, $gpath;
}
command_close_pipe($ls, $ctx);
$self->{empty}->{$path} = 0;
my ($dir, $file) = ($path =~ m#^(.*?)/?([^/]+)$#);
delete $self->{empty}->{$dir};
$self->{empty}->{$path} = 1;
+
+ if ($added_placeholder{$dir}) {
+ # Remove our placeholder file, if we created one.
+ delete_entry($self, $added_placeholder{$dir});
+ delete $added_placeholder{$dir}
+ }
+
out:
{ path => $path };
}
sub close_edit {
my $self = shift;
+
+ if ($_preserve_empty_dirs) {
+ my @empty_dirs;
+
+ # Any entry flagged as empty that also has an associated
+ # dir_prop represents a newly created empty directory.
+ foreach my $i (keys %{$self->{empty}}) {
+ push @empty_dirs, $i if exists $self->{dir_prop}->{$i};
+ }
+
+ # Search for directories that have become empty due subsequent
+ # file deletes.
+ push @empty_dirs, $self->find_empty_directories();
+
+ # Finally, add a placeholder file to each empty directory.
+ $self->add_placeholder_file($_) foreach (@empty_dirs);
+
+ $self->stash_placeholder_list();
+ }
+
$self->{git_commit_ok} = 1;
$self->{nr} = $self->{gii}->{nr};
delete $self->{gii};
$self->SUPER::close_edit(@_);
}
+sub find_empty_directories {
+ my ($self) = @_;
+ my @empty_dirs;
+ my %dirs = map { dirname($_) => 1 } @deleted_gpath;
+
+ foreach my $dir (sort keys %dirs) {
+ next if $dir eq ".";
+
+ # If there have been any additions to this directory, there is
+ # no reason to check if it is empty.
+ my $skip_added = 0;
+ foreach my $t (qw/dir_prop file_prop/) {
+ foreach my $path (keys %{ $self->{$t} }) {
+ if (exists $self->{$t}->{dirname($path)}) {
+ $skip_added = 1;
+ last;
+ }
+ }
+ last if $skip_added;
+ }
+ next if $skip_added;
+
+ # Use `git ls-tree` to get the filenames of this directory
+ # that existed prior to this particular commit.
+ my $ls = command('ls-tree', '-z', '--name-only',
+ $self->{c}, "$dir/");
+ my %files = map { $_ => 1 } split(/\0/, $ls);
+
+ # Remove the filenames that were deleted during this commit.
+ delete $files{$_} foreach (@deleted_gpath);
+
+ # Report the directory if there are no filenames left.
+ push @empty_dirs, $dir unless (scalar %files);
+ }
+ @empty_dirs;
+}
+
+sub add_placeholder_file {
+ my ($self, $dir) = @_;
+ my $path = "$dir/$_placeholder_filename";
+ my $gpath = $self->git_path($path);
+
+ my $fh = $::_repository->temp_acquire($gpath);
+ my $hash = $::_repository->hash_and_insert_object(Git::temp_path($fh));
+ Git::temp_release($fh, 1);
+ $self->{gii}->update('100644', $hash, $gpath) or croak $!;
+
+ # The directory should no longer be considered empty.
+ delete $self->{empty}->{$dir} if exists $self->{empty}->{$dir};
+
+ # Keep track of any placeholder files we create.
+ $added_placeholder{$dir} = $path;
+}
+
+sub stash_placeholder_list {
+ my ($self) = @_;
+ my $k = "svn-remote.$repo_id.added-placeholder";
+ my $v = eval { command_oneline('config', '--get-all', $k) };
+ command_noisy('config', '--unset-all', $k) if $v;
+ foreach (values %added_placeholder) {
+ command_noisy('config', '--add', $k, $_);
+ }
+}
+
package SVN::Git::Editor;
use vars qw/@ISA $_rmdir $_cp_similarity $_find_copies_harder $_rename_limit/;
use strict;
$self->{path_prefix} = length $self->{svn_path} ?
"$self->{svn_path}/" : '';
$self->{config} = $opts->{config};
+ $self->{mergeinfo} = $opts->{mergeinfo};
return $self;
}
sub repo_path {
my ($self, $path) = @_;
+ if (my $enc = $self->{pathnameencoding}) {
+ require Encode;
+ Encode::from_to($path, $enc, 'UTF-8');
+ }
$self->{path_prefix}.(defined $path ? $path : '');
}
}
sub open_or_add_dir {
- my ($self, $full_path, $baton) = @_;
+ my ($self, $full_path, $baton, $deletions) = @_;
my $t = $self->{types}->{$full_path};
if (!defined $t) {
die "$full_path not known in r$self->{r} or we have a bug!\n";
no warnings 'once';
# SVN::Node::none and SVN::Node::file are used only once,
# so we're shutting up Perl's warnings about them.
- if ($t == $SVN::Node::none) {
+ if ($t == $SVN::Node::none || defined($deletions->{$full_path})) {
return $self->add_directory($full_path, $baton,
undef, -1, $self->{pool});
} elsif ($t == $SVN::Node::dir) {
}
sub ensure_path {
- my ($self, $path) = @_;
+ my ($self, $path, $deletions) = @_;
my $bat = $self->{bat};
my $repo_path = $self->repo_path($path);
return $bat->{''} unless (length $repo_path);
+
my @p = split m#/+#, $repo_path;
my $c = shift @p;
- $bat->{$c} ||= $self->open_or_add_dir($c, $bat->{''});
+ $bat->{$c} ||= $self->open_or_add_dir($c, $bat->{''}, $deletions);
while (@p) {
my $c0 = $c;
$c .= '/' . shift @p;
- $bat->{$c} ||= $self->open_or_add_dir($c, $bat->{$c0});
+ $bat->{$c} ||= $self->open_or_add_dir($c, $bat->{$c0}, $deletions);
}
return $bat->{$c};
}
}
sub A {
- my ($self, $m) = @_;
+ my ($self, $m, $deletions) = @_;
my ($dir, $file) = split_path($m->{file_b});
- my $pbat = $self->ensure_path($dir);
+ my $pbat = $self->ensure_path($dir, $deletions);
my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
undef, -1);
print "\tA\t$m->{file_b}\n" unless $::_q;
}
sub C {
- my ($self, $m) = @_;
+ my ($self, $m, $deletions) = @_;
my ($dir, $file) = split_path($m->{file_b});
- my $pbat = $self->ensure_path($dir);
+ my $pbat = $self->ensure_path($dir, $deletions);
my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
$self->url_path($m->{file_a}), $self->{r});
print "\tC\t$m->{file_a} => $m->{file_b}\n" unless $::_q;
}
sub R {
- my ($self, $m) = @_;
+ my ($self, $m, $deletions) = @_;
my ($dir, $file) = split_path($m->{file_b});
- my $pbat = $self->ensure_path($dir);
+ my $pbat = $self->ensure_path($dir, $deletions);
my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
$self->url_path($m->{file_a}), $self->{r});
print "\tR\t$m->{file_a} => $m->{file_b}\n" unless $::_q;
$self->close_file($fbat,undef,$self->{pool});
($dir, $file) = split_path($m->{file_a});
- $pbat = $self->ensure_path($dir);
+ $pbat = $self->ensure_path($dir, $deletions);
$self->delete_entry($m->{file_a}, $pbat);
}
sub M {
- my ($self, $m) = @_;
+ my ($self, $m, $deletions) = @_;
my ($dir, $file) = split_path($m->{file_b});
- my $pbat = $self->ensure_path($dir);
+ my $pbat = $self->ensure_path($dir, $deletions);
my $fbat = $self->open_file($self->repo_path($m->{file_b}),
$pbat,$self->{r},$self->{pool});
print "\t$m->{chg}\t$m->{file_b}\n" unless $::_q;
$self->SUPER::change_file_prop($fbat, $pname, $pval, $self->{pool});
}
+sub change_dir_prop {
+ my ($self, $pbat, $pname, $pval) = @_;
+ $self->SUPER::change_dir_prop($pbat, $pname, $pval, $self->{pool});
+}
+
sub _chg_file_get_blob ($$$$) {
my ($self, $fbat, $m, $which) = @_;
my $fh = $::_repository->temp_acquire("git_blob_$which");
}
sub D {
- my ($self, $m) = @_;
+ my ($self, $m, $deletions) = @_;
my ($dir, $file) = split_path($m->{file_b});
- my $pbat = $self->ensure_path($dir);
+ my $pbat = $self->ensure_path($dir, $deletions);
print "\tD\t$m->{file_b}\n" unless $::_q;
$self->delete_entry($m->{file_b}, $pbat);
}
sub apply_diff {
my ($self) = @_;
my $mods = $self->{mods};
- my %o = ( D => 1, R => 0, C => -1, A => 3, M => 3, T => 3 );
+ my %o = ( D => 0, C => 1, R => 2, A => 3, M => 4, T => 5 );
+ my %deletions;
+
+ foreach my $m (@$mods) {
+ if ($m->{chg} eq "D") {
+ $deletions{$m->{file_b}} = 1;
+ }
+ }
+
foreach my $m (sort { $o{$a->{chg}} <=> $o{$b->{chg}} } @$mods) {
my $f = $m->{chg};
if (defined $o{$f}) {
- $self->$f($m);
+ $self->$f($m, \%deletions);
} else {
fatal("Invalid change type: $f");
}
}
+
+ if (defined($self->{mergeinfo})) {
+ $self->change_dir_prop($self->{bat}{''}, "svn:mergeinfo",
+ $self->{mergeinfo});
+ }
$self->rmdirs if $_rmdir;
- if (@$mods == 0) {
+ if (@$mods == 0 && !defined($self->{mergeinfo})) {
$self->abort_edit;
} else {
$self->close_edit;
}
package Git::SVN::Ra;
-use vars qw/@ISA $config_dir $_log_window_size/;
+use vars qw/@ISA $config_dir $_ignore_refs_regex $_log_window_size/;
use strict;
use warnings;
my ($ra_invalid, $can_do_switch, %ignored_err, $RA);
$url =~ s!/+$!!;
return $RA if ($RA && $RA->{url} eq $url);
+ ::_req_svn();
+
SVN::_Core::svn_config_ensure($config_dir, undef);
my ($baton, $callbacks) = SVN::Core::auth_open_helper(_auth_providers);
my $config = SVN::Core::config_get_config($config_dir);
@finalents;
}
+# return value: 0 -- don't ignore, 1 -- ignore
+sub is_ref_ignored {
+ my ($g, $p) = @_;
+ my $refname = $g->{ref}->full_path($p);
+ return 1 if defined($g->{ignore_refs_regex}) &&
+ $refname =~ m!$g->{ignore_refs_regex}!;
+ return 0 unless defined($_ignore_refs_regex);
+ return 1 if $refname =~ m!$_ignore_refs_regex!o;
+ return 0;
+}
+
sub match_globs {
my ($self, $exists, $paths, $globs, $r) = @_;
next if (length $g->{path}->{right} &&
($self->check_path($p, $r) !=
$SVN::Node::dir));
+ next unless $p =~ /$g->{path}->{regex}/;
$exists->{$p} = Git::SVN->init($self->{url}, $p, undef,
$g->{ref}->full_path($de), 1);
}
next unless /$g->{path}->{regex}/;
my $p = $1;
my $pathname = $g->{path}->full_path($p);
+ next if is_ref_ignored($g, $p);
next if $exists->{$pathname};
next if ($self->check_path($pathname, $r) !=
$SVN::Node::dir);
use strict;
use warnings;
use POSIX qw/strftime/;
-use Time::Local;
use constant commit_log_separator => ('-' x 72) . "\n";
use vars qw/$TZ $limit $color $pager $non_recursive $verbose $oneline
%rusers $show_commit $incremental/;
# adapted from pager.c
sub config_pager {
- $pager ||= $ENV{GIT_PAGER} || $ENV{PAGER};
- if (!defined $pager) {
- $pager = 'less';
- } elsif (length $pager == 0 || $pager eq 'cat') {
+ if (! -t *STDOUT) {
+ $ENV{GIT_PAGER_IN_USE} = 'false';
+ $pager = undef;
+ return;
+ }
+ chomp($pager = command_oneline(qw(var GIT_PAGER)));
+ if ($pager eq 'cat') {
$pager = undef;
}
$ENV{GIT_PAGER_IN_USE} = defined($pager);
}
sub run_pager {
- return unless -t *STDOUT && defined $pager;
+ return unless defined $pager;
pipe my ($rfd, $wfd) or return;
defined(my $pid = fork) or ::fatal "Can't fork: $!";
if (!$pid) {
}
sub format_svn_date {
- # some systmes don't handle or mishandle %z, so be creative.
my $t = shift || time;
- my $gm = timelocal(gmtime($t));
- my $sign = qw( + + - )[ $t <=> $gm ];
- my $gmoff = sprintf("%s%02d%02d", $sign, (gmtime(abs($t - $gm)))[2,1]);
+ my $gmoff = Git::SVN::get_tz($t);
return strftime("%Y-%m-%d %H:%M:%S $gmoff (%a, %d %b %Y)", localtime($t));
}
my (@k, $c, $d, $stat);
my $esc_color = qr/(?:\033\[(?:(?:\d+;)*\d*)?m)*/;
while (<$log>) {
- if (/^${esc_color}commit -?($::sha1_short)/o) {
+ if (/^${esc_color}commit (?:- )?($::sha1_short)/o) {
my $cmt = $1;
if ($c && cmt_showable($c) && $c->{r} != $r_last) {
$r_last = $c->{r};
use warnings;
sub new {
- my ($class, $glob) = @_;
+ my ($class, $glob, $pattern_ok) = @_;
my $re = $glob;
$re =~ s!/+$!!g; # no need for trailing slashes
- $re =~ m!^([^*]*)(\*(?:/\*)*)(.*)$!;
- my $temp = $re;
- my ($left, $right) = ($1, $3);
- $re = $2;
- my $depth = $re =~ tr/*/*/;
- if ($depth != $temp =~ tr/*/*/) {
- die "Only one set of wildcard directories " .
- "(e.g. '*' or '*/*/*') is supported: '$glob'\n";
+ 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 for glob: '$glob'\n";
- }
- $re =~ s!\*!\[^/\]*!g;
- $re = quotemeta($left) . "($re)" . quotemeta($right);
- if (length $left && !($left =~ s!/+$!!g)) {
- die "Missing trailing '/' on left side of: '$glob' ($left)\n";
- }
- if (length $right && !($right =~ s!^/+!!g)) {
- die "Missing leading '/' on right side of: '$glob' ($right)\n";
+ 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;