END { $? = $Debian::Dgit::ExitStatus::desired // -1; };
use Debian::Dgit::GDR;
use Debian::Dgit::ExitStatus;
+use Debian::Dgit::I18n;
use strict;
use Memoize;
use Carp;
use POSIX;
+use Locale::gettext;
use Data::Dumper;
use Getopt::Long qw(:config posix_default gnu_compat bundling);
use Dpkg::Version;
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;
playtree_setup();
foreach my $q ($base_q, reverse @input_qs) {
my $s = $q->{MR}{S};
- gbp_pq_export "p-$s", $q->{SeriesBase}, $q->{SeriesTip};
+ my $any = gbp_pq_export "p-$s", $q->{SeriesBase}, $q->{SeriesTip};
my @earlier;
- if (open S, $seriesfile) {
+ if ($any) {
+ 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;
- } else {
- die "$seriesfile $!" unless $!==ENOENT;
}
read_tree_upstream $newbase, 1;
my $pec = make_commit [ grep { defined } $base_q->{MR}{PEC} ], [
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 = {
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;
my ($head, $furniture, $unclean, $trouble, $fatal, $claimed_bw) = @_;
# => ($anchor, $breakwater)
- # $unclean->("unclean-$tagsfx", $msg, $cl)
# $furniture->("unclean-$tagsfx", $msg, $cl)
- # $dgitimport->("unclean-$tagsfx", $msg, $cl))
+ # $unclean->("unclean-$tagsfx", $msg, $cl)
# is callled for each situation or commit that
# wouldn't be found in a laundered branch
# $furniture is for furniture commits such as might be found on an
$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);
$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);
}
my $old_upstream;
if (!$old_anchor_cl->{OrigParents}) {
snag 'anchor-treated',
- 'old anchor is recognised due to --anchor, cannot check upstream';
+ __ 'old anchor is recognised due to --anchor, cannot check upstream';
} else {
$old_upstream = parsecommit
$old_anchor_cl->{OrigParents}[0]{CommitId};
"[git-debrebase anchor: new upstream $new_upstream_version, merge]",
];
- my $clogsignoff = cmdoutput qw(git show),
- '--pretty=format:%an <%ae> %aD',
- $new_bw;
-
# Now we have to add a changelog stanza so the Debian version
- # is right.
- die if unlink "debian";
- die $! unless $!==ENOENT or $!==ENOTEMPTY;
- unlink "debian/changelog" or $!==ENOENT or die $!;
- mkdir "debian" or die $!;
- open CN, ">", "debian/changelog" or die $!;
- my $oldclog = git_cat_file ":debian/changelog";
- $oldclog =~ m/^($package_re) \(\S+\) / or
- fail "cannot parse old changelog to get package name";
- my $p = $1;
- print CN <<END, $oldclog or die $!;
-$p ($new_version) UNRELEASED; urgency=medium
-
- * Update to new upstream version $new_upstream_version.
-
- -- $clogsignoff
-
-END
- close CN or die $!;
+ # is right. We use debchange to do this. Invoking debchange
+ # here is a bit fiddly because it has a lot of optional
+ # exciting behaviours, some of which will break stuff, and
+ # some of which won't work in a playtree.
+
+ # Make debchange use git's idea of the user's identity.
+ # That way, if the user never uses debchange et al, configuring
+ # git is enough.
+ my $usetup = sub {
+ my ($e, $k) = @_;
+ my $v = cfg $k, 1;
+ defined $v or return;
+ $ENV{$e} = $v;
+ };
+ $usetup->('DEBEMAIL', 'user.email');
+ $usetup->('DEBFULLNAME', 'user.name');
+
+sleep 2;
+
+ my @dch = (qw(debchange
+ --allow-lower-version .*
+ --no-auto-nmu
+ --preserve
+ --vendor=Unknown-Vendor
+ --changelog debian/changelog
+ --check-dirname-level 0
+ --release-heuristic=changelog
+ -v), $new_version,
+ "Update to new upstream version $new_upstream_version.");
+
+ runcmd @git, qw(checkout -q debian/changelog);
+ runcmd @dch;
runcmd @git, qw(update-index --add --replace), 'debian/changelog';
# Now we have the final new breakwater branch in the index
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;
# laundered.
my ($secret_head, $secret_bw, $last_anchor) = walk $head;
fresh_workarea();
+ my $any;
in_workarea sub {
- gbp_pq_export 'bw', $secret_bw, $secret_head;
+ $any = gbp_pq_export 'bw', $secret_bw, $secret_head;
};
+ return $any;
}
sub make_patches ($) {
my ($head) = @_;
keycommits $head, 0, \&snag;
- make_patches_staged $head;
+ my $any = make_patches_staged $head;
my $out;
in_workarea sub {
- my $ptree = cmdoutput @git, qw(write-tree --prefix=debian/patches/);
+ my $ptree = !$any ? undef :
+ cmdoutput @git, qw(write-tree --prefix=debian/patches/);
runcmd @git, qw(read-tree), $head;
- read_tree_subdir 'debian/patches', $ptree;
+ if ($ptree) {
+ read_tree_subdir 'debian/patches', $ptree;
+ } else {
+ rm_subdir_cached 'debian/patches';
+ }
$out = make_commit [$head], [
'Commit patch queue (exported by git-debrebase)',
'[git-debrebase make-patches: export and commit patches]',
};
complete_convert_from $old_head, $work, $gdrlastinfo, 'convert-from-gbp';
- print <<END or die $!;
+ print <<END or confess $!;
git-debrebase: converted from patched-unapplied (gbp) branch format, OK
END
}
badusage "no arguments allowed" if @ARGV;
my $head = get_head();
my (undef, undef, undef, $ffq, $gdrlast) = ffq_prev_branchinfo();
- keycommits $head, 0;
- my $out;
- make_patches_staged $head;
- in_workarea sub {
- $out = make_commit ['HEAD'], [
- 'Commit patch queue (converted from git-debrebase format)',
- '[git-debrebase convert-to-gbp: commit patches]',
- ];
- };
+ my ($anchor, $breakwater) = keycommits $head, 0;
+ my $out = $breakwater;
+ my $any = make_patches_staged $head;
+ if ($any) {
+ in_workarea sub {
+ $out = make_commit [$out], [
+ 'Commit patch queue (converted from git-debrebase format)',
+ '[git-debrebase convert-to-gbp: commit patches]',
+ ];
+ };
+ } else {
+ # in this case, it can be fast forward
+ $out = $head;
+ }
if (defined $ffq) {
push @deferred_updates, "delete $ffq";
push @deferred_updates, "delete $gdrlast";
}
snags_maybe_bail();
update_head_checkout $head, $out, "convert to gbp (v0)";
- print <<END or die $!;
+ print <<END or confess $!;
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!
$something=1;
last;
}
- die "read $bpd: $!" if $!;
+ confess "read $bpd: $!" if $!;
closedir BPD;
}
if ($something) {
}
}
+setlocale(LC_MESSAGES, "");
+textdomain("git-debrebase");
+
getoptions_main
("bad options\n",
"D+" => \$debuglevel,
'experimental-merge-resolution!', \$opt_merges,
'-i:s' => sub {
my ($opt,$val) = @_;
- badusage "git-debrebase: no cuddling to -i for git-rebase"
+ badusage __ "git-debrebase: no cuddling to -i for git-rebase"
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
$cmdfn =~ y/-/_/;
$cmdfn = ${*::}{"cmd_$cmdfn"};
- $cmdfn or badusage "unknown git-debrebase sub-operation $cmd";
+ $cmdfn or badusage f_ "unknown git-debrebase sub-operation %s", $cmd;
$cmdfn->();
}
~ianmdlvl / dgit.git / blobdiff