my $got = read PF, $d, 65536;
die "$ourfn: $!" unless defined $got;
last if !$got;
- print $fh "data-block ".length($d)."\n" or die $!;
- print $fh $d or die $!;
+ print $fh "data-block ".length($d)."\n" or confess $!;
+ print $fh $d or confess $!;
}
PF->error and die "$ourfn $!";
- print $fh "data-end\n" or die $!;
+ print $fh "data-end\n" or confess $!;
close PF;
}
} $fh;
last unless $y;
my $d = protocol_read_bytes $fh, $l;
- print PF $d or die $!;
+ print PF $d or confess $!;
}
- close PF or die $!;
+ close PF or confess $!;
}
#---------- remote protocol support, responder ----------
return unless $we_are_responder;
# called even without $we_are_responder
printdebug ">> $command\n";
- print PO $command, "\n" or die $!;
+ print PO $command, "\n" or confess $!;
}
sub responder_send_file ($$) {
sub progress {
if ($we_are_responder) {
my $m = join '', @_;
- responder_send_command "progress ".length($m) or die $!;
- print PO $m or die $!;
+ responder_send_command "progress ".length($m) or confess $!;
+ print PO $m or confess $!;
} else {
print @_, "\n";
}
}
my $what = $_[$#_];
progress "downloading $what...";
- my $r = $ua->get(@_) or die $!;
+ my $r = $ua->get(@_) or confess $!;
return undef if $r->code == 404;
$r->is_success or fail f_ "failed to fetch %s: %s",
$what, $r->status_line;
END
sub badusage {
- print STDERR f_ "%s: %s\n%s", $us, "@_", __ $helpmsg or die $!;
+ print STDERR f_ "%s: %s\n%s", $us, "@_", __ $helpmsg or confess $!;
finish 8;
}
not_necessarily_a_tree();
}
sub cmd_help () {
- print __ $helpmsg or die $!;
+ print __ $helpmsg or confess $!;
finish 0;
}
return;
} elsif ($protovsn >= 3) {
responder_send_command "supplementary-message ".length($msg)
- or die $!;
- print PO $msg or die $!;
+ or confess $!;
+ print PO $msg or confess $!;
}
}
}
sub parse_dscdata () {
- my $dscfh = new IO::File \$dscdata, '<' or die $!;
+ my $dscfh = new IO::File \$dscdata, '<' or confess $!;
printdebug Dumper($dscdata) if $debuglevel>1;
$dsc = parsecontrolfh($dscfh,$dscurl,1);
printdebug Dumper($dsc) if $debuglevel>1;
access_cfg('mirror'),
$aptsuites,
access_cfg('aptget-components')
- or die $!;
+ or confess $!;
ensuredir "$aptget_base/cache";
ensuredir "$aptget_base/lists";
- open CONF, ">", $aptget_configpath or die $!;
+ open CONF, ">", $aptget_configpath or confess $!;
print CONF <<END;
Debug::NoLocking "true";
APT::Get::List-Cleanup "false";
Dir::Etc::preferencesparts
)) {
ensuredir "$aptget_base/$key";
- print CONF "$key \"$quoted_base/$key\";\n" or die $!;
+ print CONF "$key \"$quoted_base/$key\";\n" or confess $!;
};
- my $oldatime = (time // die $!) - 1;
+ my $oldatime = (time // confess $!) - 1;
foreach my $oldlist (<$aptget_base/lists/*Release>) {
next unless stat_exists $oldlist;
my ($mtime) = (stat _)[9];
my @cmd = (qw(sh -ec), 'cd "$1"; shift'."\n".$rune,
qw(x), $mirror, @$argl);
debugcmd "-|", @cmd;
- open FIA, "-|", @cmd or die $!;
+ open FIA, "-|", @cmd or confess $!;
my $r = $fn->();
close FIA or ($!==0 && $?==141) or die failedcmd @cmd;
return $r;
" export LC_MESSAGES=C; export LC_CTYPE=C;".
" ".shellquote qw(psql -A), $dbname, qw(-c), $sql);
debugcmd "|",@cmd;
- open P, "-|", @cmd or die $!;
+ open P, "-|", @cmd or confess $!;
while (<P>) {
chomp or die;
printdebug(">|$_|\n");
my ($what) = @_;
my @gitscmd = qw(find -name .git -prune -print0);
debugcmd "|",@gitscmd;
- open GITS, "-|", @gitscmd or die $!;
+ open GITS, "-|", @gitscmd or confess $!;
{
local $/="\0";
while (<GITS>) {
new Dpkg::Compression::Process compression => $cname;
@compr_cmd = $compr_proc->get_uncompress_cmdline();
my $compr_fh = new IO::Handle;
- my $compr_pid = open $compr_fh, "-|" // die $!;
+ my $compr_pid = open $compr_fh, "-|" // confess $!;
if (!$compr_pid) {
- open STDIN, "<&", $input or die $!;
+ open STDIN, "<&", $input or confess $!;
exec @compr_cmd;
die "dgit (child): exec $compr_cmd[0]: $!\n";
}
}
rmtree "_unpack-tar";
- mkdir "_unpack-tar" or die $!;
+ mkdir "_unpack-tar" or confess $!;
my @tarcmd = qw(tar -x -f -
--no-same-owner --no-same-permissions
--no-acls --no-xattrs --no-selinux);
- my $tar_pid = fork // die $!;
+ my $tar_pid = fork // confess $!;
if (!$tar_pid) {
- chdir "_unpack-tar" or die $!;
- open STDIN, "<&", $input or die $!;
+ chdir "_unpack-tar" or confess $!;
+ open STDIN, "<&", $input or confess $!;
exec @tarcmd;
die f_ "dgit (child): exec %s: %s", $tarcmd[0], $!;
}
- $!=0; (waitpid $tar_pid, 0) == $tar_pid or die $!;
+ $!=0; (waitpid $tar_pid, 0) == $tar_pid or confess $!;
!$? or failedcmd @tarcmd;
close $input or
(@compr_cmd ? ($?==SIGPIPE || failedcmd @compr_cmd)
- : die $!);
+ : confess $!);
# finally, we have the results in "tarball", but maybe
# with the wrong permissions
printdebug "import main commit\n";
- open C, ">../commit.tmp" or die $!;
- print C <<END or die $!;
+ open C, ">../commit.tmp" or confess $!;
+ print C <<END or confess $!;
tree $tree
END
- print C <<END or die $! foreach @tartrees;
+ print C <<END or confess $! foreach @tartrees;
parent $_->{Commit}
END
- print C <<END or die $!;
+ print C <<END or confess $!;
author $authline
committer $authline
[dgit import $treeimporthow $package $cversion]
END
- close C or die $!;
+ close C or confess $!;
my $rawimport_hash = make_commit qw(../commit.tmp);
if (madformat $dsc->{format}) {
progress f_ "%s: trying slow absurd-git-apply...", $us;
rename "../../gbp-pq-output","../../gbp-pq-output.0"
or $!==ENOENT
- or die $!;
+ or confess $!;
}
eval {
die "forbid absurd git-apply\n" if $use_absurd
Last version pushed with dgit: %s (newer or same)
%s
END
- __ $later_warning_msg or die $!;
+ __ $later_warning_msg or confess $!;
@output = $lastpush_mergeinput;
} else {
# Same version. Use what's in the server git branch,
open F, "<", "$tf" or die "$tf: $!";
$fi->{Digester}->reset();
$fi->{Digester}->addfile(*F);
- F->error and die $!;
+ F->error and confess $!;
$got = $fi->{Digester}->hexdigest();
return $got eq $fi->{Hash};
};
debugcmd "|",@lcmd;
my %wantr;
- open GITLS, "-|", @lcmd or die $!;
+ open GITLS, "-|", @lcmd or confess $!;
while (<GITLS>) {
printdebug "=> ", $_;
m/^(\w+)\s+(\S+)\n/ or die "ls-remote $_ ?";
printdebug "del_lrfetchrefs: $objid $fullrefname\n";
if (!$gur) {
$gur ||= new IO::Handle;
- open $gur, "|-", qw(git update-ref --stdin) or die $!;
+ open $gur, "|-", qw(git update-ref --stdin) or confess $!;
}
printf $gur "delete %s %s\n", $fullrefname, $objid;
}
Last version pushed with dgit: %s
%s
END
- __ $later_warning_msg or die $!;
+ __ $later_warning_msg or confess $!;
@mergeinputs = ($lastpush_mergeinput);
} else {
# Archive has .dsc which is not a descendant of the last dgit
Package not found in the archive, but has allegedly been pushed using dgit.
%s
END
- __ $later_warning_msg or die $!;
+ __ $later_warning_msg or confess $!;
} else {
printdebug "nothing found!\n";
if (defined $skew_warning_vsn) {
- print STDERR f_ <<END, $skew_warning_vsn or die $!;
+ print STDERR f_ <<END, $skew_warning_vsn or confess $!;
Warning: relevant archive skew detected.
Archive allegedly contains %s
my $mcf = dgit_privdir()."/mergecommit";
open MC, ">", $mcf or die "$mcf $!";
- print MC <<END or die $!;
+ print MC <<END or confess $!;
tree $tree
END
my @parents = grep { $_->{Commit} } @mergeinputs;
@parents = reverse @parents if $compat_info->{ReverseParents};
- print MC <<END or die $! foreach @parents;
+ print MC <<END or confess $! foreach @parents;
parent $_->{Commit}
END
- print MC <<END or die $!;
+ print MC <<END or confess $!;
author $author
committer $author
END
if (defined $compat_info->{Message}) {
- print MC $compat_info->{Message} or die $!;
+ print MC $compat_info->{Message} or confess $!;
} else {
- print MC f_ <<END, $package, $cversion, $csuite or die $!;
+ print MC f_ <<END, $package, $cversion, $csuite or confess $!;
Record %s (%s) in archive suite %s
Record that
my ($mi) = (@_);
my $mversion = mergeinfo_version $mi;
printf MC " %-20s %s\n", $mversion, $mi->{Info}
- or die $!;
+ or confess $!;
};
$message_add_info->($mergeinputs[0]);
- print MC __ <<END or die $!;
+ print MC __ <<END or confess $!;
should be treated as descended from
END
$message_add_info->($_) foreach @mergeinputs[1..$#mergeinputs];
}
- close MC or die $!;
+ close MC or confess $!;
$hash = make_commit $mcf;
} else {
$hash = $mergeinputs[0]{Commit};
my $got_vsn = getfield $gotclogp, 'Version';
printdebug "SKEW CHECK GOT $got_vsn\n";
if (version_compare($got_vsn, $skew_warning_vsn) < 0) {
- print STDERR f_ <<END, $skew_warning_vsn, $got_vsn or die $!;
+ print STDERR f_ <<END, $skew_warning_vsn, $got_vsn or confess $!;
Warning: archive skew detected. Using the available version:
Archive allegedly contains %s
while (<ATTRS>) {
chomp;
next if m{^debian/changelog\s};
- print NATTRS $_, "\n" or die $!;
+ print NATTRS $_, "\n" or confess $!;
}
- ATTRS->error and die $!;
+ ATTRS->error and confess $!;
close ATTRS;
}
- print NATTRS "debian/changelog merge=$driver\n" or die $!;
+ print NATTRS "debian/changelog merge=$driver\n" or confess $!;
close NATTRS;
set_local_git_config "$cb.name", __ 'debian/changelog merge driver';
printdebug "is_gitattrs_setup: found old macro\n";
return 0;
}
- $gai->error and die $!;
+ $gai->error and confess $!;
printdebug "is_gitattrs_setup: found nothing\n";
return undef;
}
my $af = "$maindir_gitcommon/info/attributes";
ensuredir "$maindir_gitcommon/info";
- open GAO, "> $af.new" or die $!;
- print GAO <<END, __ <<ENDT or die $! unless defined $already;
+ open GAO, "> $af.new" or confess $!;
+ print GAO <<END, __ <<ENDT or confess $! unless defined $already;
* dgit-defuse-attrs
$new
END
$_ = $new;
}
chomp;
- print GAO $_, "\n" or die $!;
+ print GAO $_, "\n" or confess $!;
}
- $gai->error and die $!;
+ $gai->error and confess $!;
}
- close GAO or die $!;
+ close GAO or confess $!;
rename "$af.new", "$af" or fail f_ "install %s: %s", $af, $!;
}
my @cmd = (@git, qw(ls-tree -lrz --), "${treeish}:");
debugcmd "|",@cmd;
my $gafl = new IO::File;
- open $gafl, "-|", @cmd or die $!;
+ open $gafl, "-|", @cmd or confess $!;
while (<$gafl>) {
chomp or die;
s/^\d+\s+\w+\s+\w+\s+(\d+)\t// or die;
# in child, sets things up, calls $fn->(), and returns undef
# in parent, returns canonical suite name for $tsuite
my $canonsuitefh = IO::File::new_tmpfile;
- my $pid = fork // die $!;
+ my $pid = fork // confess $!;
if (!$pid) {
forkcheck_setup();
$isuite = $tsuite;
$debugprefix .= " ";
progress f_ "fetching %s...", $tsuite;
canonicalise_suite();
- print $canonsuitefh $csuite, "\n" or die $!;
- close $canonsuitefh or die $!;
+ print $canonsuitefh $csuite, "\n" or confess $!;
+ close $canonsuitefh or confess $!;
$fn->();
return undef;
}
- waitpid $pid,0 == $pid or die $!;
+ waitpid $pid,0 == $pid or confess $!;
fail f_ "failed to obtain %s: %s", $tsuite, waitstatusmsg()
if $? && $?!=256*4;
- seek $canonsuitefh,0,0 or die $!;
+ seek $canonsuitefh,0,0 or confess $!;
local $csuite = <$canonsuitefh>;
- die $! unless defined $csuite && chomp $csuite;
+ confess $! unless defined $csuite && chomp $csuite;
if ($? == 256*4) {
printdebug "multisuite $tsuite missing\n";
return $csuite;
}
sub clone_set_head () {
- open H, "> .git/HEAD" or die $!;
- print H "ref: ".lref()."\n" or die $!;
- close H or die $!;
+ open H, "> .git/HEAD" or confess $!;
+ print H "ref: ".lref()."\n" or confess $!;
+ close H or confess $!;
}
sub clone_finish ($) {
my ($dstdir) = @_;
$options{$_} = 1;
}
}
- F->error and die $!;
+ F->error and confess $!;
close F;
} else {
- die $! unless $!==&ENOENT;
+ confess $! unless $!==&ENOENT;
}
if (!open F, "debian/source/format") {
- die $! unless $!==&ENOENT;
+ confess $! unless $!==&ENOENT;
return '';
}
$_ = <F>;
- F->error and die $!;
+ F->error and confess $!;
chomp;
return ($_, \%options);
}
# git rev-list --first-parent DTRT.
my $pmf = dgit_privdir()."/pseudomerge";
open MC, ">", $pmf or die "$pmf $!";
- print MC <<END or die $!;
+ print MC <<END or confess $!;
tree $tree
parent $dgitview
parent $archive_hash
[$msg_cmd]
END
- close MC or die $!;
+ close MC or confess $!;
return make_commit($pmf);
}
$dsc->{$ourdscfield[0]} = join " ",
$tagwants->[0]{Objid}, $declaredistro, $tagwants->[0]{Tag},
$reader_giturl;
- $dsc->save("$dscfn.tmp") or die $!;
+ $dsc->save("$dscfn.tmp") or confess $!;
my $changes = parsecontrol($changesfile,$changesfilewhat);
foreach my $field (qw(Source Distribution Version)) {
my $head = $tw->{Objid};
my $tag = $tw->{Tag};
- open TO, '>', $tfn->('.tmp') or die $!;
- print TO <<END or die $!;
+ open TO, '>', $tfn->('.tmp') or confess $!;
+ print TO <<END or confess $!;
object $head
type commit
tag $tag
print TO f_ <<ENDT, $package, $cversion, $clogsuite, $csuite
%s release %s for %s (%s) [dgit]
ENDT
- or die $!;
- print TO <<END or die $!;
+ or confess $!;
+ print TO <<END or confess $!;
[dgit distro=$declaredistro$delibs]
END
foreach my $ref (sort keys %previously) {
- print TO <<END or die $!;
+ print TO <<END or confess $!;
[dgit previously:$ref=$previously{$ref}]
END
}
(maintainer view tag generated by dgit --quilt=%s)
END
$quilt_mode
- or die $!;
+ or confess $!;
} else {
confess Dumper($tw)."?";
}
- close TO or die $!;
+ close TO or confess $!;
my $tagobjfn = $tfn->('.tmp');
if ($sign) {
if (!defined $keyid) {
$keyid = getfield $clogp, 'Maintainer';
}
- unlink $tfn->('.tmp.asc') or $!==&ENOENT or die $!;
+ unlink $tfn->('.tmp.asc') or $!==&ENOENT or confess $!;
my @sign_cmd = (@gpg, qw(--detach-sign --armor));
push @sign_cmd, qw(-u),$keyid if defined $keyid;
push @sign_cmd, $tfn->('.tmp');
$we_are_responder = 1;
$us .= " (build host)";
- open PI, "<&STDIN" or die $!;
- open STDIN, "/dev/null" or die $!;
- open PO, ">&STDOUT" or die $!;
+ open PI, "<&STDIN" or confess $!;
+ open STDIN, "/dev/null" or confess $!;
+ open PO, ">&STDOUT" or confess $!;
autoflush PO 1;
- open STDOUT, ">&STDERR" or die $!;
+ open STDOUT, ">&STDERR" or confess $!;
autoflush STDOUT 1;
$vsnwant //= 1;
$i_child_pid = undef; # prevents killing some other process with same pid
printdebug "waiting for build host child $pid...\n";
my $got = waitpid $pid, 0;
- die $! unless $got == $pid;
+ confess $! unless $got == $pid;
fail f_ "build host child failed: %s", waitstatusmsg() if $?;
i_cleanup();
foreach my $localpath (@localpaths) {
protocol_send_file \*RI, $localpath;
}
- print RI "files-end\n" or die $!;
+ print RI "files-end\n" or confess $!;
}
our ($i_clogp, $i_version, $i_dscfn, $i_changesfn, @i_buildinfos);
my $descfn = ".git/dgit/quilt-description.tmp";
open O, '>', $descfn or confess "$descfn: $!";
$msg =~ s/\n+/\n\n/;
- print O <<END or die $!;
+ print O <<END or confess $!;
From: $author
${xinfo}Subject: $msg
---
END
- close O or die $!;
+ close O or confess $!;
{
local $ENV{'EDITOR'} = cmdoutput qw(realpath --), $0;
" to record .gitignore changes",
$gipatch
if (stat _)[7];
- print GIPATCH <<END.<<ENDU or die "$gipatch: $!";
+ print GIPATCH +(__ <<END).<<ENDU or die "$gipatch: $!";
Subject: Update .gitignore from Debian packaging branch
The Debian packaging git branch contains these updates to the upstream
close GIPATCH or die "$gipatch: $!";
runcmd shell_cmd "exec >>$gipatch", @git, qw(diff),
$unapplied, $headref, "--", sort keys %$editedignores;
- open SERIES, "+>>", "debian/patches/series" or die $!;
- defined seek SERIES, -1, 2 or $!==EINVAL or die $!;
+ open SERIES, "+>>", "debian/patches/series" or confess $!;
+ defined seek SERIES, -1, 2 or $!==EINVAL or confess $!;
my $newline;
- defined read SERIES, $newline, 1 or die $!;
- print SERIES "\n" or die $! unless $newline eq "\n";
- print SERIES "auto-gitignore\n" or die $!;
+ defined read SERIES, $newline, 1 or confess $!;
+ print SERIES "\n" or confess $! unless $newline eq "\n";
+ print SERIES "auto-gitignore\n" or confess $!;
close SERIES or die $!;
runcmd @git, qw(add -f -- debian/patches/series), $gipatch;
- commit_admin <<END.<<ENDU
+ commit_admin +(__ <<END).<<ENDU
Commit patch to update .gitignore
END
changedir "$playground/work";
- my $saved = maybe_split_brain_save $headref, $dgitview, "converted";
- progress "dgit view: created ($saved)";
+ my $saved = maybe_split_brain_save $headref, $dgitview, __ "converted";
+ progress f_ "dgit view: created (%s)", $saved;
}
sub quiltify ($$$$) {
my $c = shift @todo;
next if $considered{$c->{Commit}}++;
- $not->($c, "maximum search space exceeded") if --$max_work <= 0;
+ $not->($c, __ "maximum search space exceeded") if --$max_work <= 0;
printdebug "quiltify investigate $c->{Commit}\n";
}
my $c_sentinels = quiltify_tree_sentinelfiles $c->{Commit};
- $not->($c, "has $c_sentinels not $t_sentinels")
+ $not->($c, f_ "has %s not %s", $c_sentinels, $t_sentinels)
if $c_sentinels ne $t_sentinels;
my $commitdata = cmdoutput @git, qw(cat-file commit), $c->{Commit};
my @parents = ($commitdata =~ m/^parent (\w+)$/gm);
@parents = map { { Commit => $_, Child => $c } } @parents;
- $not->($c, "root commit") if !@parents;
+ $not->($c, __ "root commit") if !@parents;
foreach my $p (@parents) {
$p->{Nontrivial}= quiltify_trees_differ $p->{Commit},$c->{Commit};
}
my $ndiffers = grep { $_->{Nontrivial} } @parents;
- $not->($c, "merge ($ndiffers nontrivial parents)") if $ndiffers > 1;
+ $not->($c, f_ "merge (%s nontrivial parents)", $ndiffers)
+ if $ndiffers > 1;
foreach my $p (@parents) {
printdebug "considering C=$c->{Commit} P=$p->{Commit}\n";
my $patchstackchange = cmdoutput @cmd;
if (length $patchstackchange) {
$patchstackchange =~ s/\n/,/g;
- $not->($p, "changed $patchstackchange");
+ $not->($p, f_ "changed %s", $patchstackchange);
}
printdebug " search queue P=$p->{Commit} ",
return $x;
};
if ($quilt_mode eq 'linear') {
- print STDERR "\n$us: error: quilt fixup cannot be linear. Stopped at:\n";
+ print STDERR f_
+ "\n%s: error: quilt fixup cannot be linear. Stopped at:\n",
+ $us;
my $all_gdr = !!@nots;
foreach my $notp (@nots) {
my $c = $notp->{Child};
my $cprange = $abbrev->($notp);
$cprange .= "..".$abbrev->($c) if $c;
- print STDERR "$us: $cprange: $notp->{Whynot}\n";
+ print STDERR f_ "%s: %s: %s\n",
+ $us, $cprange, $notp->{Whynot};
$all_gdr &&= $notp->{Child} &&
(git_cat_file $notp->{Child}{Commit}, 'commit')
=~ m{^\[git-debrebase(?! split[: ]).*\]$}m;
[ grep { $_->[0] ne 'quilt-mode' } @$failsuggestion ]
if $all_gdr;
print STDERR "$us: $_->[1]\n" foreach @$failsuggestion;
- fail
+ fail __
"quilt history linearisation failed. Search \`quilt fixup' in dgit(7).\n";
} elsif ($quilt_mode eq 'smash') {
} elsif ($quilt_mode eq 'auto') {
- progress "quilt fixup cannot be linear, smashing...";
+ progress __ "quilt fixup cannot be linear, smashing...";
} else {
- die "$quilt_mode ?";
+ confess "$quilt_mode ?";
}
my $time = $ENV{'GIT_COMMITTER_DATE'} || time;
quiltify_dpkg_commit "auto-$version-$target-$time",
(getfield $clogp, 'Maintainer'),
- "Automatically generated patch ($clogp->{Version})\n".
- "Last (up to) $ncommits git changes, FYI:\n\n". $msg;
+ (f_ "Automatically generated patch (%s)\n".
+ "Last (up to) %s git changes, FYI:\n\n",
+ $clogp->{Version}, $ncommits).
+ $msg;
return;
}
- progress "quiltify linearisation planning successful, executing...";
+ progress __ "quiltify linearisation planning successful, executing...";
for (my $p = $sref_S;
my $c = $p->{Child};
my ($what) = @_;
eval {
- die "contains unexpected slashes\n" if m{//} || m{/$};
- die "contains leading punctuation\n" if m{^\W} || m{/\W};
- die "contains bad character(s)\n" if m{[^-a-z0-9_.+=~/]}i;
- die "is series file\n" if m{$series_filename_re}o;
- die "too long\n" if length > 200;
+ die __ "contains unexpected slashes\n" if m{//} || m{/$};
+ die __ "contains leading punctuation\n" if m{^\W} || m{/\W};
+ die __ "contains bad character(s)\n" if m{[^-a-z0-9_.+=~/]}i;
+ die __ "is series file\n" if m{$series_filename_re}o;
+ die __ "too long\n" if length > 200;
};
return $_ unless $@;
- print STDERR "quiltifying commit $cc:".
- " ignoring/dropping Gbp-Pq $what: $@";
+ print STDERR f_
+ "quiltifying commit %s: ignoring/dropping Gbp-Pq %s: %s",
+ $cc, $what, $@;
return undef;
};
$patchname = $translitname;
};
print STDERR
- "dgit: patch title transliteration error: $@"
+ +(f_ "dgit: patch title transliteration error: %s", $@)
if $@;
$patchname =~ y/ A-Z/-a-z/;
$patchname =~ y/-a-z0-9_.+=~//cd;
for ($index='';
stat "debian/patches/$patchname$index";
$index++) { }
- $!==ENOENT or die "$patchname$index $!";
+ $!==ENOENT or confess "$patchname$index $!";
runcmd @git, qw(checkout -q), $cc;
sub unpack_playtree_mkwork ($) {
my ($headref) = @_;
- mkdir "work" or die $!;
+ mkdir "work" or confess $!;
changedir "work";
mktree_in_ud_here();
runcmd @git, qw(reset -q --hard), $headref;
sub quilt_fixup_delete_pc () {
runcmd @git, qw(rm -rqf .pc);
- commit_admin <<END.<<ENDU
+ commit_admin +(__ <<END).<<ENDU
Commit removal of .pc (quilt series tracking data)
END
sub quilt_fixup_singlepatch ($$$) {
my ($clogp, $headref, $upstreamversion) = @_;
- progress "starting quiltify (single-debian-patch)";
+ progress __ "starting quiltify (single-debian-patch)";
# dpkg-source --commit generates new patches even if
# single-debian-patch is in debian/source/options. In order to
my $fakeversion="$upstreamversion-~~DGITFAKE";
- my $fakedsc=new IO::File 'fake.dsc', '>' or die $!;
- print $fakedsc <<END or die $!;
+ my $fakedsc=new IO::File 'fake.dsc', '>' or confess $!;
+ print $fakedsc <<END or confess $!;
Format: 3.0 (quilt)
Source: $package
Version: $fakeversion
my $md = new Digest::MD5;
my $fh = new IO::File $b, '<' or die "$b $!";
- stat $fh or die $!;
+ stat $fh or confess $!;
my $size = -s _;
$md->addfile($fh);
- print $fakedsc " ".$md->hexdigest." $size $b\n" or die $!;
+ print $fakedsc " ".$md->hexdigest." $size $b\n" or confess $!;
};
unpack_playtree_linkorigs($upstreamversion, $dscaddfile);
runcmd qw(env GZIP=-1n tar -zcf), "./$debtar", qw(-C), $maindir, @files;
$dscaddfile->($debtar);
- close $fakedsc or die $!;
+ close $fakedsc or confess $!;
}
sub quilt_fakedsc2unapplied ($$) {
changedir 'fake';
- remove_stray_gits("source package");
+ remove_stray_gits(__ "source package");
mktree_in_ud_here();
rmtree '.pc';
my $splitbrain_cachekey;
- progress
- "dgit: split brain (separate dgit view) may be needed (--quilt=$quilt_mode).";
+ progress f_
+ "dgit: split brain (separate dgit view) may be needed (--quilt=%s).",
+ $quilt_mode;
# we look in the reflog of dgit-intern/quilt-cache
# we look for an entry whose message is the key for the cache lookup
my @cachekey = (qw(dgit), $our_version);
unpack_playtree_mkwork($headref);
my $saved = maybe_split_brain_save $headref, $cachehit, "cache-hit";
if ($cachehit ne $headref) {
- progress "dgit view: found cached ($saved)";
+ progress f_ "dgit view: found cached (%s)", $saved;
runcmd @git, qw(checkout -q -b dgit-view), $cachehit;
$split_brain = 1;
return ($cachehit, $splitbrain_cachekey);
}
- progress "dgit view: found cached, no changes required";
+ progress __ "dgit view: found cached, no changes required";
return ($headref, $splitbrain_cachekey);
}
sub quilt_fixup_multipatch ($$$) {
my ($clogp, $headref, $upstreamversion) = @_;
- progress "examining quilt state (multiple patches, $quilt_mode mode)";
+ progress f_ "examining quilt state (multiple patches, %s mode)",
+ $quilt_mode;
# Our objective is:
# - honour any existing .pc in case it has any strangeness
$!=0; $?=-1;
if (system @bbcmd) {
failedcmd @bbcmd if $? < 0;
- fail <<END;
+ fail __ <<END;
failed to apply your git tree's patch stack (from debian/patches/) to
the corresponding upstream tarball(s). Your source tree and .orig
are probably too inconsistent. dgit can only fix up certain kinds of
my $mustdeletepc=0;
if (stat_exists ".pc") {
-d _ or die;
- progress "Tree already contains .pc - will use it then delete it.";
+ progress __ "Tree already contains .pc - will use it then delete it.";
$mustdeletepc=1;
} else {
- rename '../fake/.pc','.pc' or die $!;
+ rename '../fake/.pc','.pc' or confess $!;
}
changedir '../fake';
}
printdebug "differences \@dl @dl.\n";
- progress sprintf
-"$us: base trees orig=%.20s o+d/p=%.20s",
- $unapplied, $oldtiptree;
- progress sprintf
-"$us: quilt differences: src: %s orig %s gitignores: %s orig %s\n".
-"$us: quilt differences: HEAD %s o+d/p HEAD %s o+d/p",
- $dl[0], $dl[1], $dl[3], $dl[4],
- $dl[2], $dl[5];
+ progress f_
+"%s: base trees orig=%.20s o+d/p=%.20s",
+ $us, $unapplied, $oldtiptree;
+ progress f_
+"%s: quilt differences: src: %s orig %s gitignores: %s orig %s\n".
+"%s: quilt differences: HEAD %s o+d/p HEAD %s o+d/p",
+ $us, $dl[0], $dl[1], $dl[3], $dl[4],
+ $us, $dl[2], $dl[5];
if (@unrepres) {
- print STDERR "dgit: cannot represent change: $_->[1]: $_->[0]\n"
+ print STDERR f_ "dgit: cannot represent change: %s: %s\n",
+ $_->[1], $_->[0]
foreach @unrepres;
- forceable_fail [qw(unrepresentable)], <<END;
+ forceable_fail [qw(unrepresentable)], __ <<END;
HEAD has changes to .orig[s] which are not representable by `3.0 (quilt)'
END
}
my @failsuggestion;
if (!($diffbits->{O2H} & $diffbits->{O2A})) {
- push @failsuggestion, [ 'unapplied',
- "This might be a patches-unapplied branch." ];
+ push @failsuggestion, [ 'unapplied', __
+ "This might be a patches-unapplied branch." ];
} elsif (!($diffbits->{H2A} & $diffbits->{O2A})) {
- push @failsuggestion, [ 'applied',
- "This might be a patches-applied branch." ];
+ push @failsuggestion, [ 'applied', __
+ "This might be a patches-applied branch." ];
}
- push @failsuggestion, [ 'quilt-mode',
+ push @failsuggestion, [ 'quilt-mode', __
"Maybe you need one of --[quilt=]gbp --[quilt=]dpm --quilt=unapplied ?" ];
- push @failsuggestion, [ 'gitattrs',
+ push @failsuggestion, [ 'gitattrs', __
"Warning: Tree has .gitattributes. See GITATTRIBUTES in dgit(7)." ]
if stat_exists '.gitattributes';
- push @failsuggestion, [ 'origs',
+ push @failsuggestion, [ 'origs', __
"Maybe orig tarball(s) are not identical to git representation?" ];
if (quiltmode_splitbrain()) {
return;
}
- progress "starting quiltify (multiple patches, $quilt_mode mode)";
+ progress f_ "starting quiltify (multiple patches, %s mode)", $quilt_mode;
quiltify($clogp,$headref,$oldtiptree,\@failsuggestion);
if (!open P, '>>', ".pc/applied-patches") {
- $!==&ENOENT or die $!;
+ $!==&ENOENT or confess $!;
} else {
close P;
}
sub quilt_fixup_editor () {
my $descfn = $ENV{$fakeeditorenv};
my $editing = $ARGV[$#ARGV];
- open I1, '<', $descfn or die "$descfn: $!";
- open I2, '<', $editing or die "$editing: $!";
- unlink $editing or die "$editing: $!";
- open O, '>', $editing or die "$editing: $!";
- while (<I1>) { print O or die $!; } I1->error and die $!;
+ open I1, '<', $descfn or confess "$descfn: $!";
+ open I2, '<', $editing or confess "$editing: $!";
+ unlink $editing or confess "$editing: $!";
+ open O, '>', $editing or confess "$editing: $!";
+ while (<I1>) { print O or confess $!; } I1->error and confess $!;
my $copying = 0;
while (<I2>) {
$copying ||= m/^\-\-\- /;
next unless $copying;
- print O or die $!;
+ print O or confess $!;
}
- I2->error and die $!;
+ I2->error and confess $!;
close O or die $1;
finish 0;
}
sub maybe_apply_patches_dirtily () {
return unless $quilt_mode =~ m/gbp|unapplied/;
- print STDERR <<END or die $!;
+ print STDERR <<END or confess $!;
dgit: Building, or cleaning with rules target, in patches-unapplied tree.
dgit: Have to apply the patches - making the tree dirty.
} elsif ($cleanmode eq 'check') {
my $leftovers = cmdoutput @git, qw(clean -xdn);
if (length $leftovers) {
- print STDERR $leftovers, "\n" or die $!;
+ print STDERR $leftovers, "\n" or confess $!;
fail "tree contains uncommitted files and --clean=check specified";
}
} elsif ($cleanmode eq 'none') {
} else {
fail "wrong number of different changes files (@changesfiles)";
}
- printdone "build successful, results in $result\n" or die $!;
+ printdone "build successful, results in $result\n" or confess $!;
}
sub midbuild_checkchanges () {
if ($gbp_make_orig) {
my $priv = dgit_privdir();
my $ok = "$priv/origs-gen-ok";
- unlink $ok or $!==&ENOENT or die $!;
+ unlink $ok or $!==&ENOENT or confess $!;
my @origs_cmd = @cmd;
push @origs_cmd, qw(--git-cleaner=true);
push @origs_cmd, "--git-prebuild=".
my $uv = upstreamversion $version;
quilt_make_fake_dsc($uv);
my $u = quilt_fakedsc2unapplied($headref, $uv);
- print $u, "\n" or die $!;
+ print $u, "\n" or confess $!;
}
sub import_dsc_result {
badusage "no arguments allowed to dgit print-dgit-repos-server-source-url"
if @ARGV;
my $url = repos_server_url();
- print $url, "\n" or die $!;
+ print $url, "\n" or confess $!;
}
sub pre_print_dpkg_source_ignores {
sub cmd_print_dpkg_source_ignores {
badusage "no arguments allowed to dgit print-dpkg-source-ignores"
if @ARGV;
- print "@dpkg_source_ignores\n" or die $!;
+ print "@dpkg_source_ignores\n" or confess $!;
}
sub cmd_setup_mergechangelogs {
#---------- argument parsing and main program ----------
sub cmd_version {
- print "dgit version $our_version\n" or die $!;
+ print "dgit version $our_version\n" or confess $!;
finish 0;
}
sub check_env_sanity () {
my $blocked = new POSIX::SigSet;
- sigprocmask SIG_UNBLOCK, $blocked, $blocked or die $!;
+ sigprocmask SIG_UNBLOCK, $blocked, $blocked or confess $!;
eval {
foreach my $name (qw(PIPE CHLD)) {
print STDERR "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n"
if $dryrun_level == 1;
if (!@ARGV) {
- print STDERR __ $helpmsg or die $!;
+ print STDERR __ $helpmsg or confess $!;
finish 8;
}
$cmd = $subcommand = shift @ARGV;
~ianmdlvl / dgit.git / blobdiff