$debugcmd_when_debuglevel = 2;
-our ($usage_message) = <<'END';
+our ($usage_message) = i_ <<'END';
usages:
git-debrebase [<options>] [--|-i <git rebase options...>]
git-debrebase [<options>] status
sub badusage ($) {
my ($m) = @_;
- print STDERR "$us: bad usage: $m\n";
+ print STDERR f_ "%s: bad usage: %s\n", $us, $m;
finish 8;
}
}
sub getoptions {
my $sc = shift;
- getoptions_main "bad options follow \`git-debrebase $sc'", @_;
+ getoptions_main +(f_ "bad options follow \`git-debrebase %s'", $sc), @_;
}
sub cfg ($;$) {
push @cmd, $k;
my $out = cmdoutput_errok @cmd;
if (!defined $out) {
- fail "missing required git config $k" unless $optional;
+ fail f_ "missing required git config %s", $k unless $optional;
return ();
}
my @l = split /\0/, $out;
sub get_commit ($) {
my ($objid) = @_;
my $data = (git_cat_file $objid, 'commit');
- $data =~ m/(?<=\n)\n/ or die "$objid ($data) ?";
+ $data =~ m/(?<=\n)\n/ or confess "$objid ($data) ?";
return ($`,$');
}
my @upd_cmd = (git_update_ref_cmd "debrebase: $mrest", qw(--stdin));
debugcmd '>|', @upd_cmd;
- open U, "|-", @upd_cmd or die $!;
+ open U, "|-", @upd_cmd or confess $!;
foreach (@$updates) {
printdebug ">= ", $_, "\n";
- print U $_, "\n" or die $!;
+ print U $_, "\n" or confess $!;
}
printdebug ">\$\n";
close U or failedcmd @upd_cmd;
sub run_deferred_updates ($) {
my ($mrest) = @_;
- confess 'dangerous internal error' unless all_snags_summarised();
+ my $m = 'dangerous internal error';
+ confess $m.' - '.__ $m unless all_snags_summarised();
merge_wreckage_cleaning \@deferred_updates;
run_ref_updates_now $mrest, \@deferred_updates;
my ($tag,$msg) = @_; # ignores extra args, for benefit of keycommits
if (grep { $_ eq $tag } @snag_force_opts) {
$snags_forced++;
- print STDERR "git-debrebase: snag ignored (-f$tag): $msg\n";
+ print STDERR f_ "%s: snag ignored (-f%s): %s\n", $us, $tag, $msg;
} else {
$snags_tripped++;
- print STDERR "git-debrebase: snag detected (-f$tag): $msg\n";
+ print STDERR f_ "%s: snag detected (-f%s): %s\n", $us, $tag, $msg;
}
}
sub snags_maybe_bail () {
return if all_snags_summarised();
if ($snags_forced) {
- printf STDERR
+ print STDERR f_
"%s: snags: %d overriden by individual -f options\n",
$us, $snags_forced;
}
if ($snags_tripped) {
if ($opt_force) {
- printf STDERR
+ print STDERR f_
"%s: snags: %d overriden by global --force\n",
$us, $snags_tripped;
} else {
- fail sprintf
+ fail f_
"%s: snags: %d blocker(s) (you could -f<tag>, or --force)",
$us, $snags_tripped;
}
changedir $maindir;
my ($ffqs, $ffqm, $symref, $ffq_prev, $gdrlast) = ffq_prev_branchinfo();
- my $mangled = <<END;
+ my $mangled = __ <<END;
Branch/history seems mangled - no longer in gdr format.
See ILLEGAL OPERATIONS in git-debrebase(5).
END
chomp $mangled;
if (defined $ffqm) {
- fail <<END;
-$msg
-Is this meant to be a gdr branch? $ffqm
+ fail f_ <<END, $msg, $ffqm;
+%s
+Is this meant to be a gdr branch? %s
END
} elsif (git_get_ref $ffq_prev) {
- fail <<END;
-$msg
-$mangled
+ fail f_ <<END, $msg, $mangled;
+%s
+%s
Consider git-debrebase scrap, to throw away your recent work.
END
} elsif (!git_get_ref $gdrlast) {
- fail <<END;
-$msg
+ fail f_ <<END, $msg;
+%s
Branch does not seem to be meant to be a git-debrebase branch?
Wrong branch, or maybe you needed git-debrebase convert-from-*.
END
$mangled
END
} else {
- fail <<END;
-$msg
+ fail f_ <<END, $msg;
+%s
Branch/history mangled, and diverged since last git-debrebase.
Maybe you reset to, or rebased from, somewhere inappropriate.
END
my $any = gbp_pq_export "p-$s", $q->{SeriesBase}, $q->{SeriesTip};
my @earlier;
if ($any) {
- open S, $seriesfile or die "$seriesfile $!";
+ open S, $seriesfile or confess "$seriesfile $!";
while (my $patch = <S>) {
- chomp $patch or die $!;
+ chomp $patch or confess $!;
$prereq{$patch} //= {};
foreach my $earlier (@earlier) {
- $prereq{$patch}{$earlier}{$s}++ and die;
+ $prereq{$patch}{$earlier}{$s}++ and confess;
}
push @earlier, $patch;
- stat "debian/patches/$patch" or die "$patch ?";
+ stat "debian/patches/$patch" or confess "$patch ?";
}
- S->error and die "$seriesfile $!";
+ S->error and confess "$seriesfile $!";
close S;
}
read_tree_upstream $newbase, 1;
my $authordate = sub {
my ($f) = @_;
$authordate{$f} //= do {
- open PF, "<", "debian/patches/$f" or die "$f $!";
+ open PF, "<", "debian/patches/$f" or confess "$f $!";
while (<PF>) {
return $nodate if m/^$/;
last if s{^Date: }{};
};
};
- open NS, '>', $seriesfile or die $!;
+ open NS, '>', $seriesfile or confess $!;
while (keys %prereq) {
my $best;
$best = $try;
}
printdebug "merge_series series next $best\n";
- print NS "$best\n" or die $!;
+ print NS "$best\n" or confess $!;
delete $prereq{$best};
foreach my $gp (values %prereq) {
delete $gp->{$best};
my $tree = cmdoutput @git, qw(write-tree);
$commit =~ s{^parent (\S+)$}{parent $build}m or confess;
$commit =~ s{^tree (\S+)$}{tree $tree}m or confess;
- open C, ">", "../mcommit" or die $!;
- print C $commit or die $!;
- close C or die $!;
+ open C, ">", "../mcommit" or confess $!;
+ print C $commit or confess $!;
+ close C or confess $!;
$build = cmdoutput @git, qw(hash-object -w -t commit ../mcommit);
}
$result = $build;
# $p_ref, if provided, must be [] and is used as a base for Parents
$p_ref //= [];
- die if @$p_ref;
+ confess if @$p_ref;
my ($h,$m) = get_commit $objid;
- my ($t) = $h =~ m/^tree (\w+)$/m or die $objid;
+ my ($t) = $h =~ m/^tree (\w+)$/m or confess $objid;
my (@ph) = $h =~ m/^parent (\w+)$/mg;
my $r = {
# reject it here then we avoid making the pseudomerge which
# would be needed to push it.
- my $badanchor = sub { $unknown->("git-debrebase \`anchor' but @_"); };
- @p == 2 or return $badanchor->("has other than two parents");
- $haspatches and return $badanchor->("contains debian/patches");
+ my $badanchor = sub {
+ $unknown->(f_ "git-debrebase \`anchor' but %s", "@_");
+ };
+ @p == 2 or return $badanchor->(__ "has other than two parents");
+ $haspatches and return $badanchor->(__ "contains debian/patches");
# How to decide about l/r ordering of anchors ? git
# --topo-order prefers to expand 2nd parent first. There's
# parents from left to right, in order, so it's easy to see
# which way round a pseudomerge is.
- $p[0]{IsOrigin} and $badanchor->("is an origin commit");
+ $p[0]{IsOrigin} and $badanchor->(__ "is an origin commit");
$p[1]{Differs} & ~DS_DEB and
- $badanchor->("upstream files differ from left parent");
+ $badanchor->(__ "upstream files differ from left parent");
$p[0]{Differs} & ~D_UPS and
- $badanchor->("debian/ differs from right parent");
+ $badanchor->(__ "debian/ differs from right parent");
return $classify->(qw(Anchor),
OrigParents => [ $p[1] ]);
if ($d == D_PAT_ADD) {
return $classify->(qw(AddPatches));
} elsif ($d & (D_PAT_ADD|D_PAT_OTH)) {
- return $unknown->("edits debian/patches");
+ return $unknown->(__ "edits debian/patches");
} elsif ($d & DS_DEB and !($d & ~DS_DEB)) {
my ($ty,$dummy) = git_cat_file "$p[0]{CommitId}:debian";
if ($ty eq 'tree') {
} elsif ($ty eq 'missing') {
return $classify->(qw(BreakwaterStart));
} else {
- return $unknown->("parent's debian is not a directory");
+ return $unknown->(__ "parent's debian is not a directory");
}
} elsif ($d == D_UPS) {
return $classify->(qw(Upstream));
} elsif ($d & DS_DEB and $d & D_UPS and !($d & ~(DS_DEB|D_UPS))) {
return $classify->(qw(Mixed));
} elsif ($d == 0) {
- return $unknown->("no changes");
+ return $unknown->(__ "no changes");
} else {
confess "internal error $objid ?";
}
}
if (!@p) {
- return $unknown->("origin commit");
+ return $unknown->(__ "origin commit");
}
if (@p == 2 && @identical == 1) {
if (@p == 2 && @identical == 2) {
my $get_t = sub {
my ($ph,$pm) = get_commit $_[0]{CommitId};
- $ph =~ m/^committer .* (\d+) [-+]\d+$/m or die "$_->{CommitId} ?";
+ $ph =~ m/^committer .* (\d+) [-+]\d+$/m
+ or confess "$_->{CommitId} ?";
$1;
};
my @bytime = @p;
return $classify->("MergedBreakwaters");
}
if ($r->{Msg} =~ m{^\[(git-debrebase|dgit)[: ].*\]$}m) {
- return $unknown->("unknown kind of merge from $1");
+ return $unknown->(f_ "unknown kind of merge from %s", $1);
}
if (@p > 2) {
- return $unknown->("octopus merge");
+ return $unknown->(__ "octopus merge");
}
if (!$opt_merges) {
- return $unknown->("general two-parent merge");
+ return $unknown->(__ "general two-parent merge");
}
return $classify->("VanillaMerge");
$best_anchor = $panchor
if !defined $best_anchor
or is_fast_fwd $best_anchor, $panchor;
- fail "inconsistent anchors in merged-breakwaters $p->{CommitId}"
+ fail f_ "inconsistent anchors in merged-breakwaters %s",
+ $p->{CommitId}
unless is_fast_fwd $panchor, $best_anchor;
}
return $best_anchor;
my $x = sub {
my ($cb, $tagsfx, $mainwhy, $xwhy) = @_;
my $why = $mainwhy.$xwhy;
- my $m = "branch needs laundering (run git-debrebase): $why";
+ my $m = f_ "branch needs laundering (run git-debrebase): %s", $why;
fail $m unless defined $cb;
return unless $cb;
$cb->("unclean-$tagsfx", $why, $cl, $mainwhy);
$found_anchor->($head);
} elsif ($ty eq 'Upstream') {
$x->($unclean, 'ordering',
- "packaging change ($breakwater) follows upstream change"," (eg $head)")
+ (f_ "packaging change (%s) follows upstream change", $breakwater),
+ (f_ " (eg %s)", $head))
if defined $breakwater;
$clogonly = undef;
$breakwater = undef;
} elsif ($ty eq 'Mixed') {
$x->($unclean, 'mixed',
- "found mixed upstream/packaging commit"," ($head)");
+ (__ "found mixed upstream/packaging commit"),
+ (f_ " (%s)", $head));
$clogonly = undef;
$breakwater = undef;
} elsif ($ty eq 'Pseudomerge' or
$ty eq 'AddPatches') {
my $found_pm = 1;
$x->($furniture, (lc $ty),
- "found interchange bureaucracy commit ($ty)"," ($head)");
+ (f_ "found interchange bureaucracy commit (%s)", $ty),
+ (f_ " (%s)", $head));
} elsif ($ty eq 'DgitImportUnpatched') {
if ($found_pm) {
$x->($trouble, 'dgitimport',
- "found dgit dsc import"," ($head)");
+ (__ "found dgit dsc import"),
+ (f_ " (%s)", $head));
return (undef,undef);
} else {
$x->($fatal, 'unprocessable',
- "found bare dgit dsc import with no prior history",
- " ($head)");
+ (__ "found bare dgit dsc import with no prior history"),
+ (f_ " (%s)", $head));
return (undef,undef);
}
} elsif ($ty eq 'VanillaMerge') {
$x->($trouble, 'vanillamerge',
- "found vanilla merge"," ($head)");
+ (__ "found vanilla merge"),
+ (f_ " (%s)", $head));
return (undef,undef);
} elsif ($ty eq 'MergedBreakwaters') {
$found_anchor->(mergedbreakwaters_anchor $cl);
} else {
$x->($fatal, 'unprocessable',
- "found unprocessable commit, cannot cope: $cl->{Why}",
- " ($head)");
+ (f_ "found unprocessable commit, cannot cope: %s",
+ $cl->{Why}),
+ (f_ " (%s)", $head));
return (undef,undef);
}
$head = $cl->{Parents}[0]{CommitId};
if ($nogenerate) {
return (undef,undef);
}
- fail_unprocessable "found unprocessable commit, cannot cope".
- (defined $cl->{Why} ? "; $cl->{Why}:": ':').
- " (commit $cur) (d.".
- (join ' ', map { sprintf "%#x", $_->{Differs} }
- @{ $cl->{Parents} }).
- ")";
+ my $d =
+ join ' ',
+ map { sprintf "%#x", $_->{Differs} }
+ @{ $cl->{Parents} };
+ fail_unprocessable sprintf +(defined $cl->{Why}
+ ? 'found unprocessable commit, cannot cope; %3$s: (commit %1$s) (d.%2$s)'
+ : 'found unprocessable commit, cannot cope: (commit %1$s) (d.%2$s)'),
+ $cur, $d, $cl->{Why};
};
my $build;
$cl->{Why} = "bare dgit dsc import";
return $bomb->();
}
- die "$ty ?";
+ confess "$ty ?";
} elsif ($ty eq 'MergedBreakwaters') {
$last_anchor = mergedbreakwaters_anchor $cl;
$build_start->(' MergedBreakwaters', $cur);
confess "internal error" unless $build eq (pop @processed)->{CommitId};
in_workarea sub {
- mkdir $rd or $!==EEXIST or die $!;
+ mkdir $rd or $!==EEXIST or confess $!;
my $current_method;
my $want_debian = $build;
my $want_upstream = $build;
or confess "$ch ?";
}
my $cf = "$rd/m$rewriting";
- open CD, ">", $cf or die $!;
- print CD $ch, "\n", $cl->{Msg} or die $!;
- close CD or die $!;
+ open CD, ">", $cf or confess $!;
+ print CD $ch, "\n", $cl->{Msg} or confess $!;
+ close CD or confess $!;
my @cmd = (@git, qw(hash-object));
push @cmd, qw(-w) if $rewriting;
push @cmd, qw(-t commit), $cf;
};
my $final_check = get_differs $build, $input;
- die sprintf "internal error %#x %s %s", $final_check, $input, $build
+ confess sprintf "internal error %#x %s %s", $final_check, $input, $build
if $final_check & ~D_PAT_ADD;
my @r = ($build, $breakwater, $last_anchor);
sub update_head_postlaunder ($$$) {
my ($old, $tip, $reflogmsg) = @_;
return if $tip eq $old && !@deferred_updates;
- print "git-debrebase: laundered (head was $old)\n";
+ print "$us: laundered (head was $old)\n";
update_head $old, $tip, $reflogmsg;
# no tree changes except debian/patches
runcmd @git, qw(rm --quiet --ignore-unmatch -rf debian/patches);
$old = git_rev_parse 'HEAD';
}
my ($dummy,$breakwater) = walk $old, 1,*STDOUT;
- STDOUT->error and die $!;
+ STDOUT->error and confess $!;
}
sub ffq_check ($;$$) {
# normally $currentval should be HEAD
my ($currentval, $ff, $notff) =@_;
- $ff //= sub { print $_[0] or die $!; };
+ $ff //= sub { print $_[0] or confess $!; };
$notff //= \&snag;
my ($status, $message, $current, $ffq_prev, $gdrlast)
unless @ARGV && $ARGV[0] !~ m{^-};
my $c = git_rev_parse shift @ARGV;
- die unless $n =~ m/^$extra_orig_namepart_re$/;
+ confess unless $n =~ m/^$extra_orig_namepart_re$/;
$newpiece->($n, New => $c);
}
badusage "no arguments allowed" if @ARGV;
my ($status, $msg) = record_ffq_prev_deferred();
if ($status eq 'exists' && $opt_noop_ok) {
- print "Previous head already recorded\n" or die $!;
+ print "Previous head already recorded\n" or confess $!;
} elsif ($status eq 'deferred') {
run_deferred_updates 'record-ffq-prev';
} else {
sub cmd_anchor () {
badusage "no arguments allowed" if @ARGV;
my ($anchor, $bw) = keycommits +(git_rev_parse 'HEAD'), 0,0;
- print "$bw\n" or die $!;
+ print "$bw\n" or confess $!;
}
sub cmd_breakwater () {
badusage "no arguments allowed" if @ARGV;
my ($anchor, $bw) = keycommits +(git_rev_parse 'HEAD'), 0,0;
- print "$bw\n" or die $!;
+ print "$bw\n" or confess $!;
}
sub cmd_status () {
my $prcommitinfo = sub {
my ($cid) = @_;
- flush STDOUT or die $!;
+ flush STDOUT or confess $!;
runcmd @git, qw(--no-pager log -n1),
'--pretty=format: %h %s%n',
$cid;
my $clogp = parsechangelog();
my $version = $clogp->{'Version'}
- // die "missing Version from changelog";
+ // die "missing Version from changelog\n";
my ($upstream_spec) = @ARGV;
};
complete_convert_from $old_head, $work, $gdrlastinfo, 'convert-from-gbp';
- print <<END or die $!;
-git-debrebase: converted from patched-unapplied (gbp) branch format, OK
+ print <<END or confess $!;
+$us: converted from patched-unapplied (gbp) branch format, OK
END
}
}
snags_maybe_bail();
update_head_checkout $head, $out, "convert to gbp (v0)";
- print <<END or die $!;
-git-debrebase: converted to git-buildpackage branch format
-git-debrebase: WARNING: do not now run "git-debrebase" any more
-git-debrebase: WARNING: doing so would drop all upstream patches!
+ print <<END or confess $!;
+$us: converted to git-buildpackage branch format
+$us: WARNING: do not now run "git-debrebase" any more
+$us: WARNING: doing so would drop all upstream patches!
END
}
# we do a quick check to see if there are plausible origs
my $something=0;
if (!opendir BPD, $bpd) {
- die "$bpd: opendir: $!" unless $!==ENOENT;
+ die "opendir build-products-dir $bpd: $!" unless $!==ENOENT;
} else {
while ($!=0, my $f = readdir BPD) {
next unless is_orig_file_of_p_v $f, $p, $version;
$something=1;
last;
}
- die "read $bpd: $!" if $!;
+ confess "read $bpd: $!" if $!;
closedir BPD;
}
if ($something) {
'experimental-merge-resolution!', \$opt_merges,
'-i:s' => sub {
my ($opt,$val) = @_;
- badusage __ "git-debrebase: no cuddling to -i for git-rebase"
+ badusage f_ "%s: no cuddling to -i for git-rebase", $us
if length $val;
- die if $opt_defaultcmd_interactive; # should not happen
+ confess if $opt_defaultcmd_interactive; # should not happen
$opt_defaultcmd_interactive = [ qw(-i) ];
# This access to @ARGV is excessive familiarity with
# Getopt::Long, but there isn't another sensible
push @$opt_defaultcmd_interactive, @ARGV;
@ARGV=();
},
- 'help' => sub { print $usage_message or die $!; finish 0; },
+ 'help' => sub { print __ $usage_message or confess $!; finish 0; },
);
initdebug('git-debrebase ');
enabledebug if $debuglevel;
my $toplevel = cmdoutput @git, qw(rev-parse --show-toplevel);
-chdir $toplevel or die "chdir $toplevel: $!";
+chdir $toplevel or fail "chdir toplevel $toplevel: $!\n";
$rd = fresh_playground "$playprefix/misc";