return undef;
}
+sub dcommit_rebase {
+ my ($is_last, $current, $fetched_ref, $svn_error) = @_;
+ my @diff;
+
+ if ($svn_error) {
+ print STDERR "\nERROR from SVN:\n",
+ $svn_error->expanded_message, "\n";
+ }
+ unless ($_no_rebase) {
+ # we always want to rebase against the current HEAD,
+ # not any head that was passed to us
+ @diff = command('diff-tree', $current,
+ $fetched_ref, '--');
+ my @finish;
+ if (@diff) {
+ @finish = rebase_cmd();
+ print STDERR "W: $current and ", $fetched_ref,
+ " differ, using @finish:\n",
+ join("\n", @diff), "\n";
+ } elsif ($is_last) {
+ print "No changes between ", $current, " and ",
+ $fetched_ref,
+ "\nResetting to the latest ",
+ $fetched_ref, "\n";
+ @finish = qw/reset --mixed/;
+ }
+ command_noisy(@finish, $fetched_ref) if @finish;
+ }
+ if ($svn_error) {
+ die "ERROR: Not all changes have been committed into SVN"
+ .($_no_rebase ? ".\n" : ", however the committed\n"
+ ."ones (if any) seem to be successfully integrated "
+ ."into the working tree.\n")
+ ."Please see the above messages for details.\n";
+ }
+ return @diff;
+}
+
sub cmd_dcommit {
my $head = shift;
command_noisy(qw/update-index --refresh/);
}
my $rewritten_parent;
+ my $current_head = command_oneline(qw/rev-parse HEAD/);
Git::SVN::remove_username($expect_url);
if (defined($_merge_info)) {
$_merge_info =~ tr{ }{\n};
},
mergeinfo => $_merge_info,
svn_path => '');
+
+ my $err_handler = $SVN::Error::handler;
+ $SVN::Error::handler = sub {
+ my $err = shift;
+ dcommit_rebase(1, $current_head, $gs->refname,
+ $err);
+ };
+
if (!Git::SVN::Editor->new(\%ed_opts)->apply_diff) {
print "No changes\n$d~1 == $d\n";
} elsif ($parents->{$d} && @{$parents->{$d}}) {
$parents->{$d};
}
$_fetch_all ? $gs->fetch_all : $gs->fetch;
+ $SVN::Error::handler = $err_handler;
$last_rev = $cmt_rev;
next if $_no_rebase;
- # we always want to rebase against the current HEAD,
- # not any head that was passed to us
- my @diff = command('diff-tree', $d,
- $gs->refname, '--');
- my @finish;
- if (@diff) {
- @finish = rebase_cmd();
- print STDERR "W: $d and ", $gs->refname,
- " differ, using @finish:\n",
- join("\n", @diff), "\n";
- } else {
- print "No changes between current HEAD and ",
- $gs->refname,
- "\nResetting to the latest ",
- $gs->refname, "\n";
- @finish = qw/reset --mixed/;
- }
- command_noisy(@finish, $gs->refname);
+ my @diff = dcommit_rebase(@$linear_refs == 0, $d,
+ $gs->refname, undef);
- $rewritten_parent = command_oneline(qw/rev-parse HEAD/);
+ $rewritten_parent = command_oneline(qw/rev-parse/,
+ $gs->refname);
if (@diff) {
+ $current_head = command_oneline(qw/rev-parse
+ HEAD/);
@refs = ();
my ($url_, $rev_, $uuid_, $gs_) =
working_head_info('HEAD', \@refs);
}
$parents = \%p;
$linear_refs = \@l;
+ undef $last_rev;
}
}
}
}
}
-
-package Git::IndexInfo;
-use strict;
-use warnings;
-use Git qw/command_input_pipe command_close_pipe/;
-
-sub new {
- my ($class) = @_;
- my ($gui, $ctx) = command_input_pipe(qw/update-index -z --index-info/);
- bless { gui => $gui, ctx => $ctx, nr => 0}, $class;
-}
-
-sub remove {
- my ($self, $path) = @_;
- if (print { $self->{gui} } '0 ', 0 x 40, "\t", $path, "\0") {
- return ++$self->{nr};
- }
- undef;
-}
-
-sub update {
- my ($self, $mode, $hash, $path) = @_;
- if (print { $self->{gui} } $mode, ' ', $hash, "\t", $path, "\0") {
- return ++$self->{nr};
- }
- undef;
-}
-
-sub DESTROY {
- my ($self) = @_;
- command_close_pipe($self->{gui}, $self->{ctx});
-}
-
-package Git::SVN::GlobSpec;
-use strict;
-use warnings;
-
-sub new {
- my ($class, $glob, $pattern_ok) = @_;
- my $re = $glob;
- $re =~ s!/+$!!g; # no need for trailing slashes
- 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 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;
-}
-
-sub full_path {
- my ($self, $path) = @_;
- return (length $self->{left} ? "$self->{left}/" : '') .
- $path . (length $self->{right} ? "/$self->{right}" : '');
-}
-
__END__
Data structures: