41
# import functions from Git into our packages, en masse
42
43
foreach (qw/command command_oneline command_noisy command_output_pipe
43
44
command_input_pipe command_close_pipe/) {
44
$s .= "*SVN::Git::Editor::$_ = *SVN::Git::Fetcher::$_ = ".
45
"*Git::SVN::Migration::$_ = ".
46
"*Git::SVN::Log::$_ = *Git::SVN::$_ = *$_ = *Git::$_; ";
45
for my $package ( qw(SVN::Git::Editor SVN::Git::Fetcher
46
Git::SVN::Migration Git::SVN::Log Git::SVN),
48
*{"${package}::$_"} = \&{"Git::$_"};
75
77
\$Git::SVN::_repack_flags,
78
my ($_trunk, $_tags, $_branches);
80
my ($_trunk, $_tags, $_branches, $_stdlayout);
80
82
my %init_opts = ( 'template=s' => \$_template, 'shared:s' => \$_shared,
81
83
'trunk|T=s' => \$_trunk, 'tags|t=s' => \$_tags,
82
84
'branches|b=s' => \$_branches, 'prefix=s' => \$_prefix,
85
'stdlayout|s' => \$_stdlayout,
83
86
'minimize-url|m' => \$Git::SVN::_minimize_url,
84
87
'no-metadata' => sub { $icv{noMetadata} = 1 },
85
88
'use-svm-props' => sub { $icv{useSvmProps} = 1 },
368
377
$head ||= 'HEAD';
370
379
my ($url, $rev, $uuid, $gs) = working_head_info($head, \@refs);
380
print "Committing to $url ...\n";
372
382
die "Unable to determine upstream SVN information from ",
373
383
"$head history\n";
377
foreach my $d (@refs) {
378
if (!verify_ref("$d~1")) {
380
"has no parent commit, and therefore ",
381
"nothing to diff against.\n",
382
"You should be working from a repository ",
383
"originally created by git-svn\n";
386
my ($linear_refs, $parents) = linearize_history($gs, \@refs);
387
if ($_no_rebase && scalar(@$linear_refs) > 1) {
388
warn "Attempting to commit more than one change while ",
389
"--no-rebase is enabled.\n",
390
"If these changes depend on each other, re-running ",
391
"without --no-rebase will be required."
393
foreach my $d (@$linear_refs) {
385
394
unless (defined $last_rev) {
386
395
(undef, $last_rev, undef) = cmt_metadata("$d~1");
387
396
unless (defined $last_rev) {
400
410
editor_cb => sub {
401
411
print "Committed r$_[0]\n";
402
$last_rev = $_[0]; },
404
415
if (!SVN::Git::Editor->new(\%ed_opts)->apply_diff) {
405
416
print "No changes\n$d~1 == $d\n";
411
warn "Could not determine fetch information for $url\n",
412
"Will not attempt to fetch and rebase commits.\n",
413
"This probably means you have useSvmProps and should\n",
414
"now resync your SVN::Mirror repository.\n";
417
$_fetch_all ? $gs->fetch_all : $gs->fetch;
418
unless ($_no_rebase) {
419
# we always want to rebase against the current HEAD, not any
420
# head that was passed to us
421
my @diff = command('diff-tree', 'HEAD', $gs->refname, '--');
424
@finish = rebase_cmd();
425
print STDERR "W: HEAD and ", $gs->refname, " differ, ",
426
"using @finish:\n", "@diff";
428
print "No changes between current HEAD and ",
429
$gs->refname, "\nResetting to the latest ",
431
@finish = qw/reset --mixed/;
433
command_noisy(@finish, $gs->refname);
417
} elsif ($parents->{$d} && @{$parents->{$d}}) {
418
$gs->{inject_parents_dcommit}->{$cmt_rev} =
421
$_fetch_all ? $gs->fetch_all : $gs->fetch;
424
# we always want to rebase against the current HEAD,
425
# not any head that was passed to us
426
my @diff = command('diff-tree', 'HEAD',
430
@finish = rebase_cmd();
431
print STDERR "W: HEAD and ", $gs->refname,
432
" differ, using @finish:\n",
435
print "No changes between current HEAD and ",
437
"\nResetting to the latest ",
439
@finish = qw/reset --mixed/;
441
command_noisy(@finish, $gs->refname);
442
$last_rev = $cmt_rev;
594
604
my $index = $ENV{GIT_INDEX_FILE} || "$ENV{GIT_DIR}/index";
595
605
return if -f $index;
597
chomp(my $bare = `git config --bool --get core.bare`);
598
return if $bare eq 'true';
607
return if command_oneline(qw/rev-parse --is-inside-work-tree/) eq 'false';
599
608
return if command_oneline(qw/rev-parse --is-inside-git-dir/) eq 'true';
600
609
command_noisy(qw/read-tree -m -u -v HEAD HEAD/);
601
610
print STDERR "Checked out HEAD:\n ",
786
795
sub extract_metadata {
787
796
my $id = shift or return (undef, undef, undef);
788
my ($url, $rev, $uuid) = ($id =~ /^git-svn-id:\s(\S+?)\@(\d+)
797
my ($url, $rev, $uuid) = ($id =~ /^\s*git-svn-id:\s+(.*)\@(\d+)
789
798
\s([a-f\d\-]+)$/x);
790
799
if (!defined $rev || !$uuid || !$url) {
791
800
# some of the original repositories I made had
792
801
# identifiers like this:
793
($rev, $uuid) = ($id =~/^git-svn-id:\s(\d+)\@([a-f\d\-]+)/);
802
($rev, $uuid) = ($id =~/^\s*git-svn-id:\s(\d+)\@([a-f\d\-]+)/);
795
804
return ($url, $rev, $uuid);
803
812
sub working_head_info {
804
813
my ($head, $refs) = @_;
805
my ($fh, $ctx) = command_output_pipe('rev-list', $head);
806
while (my $hash = <$fh>) {
808
my ($url, $rev, $uuid) = cmt_metadata($hash);
814
my ($fh, $ctx) = command_output_pipe('log', '--no-color', $head);
818
if ( m{^commit ($::sha1)$} ) {
819
unshift @$refs, $hash if $hash and $refs;
823
next unless s{^\s*(git-svn-id:)}{$1};
824
my ($url, $rev, $uuid) = extract_metadata($_);
809
825
if (defined $url && defined $rev) {
826
next if $max{$url} and $max{$url} < $rev;
810
827
if (my $gs = Git::SVN->find_by_url($url)) {
811
828
my $c = $gs->rev_db_get($rev);
812
829
if ($c && $c eq $hash) {
813
830
close $fh; # break the pipe
814
831
return ($url, $rev, $uuid, $gs);
833
$max{$url} ||= $gs->rev_db_max;
818
unshift @$refs, $hash if $refs;
820
838
command_close_pipe($fh, $ctx);
821
839
(undef, undef, undef, undef);
842
sub read_commit_parents {
843
my ($parents, $c) = @_;
844
chomp(my $p = command_oneline(qw/rev-list --parents -1/, $c));
845
$p =~ s/^($c)\s*// or die "rev-list --parents -1 $c failed!\n";
846
@{$parents->{$c}} = split(/ /, $p);
849
sub linearize_history {
850
my ($gs, $refs) = @_;
852
foreach my $c (@$refs) {
853
read_commit_parents(\%parents, $c);
858
my $last_svn_commit = $gs->last_commit;
859
foreach my $c (reverse @$refs) {
860
next if $c eq $last_svn_commit;
863
unshift @linear_refs, $c;
866
# we only want the first parent to diff against for linear
867
# history, we save the rest to inject when we finalize the
869
my $fp_a = verify_ref("$c~1");
870
my $fp_b = shift @{$parents{$c}} if $parents{$c};
871
if (!$fp_a || !$fp_b) {
873
"has no parent commit, and therefore ",
874
"nothing to diff against.\n",
875
"You should be working from a repository ",
876
"originally created by git-svn\n";
878
if ($fp_a ne $fp_b) {
879
die "$c~1 = $fp_a, however parsing commit $c ",
880
"revealed that:\n$c~1 = $fp_b\nBUG!\n";
883
foreach my $p (@{$parents{$c}}) {
887
(\@linear_refs, \%parents);
824
890
package Git::SVN;
846
912
# some options are read globally, but can be overridden locally
847
913
# per [svn-remote "..."] section. Command-line options will *NOT*
848
914
# override options set in an [svn-remote "..."] section
850
foreach (qw/follow_parent no_metadata use_svm_props
851
use_svnsync_props/) {
916
for my $option (qw/follow_parent no_metadata use_svm_props
917
use_svnsync_props/) {
856
return \$self->{-$_} if exists \$self->{-$_};
857
my \$k = \"svn-remote.\$self->{repo_id}\.$key\";
858
eval { command_oneline(qw/config --get/, \$k) };
860
\$self->{-$_} = \$Git::SVN::_$_;
920
my $prop = "-$option";
923
return $self->{$prop} if exists $self->{$prop};
924
my $k = "svn-remote.$self->{repo_id}.$key";
925
eval { command_oneline(qw/config --get/, $k) };
927
$self->{$prop} = ${"Git::SVN::_$option"};
862
my \$v = command_oneline(qw/config --bool/,\$k);
863
\$self->{-$_} = \$v eq 'false' ? 0 : 1;
929
my $v = command_oneline(qw/config --bool/,$k);
930
$self->{$prop} = $v eq 'false' ? 0 : 1;
865
return \$self->{-$_} }\n";
932
return $self->{$prop};
879
945
foreach (command(qw#for-each-ref --format=%(refname) refs/remotes#)) {
880
946
next unless m#^refs/remotes/$ref->{regex}$#;
882
my $pathname = $path->full_path($p);
883
my $refname = $ref->full_path($p);
948
my $pathname = desanitize_refname($path->full_path($p));
949
my $refname = desanitize_refname($ref->full_path($p));
884
950
if (my $existing = $fetch->{$pathname}) {
885
951
if ($existing ne $refname) {
886
952
die "Refspec conflict:\n",
968
1034
foreach (grep { s/^svn-remote\.// } command(qw/config -l/)) {
969
1035
if (m!^(.+)\.fetch=\s*(.*)\s*:\s*refs/remotes/(.+)\s*$!) {
970
$r->{$1}->{fetch}->{$2} = $3;
1036
my ($remote, $local_ref, $remote_ref) = ($1, $2, $3);
1037
$local_ref =~ s{^/}{};
1038
$r->{$remote}->{fetch}->{$local_ref} = $remote_ref;
971
1039
} elsif (m!^(.+)\.url=\s*(.*)\s*$!) {
972
1040
$r->{$1}->{url} = $2;
973
1041
} elsif (m!^(.+)\.(branches|tags)=
1180
sub refname { "refs/remotes/$_[0]->{ref_id}" }
1250
my ($refname) = "refs/remotes/$_[0]->{ref_id}" ;
1252
# It cannot end with a slash /, we'll throw up on this because
1253
# SVN can't have directories with a slash in their name, either:
1254
if ($refname =~ m{/$}) {
1255
die "ref: '$refname' ends with a trailing slash, this is ",
1256
"not permitted by git nor Subversion\n";
1259
# It cannot have ASCII control character space, tilde ~, caret ^,
1260
# colon :, question-mark ?, asterisk *, space, or open bracket [
1263
# Additionally, % must be escaped because it is used for escaping
1264
# and we want our escaped refname to be reversible
1265
$refname =~ s{([ \%~\^:\?\*\[\t])}{uc sprintf('%%%02x',ord($1))}eg;
1267
# no slash-separated component can begin with a dot .
1269
$refname =~ s{/\.}{/%2E}g;
1271
# It cannot have two consecutive dots .. anywhere
1273
$refname =~ s{\.\.}{%2E%2E}g;
1278
sub desanitize_refname {
1280
$refname =~ s{%(?:([0-9A-F]{2}))}{chr hex($1)}eg;
1183
1285
my ($self) = @_;
1966
2073
print "Rebuilding $db_path ...\n";
1967
my ($rev_list, $ctx) = command_output_pipe("rev-list", $self->refname);
2074
my ($log, $ctx) = command_output_pipe("log", '--no-color', $self->refname);
1969
2076
my $full_url = $self->full_url;
1970
2077
remove_username($full_url);
1972
while (<$rev_list>) {
1975
die "Non-SHA1: $c\n" unless $c =~ /^$::sha1$/o;
1976
my ($url, $rev, $uuid) = ::cmt_metadata($c);
2081
if ( m{^commit ($::sha1)$} ) {
2085
next unless s{^\s*(git-svn-id:)}{$1};
2086
my ($url, $rev, $uuid) = ::extract_metadata($_);
1977
2087
remove_username($url);
1979
2089
# ignore merges (from set-tree)
2895
3008
use vars qw/@ISA $config_dir $_log_window_size/;
2898
my ($can_do_switch, %ignored_err, $RA);
3011
my ($ra_invalid, $can_do_switch, %ignored_err, $RA);
2901
3014
# enforce temporary pool usage for some simple functions
2903
foreach (qw/rev_proplist get_latest_revnum get_uuid get_repos_root/) {
2906
my \$pool = SVN::Pool->new;
2907
my \@ret = \$self->SUPER::$_(\@_,\$pool);
2909
wantarray ? \@ret : \$ret[0]; }\n";
3016
for my $f (qw/rev_proplist get_latest_revnum get_uuid get_repos_root/) {
3017
my $SUPER = "SUPER::$f";
3020
my $pool = SVN::Pool->new;
3021
my @ret = $self->$SUPER(@_,$pool);
3023
wantarray ? @ret : $ret[0];
2912
eval "$e; 1;" or die $@;
2923
3036
SVN::Client::get_ssl_server_trust_file_provider(),
2924
3037
SVN::Client::get_simple_prompt_provider(
2925
3038
\&Git::SVN::Prompt::simple, 2),
3039
SVN::Client::get_ssl_client_cert_file_provider(),
2926
3040
SVN::Client::get_ssl_client_cert_prompt_provider(
2927
3041
\&Git::SVN::Prompt::ssl_client_cert, 2),
2928
3042
SVN::Client::get_ssl_client_cert_pw_prompt_provider(
3072
3191
$editor->{git_commit_ok};
3075
sub gs_fetch_loop_common {
3076
my ($self, $base, $head, $gsv, $globs) = @_;
3077
return if ($base > $head);
3078
my $inc = $_log_window_size;
3079
my ($min, $max) = ($base, $head < $base + $inc ? $head : $base + $inc);
3194
sub longest_common_path {
3195
my ($gsv, $globs) = @_;
3081
3197
my $common_max = scalar @$gsv;
3230
sub gs_fetch_loop_common {
3231
my ($self, $base, $head, $gsv, $globs) = @_;
3232
return if ($base > $head);
3233
my $inc = $_log_window_size;
3234
my ($min, $max) = ($base, $head < $base + $inc ? $head : $base + $inc);
3235
my $longest_path = longest_common_path($gsv, $globs);
3236
my $ra_url = $self->{url};
3387
3520
sub git_svn_log_cmd {
3388
3521
my ($r_min, $r_max, @args) = @_;
3389
3522
my $head = 'HEAD';
3523
my (@files, @log_opts);
3390
3524
foreach my $x (@args) {
3392
next unless ::verify_ref("$x^0");
3525
if ($x eq '--' || @files) {
3528
if (::verify_ref("$x^0")) {
3397
3536
my ($url, $rev, $uuid, $gs) = ::working_head_info($head);
3401
3540
push @cmd, '-r' unless $non_recursive;
3402
3541
push @cmd, qw/--raw --name-status/ if $verbose;
3403
3542
push @cmd, '--color' if log_use_color();
3404
return @cmd unless defined $r_max;
3405
if ($r_max == $r_min) {
3543
push @cmd, @log_opts;
3544
if (defined $r_max && $r_max == $r_min) {
3406
3545
push @cmd, '--max-count=1';
3407
3546
if (my $c = $gs->rev_db_get($r_max)) {
3549
} elsif (defined $r_max) {
3411
3550
my ($c_min, $c_max);
3412
3551
$c_max = $gs->rev_db_get($r_max);
3413
3552
$c_min = $gs->rev_db_get($r_min);
added
removed
git-svn.perl
