diff options
| -rw-r--r-- | Debian/Dgit.pm | 56 | ||||
| -rwxr-xr-x | dgit | 240 | ||||
| -rwxr-xr-x | git-debrebase | 42 |
3 files changed, 169 insertions, 169 deletions
diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm index 2ef32f3..61476d9 100644 --- a/Debian/Dgit.pm +++ b/Debian/Dgit.pm @@ -148,11 +148,11 @@ sub setup_sigwarn () { sub initdebug ($) { ($debugprefix) = @_; - open DEBUG, ">/dev/null" or confess $!; + open DEBUG, ">/dev/null" or confess "$!"; } sub enabledebug () { - open DEBUG, ">&STDERR" or confess $!; + open DEBUG, ">&STDERR" or confess "$!"; DEBUG->autoflush(1); $debuglevel ||= 1; } @@ -181,7 +181,7 @@ sub printdebug { print DEBUG $debugprefix unless $printdebug_noprefix; pop @_ while @_ and !length $_[-1]; return unless @_; - print DEBUG @_ or confess $!; + print DEBUG @_ or confess "$!"; $printdebug_noprefix = $_[-1] !~ m{\n$}; } @@ -214,9 +214,9 @@ sub shellquote { sub printcmd { my $fh = shift @_; my $intro = shift @_; - print $fh $intro," " or confess $!; - print $fh shellquote @_ or confess $!; - print $fh "\n" or confess $!; + print $fh $intro," " or confess "$!"; + print $fh shellquote @_ or confess "$!"; + print $fh "\n" or confess "$!"; } sub debugcmd { @@ -347,7 +347,7 @@ sub waitstatusmsg () { sub failedcmd_report_cmd { my $intro = shift @_; $intro //= __ "failed command"; - { local ($!); printcmd \*STDERR, _us().": $intro:", @_ or confess $!; }; + { local ($!); printcmd \*STDERR, _us().": $intro:", @_ or confess "$!"; }; } sub failedcmd_waitstatus { @@ -395,7 +395,7 @@ sub cmdoutput_errok { my $d; $!=0; $?=0; { local $/ = undef; $d = <P>; } - confess $! if P->error; + confess "$!" if P->error; if (!close P) { printdebug "=>!$?\n"; return undef; } chomp $d; if ($debuglevel > 0) { @@ -528,10 +528,10 @@ sub git_cat_file ($;$) { if (!$gcf_pid) { my @cmd = qw(git cat-file --batch); debugcmd "GCF|", @cmd; - $gcf_pid = open2 $gcf_o, $gcf_i, @cmd or confess $!; + $gcf_pid = open2 $gcf_o, $gcf_i, @cmd or confess "$!"; } printdebug "GCF>| $objname\n"; - print $gcf_i $objname, "\n" or confess $!; + print $gcf_i $objname, "\n" or confess "$!"; my $x = <$gcf_o>; printdebug "GCF<| ", $x; if ($x =~ m/ (missing)$/) { return $chk->($1, undef); } @@ -567,7 +567,7 @@ sub git_for_each_ref ($$;$) { if (defined $gitdir) { @cmd = ('sh','-ec','cd "$1"; shift; exec "$@"','x', $gitdir, @cmd); } - open GFER, "-|", @cmd or confess $!; + open GFER, "-|", @cmd or confess "$!"; debugcmd "|", @cmd; while (<GFER>) { chomp or confess "$_ ?"; @@ -665,7 +665,7 @@ sub git_slurp_config_src ($) { local $/="\0"; my $r = { }; - open GITS, "-|", @cmd or confess $!; + open GITS, "-|", @cmd or confess "$!"; while (<GITS>) { chomp or confess; printdebug "=> ", (messagequote $_), "\n"; @@ -728,7 +728,7 @@ sub parsecontrol { my $fh = new IO::Handle; open $fh, '<', $file or fail f_ "open %s (%s): %s", $file, $desc, $!; my $c = parsecontrolfh($fh,$desc,$allowsigned); - $fh->error and confess $!; + $fh->error and confess "$!"; close $fh; return $c; } @@ -737,7 +737,7 @@ sub parsechangelog { my $c = Dpkg::Control::Hash->new(name => 'parsed changelog'); my $p = new IO::Handle; my @cmd = (qw(dpkg-parsechangelog), @_); - open $p, '-|', @cmd or confess $!; + open $p, '-|', @cmd or confess "$!"; $c->parse($p); $?=0; $!=0; close $p or failedcmd @cmd; return $c; @@ -755,7 +755,7 @@ sub parsechangelog_loop ($$$) { # @$clogcmd is qw(dpkg-parsechangelog ...some...options...) # calls $fn->($thisstanza, $desc); debugcmd "|",@$clogcmd; - open CLOGS, "-|", @$clogcmd or confess $!; + open CLOGS, "-|", @$clogcmd or confess "$!"; for (;;) { my $stanzatext = do { local $/=""; <CLOGS>; }; printdebug "clogp stanza ".Dumper($stanzatext) if $debuglevel>1; @@ -767,7 +767,7 @@ sub parsechangelog_loop ($$$) { $fn->($thisstanza, $desc); } - confess $! if CLOGS->error; + confess "$!" if CLOGS->error; close CLOGS or $?==SIGPIPE or failedcmd @$clogcmd; } @@ -777,11 +777,11 @@ sub make_commit_text ($) { my @cmd = (qw(git hash-object -w -t commit --stdin)); debugcmd "|",@cmd; print Dumper($text) if $debuglevel > 1; - my $child = open2($out, $in, @cmd) or confess $!; + my $child = open2($out, $in, @cmd) or confess "$!"; my $h; eval { - print $in $text or confess $!; - close $in or confess $!; + print $in $text or confess "$!"; + close $in or confess "$!"; $h = <$out>; $h =~ m/^\w+$/ or confess; $h = $&; @@ -803,7 +803,7 @@ sub reflog_cache_insert ($$$) { my $parent = $ref; $parent =~ s{/[^/]+$}{}; ensuredir "$maindir_gitcommon/logs/$parent"; my $makelogfh = new IO::File "$maindir_gitcommon/logs/$ref", '>>' - or confess $!; + or confess "$!"; my $oldcache = git_get_ref $ref; @@ -832,11 +832,11 @@ sub reflog_cache_lookup ($$) { # you must have called record_maindir my @cmd = (qw(git log -g), '--pretty=format:%H %gs', $ref); debugcmd "|(probably)",@cmd; - my $child = open GC, "-|"; defined $child or confess $!; + my $child = open GC, "-|"; defined $child or confess "$!"; if (!$child) { - chdir $maindir or confess $!; + chdir $maindir or confess "$!"; if (!stat "$maindir_gitcommon/logs/$ref") { - $! == ENOENT or confess $!; + $! == ENOENT or confess "$!"; printdebug ">(no reflog)\n"; finish 0; } @@ -849,7 +849,7 @@ sub reflog_cache_lookup ($$) { close GC; return $1; } - confess $! if GC->error; + confess "$!" if GC->error; failedcmd unless close GC; return undef; } @@ -975,11 +975,11 @@ sub playtree_setup (;$) { # $maindir_gitdir contains our main working "dgit", HEAD, etc. # $maindir_gitcommon the shared stuff, including .objects rmtree('.git/objects'); - symlink "$maindir_gitcommon/objects",'.git/objects' or confess $!; + symlink "$maindir_gitcommon/objects",'.git/objects' or confess "$!"; ensuredir '.git/info'; - open GA, "> .git/info/attributes" or confess $!; - print GA "* $negate_harmful_gitattrs\n" or confess $!; - close GA or confess $!; + open GA, "> .git/info/attributes" or confess "$!"; + print GA "* $negate_harmful_gitattrs\n" or confess "$!"; + close GA or confess "$!"; } 1; @@ -524,11 +524,11 @@ sub protocol_send_file ($$) { my $got = read PF, $d, 65536; die "$ourfn: $!" unless defined $got; last if !$got; - print $fh "data-block ".length($d)."\n" or confess $!; - print $fh $d or confess $!; + 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 confess $!; + print $fh "data-end\n" or confess "$!"; close PF; } @@ -553,9 +553,9 @@ sub protocol_receive_file ($$) { } $fh; last unless $y; my $d = protocol_read_bytes $fh, $l; - print PF $d or confess $!; + print PF $d or confess "$!"; } - close PF or confess $!; + close PF or confess "$!"; } #---------- remote protocol support, responder ---------- @@ -565,7 +565,7 @@ sub responder_send_command ($) { return unless $we_are_responder; # called even without $we_are_responder printdebug ">> $command\n"; - print PO $command, "\n" or confess $!; + print PO $command, "\n" or confess "$!"; } sub responder_send_file ($$) { @@ -600,8 +600,8 @@ sub initiator_expect (&) { sub progress { if ($we_are_responder) { my $m = join '', @_; - responder_send_command "progress ".length($m) or confess $!; - print PO $m or confess $!; + responder_send_command "progress ".length($m) or confess "$!"; + print PO $m or confess "$!"; } else { print @_, "\n"; } @@ -616,7 +616,7 @@ sub url_get { } my $what = $_[$#_]; progress "downloading $what..."; - my $r = $ua->get(@_) or confess $!; + 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; @@ -680,7 +680,7 @@ Perhaps the upload is stuck in incoming. Using the version from git. END sub badusage { - print STDERR f_ "%s: %s\n%s", $us, "@_", __ $helpmsg or confess $!; + print STDERR f_ "%s: %s\n%s", $us, "@_", __ $helpmsg or confess "$!"; finish 8; } @@ -693,7 +693,7 @@ sub pre_help () { not_necessarily_a_tree(); } sub cmd_help () { - print __ $helpmsg or confess $!; + print __ $helpmsg or confess "$!"; finish 0; } @@ -943,8 +943,8 @@ sub supplementary_message ($) { return; } elsif ($protovsn >= 3) { responder_send_command "supplementary-message ".length($msg) - or confess $!; - print PO $msg or confess $!; + or confess "$!"; + print PO $msg or confess "$!"; } } @@ -1081,7 +1081,7 @@ sub commit_getclogp ($) { } sub parse_dscdata () { - my $dscfh = new IO::File \$dscdata, '<' or confess $!; + 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; @@ -1299,17 +1299,17 @@ sub aptget_prep ($) { cfg_apply_map(\$aptsuites, 'suite map', access_cfg('aptget-suite-map', 'RETURN-UNDEF')); - open SRCS, ">", "$aptget_base/$sourceslist" or confess $!; + open SRCS, ">", "$aptget_base/$sourceslist" or confess "$!"; printf SRCS "deb-src %s %s %s\n", access_cfg('mirror'), $aptsuites, access_cfg('aptget-components') - or confess $!; + or confess "$!"; ensuredir "$aptget_base/cache"; ensuredir "$aptget_base/lists"; - open CONF, ">", $aptget_configpath or confess $!; + open CONF, ">", $aptget_configpath or confess "$!"; print CONF <<END; Debug::NoLocking "true"; APT::Get::List-Cleanup "false"; @@ -1329,10 +1329,10 @@ END Dir::Etc::preferencesparts )) { ensuredir "$aptget_base/$key"; - print CONF "$key \"$quoted_base/$key\";\n" or confess $!; + print CONF "$key \"$quoted_base/$key\";\n" or confess "$!"; }; - my $oldatime = (time // confess $!) - 1; + my $oldatime = (time // confess "$!") - 1; foreach my $oldlist (<$aptget_base/lists/*Release>) { next unless stat_exists $oldlist; my ($mtime) = (stat _)[9]; @@ -1432,7 +1432,7 @@ sub dummycatapi_run_in_mirror ($@) { my @cmd = (qw(sh -ec), 'cd "$1"; shift'."\n".$rune, qw(x), $mirror, @$argl); debugcmd "-|", @cmd; - open FIA, "-|", @cmd or confess $!; + open FIA, "-|", @cmd or confess "$!"; my $r = $fn->(); close FIA or ($!==0 && $?==141) or die failedcmd @cmd; return $r; @@ -1535,7 +1535,7 @@ sub sshpsql ($$$) { " export LC_MESSAGES=C; export LC_CTYPE=C;". " ".shellquote qw(psql -A), $dbname, qw(-c), $sql); debugcmd "|",@cmd; - open P, "-|", @cmd or confess $!; + open P, "-|", @cmd or confess "$!"; while (<P>) { chomp or die; printdebug(">|$_|\n"); @@ -1836,7 +1836,7 @@ sub remove_stray_gits ($) { my ($what) = @_; my @gitscmd = qw(find -name .git -prune -print0); debugcmd "|",@gitscmd; - open GITS, "-|", @gitscmd or confess $!; + open GITS, "-|", @gitscmd or confess "$!"; { local $/="\0"; while (<GITS>) { @@ -2364,9 +2364,9 @@ sub generate_commits_from_dsc () { 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, "-|" // confess $!; + my $compr_pid = open $compr_fh, "-|" // confess "$!"; if (!$compr_pid) { - open STDIN, "<&", $input or confess $!; + open STDIN, "<&", $input or confess "$!"; exec @compr_cmd; die "dgit (child): exec $compr_cmd[0]: $!\n"; } @@ -2374,23 +2374,23 @@ sub generate_commits_from_dsc () { } rmtree "_unpack-tar"; - mkdir "_unpack-tar" or confess $!; + 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 // confess $!; + my $tar_pid = fork // confess "$!"; if (!$tar_pid) { - chdir "_unpack-tar" or confess $!; - open STDIN, "<&", $input or confess $!; + 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 confess $!; + $!=0; (waitpid $tar_pid, 0) == $tar_pid or confess "$!"; !$? or failedcmd @tarcmd; close $input or (@compr_cmd ? ($?==SIGPIPE || failedcmd @compr_cmd) - : confess $!); + : confess "$!"); # finally, we have the results in "tarball", but maybe # with the wrong permissions @@ -2547,14 +2547,14 @@ END_T printdebug "import main commit\n"; - open C, ">../commit.tmp" or confess $!; - print C <<END or confess $!; + open C, ">../commit.tmp" or confess "$!"; + print C <<END or confess "$!"; tree $tree END - print C <<END or confess $! foreach @tartrees; + print C <<END or confess "$!" foreach @tartrees; parent $_->{Commit} END - print C <<END or confess $!; + print C <<END or confess "$!"; author $authline committer $authline @@ -2563,7 +2563,7 @@ $changes [dgit import $treeimporthow $package $cversion] END - close C or confess $!; + close C or confess "$!"; my $rawimport_hash = make_commit qw(../commit.tmp); if (madformat $dsc->{format}) { @@ -2608,7 +2608,7 @@ END progress f_ "%s: trying slow absurd-git-apply...", $us; rename "../../gbp-pq-output","../../gbp-pq-output.0" or $!==ENOENT - or confess $!; + or confess "$!"; } eval { die "forbid absurd git-apply\n" if $use_absurd @@ -2674,7 +2674,7 @@ Version actually in archive: %s (older) Last version pushed with dgit: %s (newer or same) %s END - __ $later_warning_msg or confess $!; + __ $later_warning_msg or confess "$!"; @output = $lastpush_mergeinput; } else { # Same version. Use what's in the server git branch, @@ -2704,7 +2704,7 @@ sub complete_file_from_dsc ($$;$) { open F, "<", "$tf" or die "$tf: $!"; $fi->{Digester}->reset(); $fi->{Digester}->addfile(*F); - F->error and confess $!; + F->error and confess "$!"; $got = $fi->{Digester}->hexdigest(); return $got eq $fi->{Hash}; }; @@ -2838,7 +2838,7 @@ sub git_lrfetch_sane { debugcmd "|",@lcmd; my %wantr; - open GITLS, "-|", @lcmd or confess $!; + open GITLS, "-|", @lcmd or confess "$!"; while (<GITLS>) { printdebug "=> ", $_; m/^(\w+)\s+(\S+)\n/ or die "ls-remote $_ ?"; @@ -3260,7 +3260,7 @@ sub fetch_from_archive () { printdebug "del_lrfetchrefs: $objid $fullrefname\n"; if (!$gur) { $gur ||= new IO::Handle; - open $gur, "|-", qw(git update-ref --stdin) or confess $!; + open $gur, "|-", qw(git update-ref --stdin) or confess "$!"; } printf $gur "delete %s %s\n", $fullrefname, $objid; } @@ -3281,7 +3281,7 @@ Commit referred to by archive: %s Last version pushed with dgit: %s %s END - __ $later_warning_msg or confess $!; + __ $later_warning_msg or confess "$!"; @mergeinputs = ($lastpush_mergeinput); } else { # Archive has .dsc which is not a descendant of the last dgit @@ -3316,11 +3316,11 @@ END Package not found in the archive, but has allegedly been pushed using dgit. %s END - __ $later_warning_msg or confess $!; + __ $later_warning_msg or confess "$!"; } else { printdebug "nothing found!\n"; if (defined $skew_warning_vsn) { - print STDERR f_ <<END, $skew_warning_vsn or confess $!; + print STDERR f_ <<END, $skew_warning_vsn or confess "$!"; Warning: relevant archive skew detected. Archive allegedly contains %s @@ -3386,26 +3386,26 @@ END my $mcf = dgit_privdir()."/mergecommit"; open MC, ">", $mcf or die "$mcf $!"; - print MC <<END or confess $!; + print MC <<END or confess "$!"; tree $tree END my @parents = grep { $_->{Commit} } @mergeinputs; @parents = reverse @parents if $compat_info->{ReverseParents}; - print MC <<END or confess $! foreach @parents; + print MC <<END or confess "$!" foreach @parents; parent $_->{Commit} END - print MC <<END or confess $!; + print MC <<END or confess "$!"; author $author committer $author END if (defined $compat_info->{Message}) { - print MC $compat_info->{Message} or confess $!; + print MC $compat_info->{Message} or confess "$!"; } else { - print MC f_ <<END, $package, $cversion, $csuite or confess $!; + print MC f_ <<END, $package, $cversion, $csuite or confess "$!"; Record %s (%s) in archive suite %s Record that @@ -3414,17 +3414,17 @@ END my ($mi) = (@_); my $mversion = mergeinfo_version $mi; printf MC " %-20s %s\n", $mversion, $mi->{Info} - or confess $!; + or confess "$!"; }; $message_add_info->($mergeinputs[0]); - print MC __ <<END or confess $!; + print MC __ <<END or confess "$!"; should be treated as descended from END $message_add_info->($_) foreach @mergeinputs[1..$#mergeinputs]; } - close MC or confess $!; + close MC or confess "$!"; $hash = make_commit $mcf; } else { $hash = $mergeinputs[0]{Commit}; @@ -3449,7 +3449,7 @@ END 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 confess $!; + print STDERR f_ <<END, $skew_warning_vsn, $got_vsn or confess "$!"; Warning: archive skew detected. Using the available version: Archive allegedly contains %s @@ -3493,12 +3493,12 @@ sub setup_mergechangelogs (;$) { while (<ATTRS>) { chomp; next if m{^debian/changelog\s}; - print NATTRS $_, "\n" or confess $!; + print NATTRS $_, "\n" or confess "$!"; } - ATTRS->error and confess $!; + ATTRS->error and confess "$!"; close ATTRS; } - print NATTRS "debian/changelog merge=$driver\n" or confess $!; + print NATTRS "debian/changelog merge=$driver\n" or confess "$!"; close NATTRS; set_local_git_config "$cb.name", __ 'debian/changelog merge driver'; @@ -3554,7 +3554,7 @@ sub is_gitattrs_setup () { printdebug "is_gitattrs_setup: found old macro\n"; return 0; } - $gai->error and confess $!; + $gai->error and confess "$!"; printdebug "is_gitattrs_setup: found nothing\n"; return undef; } @@ -3575,8 +3575,8 @@ END my $af = "$maindir_gitcommon/info/attributes"; ensuredir "$maindir_gitcommon/info"; - open GAO, "> $af.new" or confess $!; - print GAO <<END, __ <<ENDT or confess $! unless defined $already; + open GAO, "> $af.new" or confess "$!"; + print GAO <<END, __ <<ENDT or confess "$!" unless defined $already; * dgit-defuse-attrs $new END @@ -3590,11 +3590,11 @@ ENDT $_ = $new; } chomp; - print GAO $_, "\n" or confess $!; + print GAO $_, "\n" or confess "$!"; } - $gai->error and confess $!; + $gai->error and confess "$!"; } - close GAO or confess $!; + close GAO or confess "$!"; rename "$af.new", "$af" or fail f_ "install %s: %s", $af, $!; } @@ -3613,7 +3613,7 @@ sub check_gitattrs ($$) { my @cmd = (@git, qw(ls-tree -lrz --), "${treeish}:"); debugcmd "|",@cmd; my $gafl = new IO::File; - open $gafl, "-|", @cmd or confess $!; + open $gafl, "-|", @cmd or confess "$!"; while (<$gafl>) { chomp or die; s/^\d+\s+\w+\s+\w+\s+(\d+)\t// or die; @@ -3638,7 +3638,7 @@ sub multisuite_suite_child ($$$) { # 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 // confess $!; + my $pid = fork // confess "$!"; if (!$pid) { forkcheck_setup(); $isuite = $tsuite; @@ -3646,17 +3646,17 @@ sub multisuite_suite_child ($$$) { $debugprefix .= " "; progress f_ "fetching %s...", $tsuite; canonicalise_suite(); - print $canonsuitefh $csuite, "\n" or confess $!; - close $canonsuitefh or confess $!; + print $canonsuitefh $csuite, "\n" or confess "$!"; + close $canonsuitefh or confess "$!"; $fn->(); return undef; } - waitpid $pid,0 == $pid or confess $!; + waitpid $pid,0 == $pid or confess "$!"; fail f_ "failed to obtain %s: %s", $tsuite, waitstatusmsg() if $? && $?!=256*4; - seek $canonsuitefh,0,0 or confess $!; + seek $canonsuitefh,0,0 or confess "$!"; local $csuite = <$canonsuitefh>; - confess $! unless defined $csuite && chomp $csuite; + confess "$!" unless defined $csuite && chomp $csuite; if ($? == 256*4) { printdebug "multisuite $tsuite missing\n"; return $csuite; @@ -3799,9 +3799,9 @@ sub fork_for_multisuite ($) { } sub clone_set_head () { - open H, "> .git/HEAD" or confess $!; - print H "ref: ".lref()."\n" or confess $!; - close H or confess $!; + open H, "> .git/HEAD" or confess "$!"; + print H "ref: ".lref()."\n" or confess "$!"; + close H or confess "$!"; } sub clone_finish ($) { my ($dstdir) = @_; @@ -3983,18 +3983,18 @@ sub get_source_format () { $options{$_} = 1; } } - F->error and confess $!; + F->error and confess "$!"; close F; } else { - confess $! unless $!==&ENOENT; + confess "$!" unless $!==&ENOENT; } if (!open F, "debian/source/format") { - confess $! unless $!==&ENOENT; + confess "$!" unless $!==&ENOENT; return ''; } $_ = <F>; - F->error and confess $!; + F->error and confess "$!"; chomp; return ($_, \%options); } @@ -4131,7 +4131,7 @@ sub pseudomerge_make_commit ($$$$ $$) { # git rev-list --first-parent DTRT. my $pmf = dgit_privdir()."/pseudomerge"; open MC, ">", $pmf or die "$pmf $!"; - print MC <<END or confess $!; + print MC <<END or confess "$!"; tree $tree parent $dgitview parent $archive_hash @@ -4142,7 +4142,7 @@ $msg_msg [$msg_cmd] END - close MC or confess $!; + close MC or confess "$!"; return make_commit($pmf); } @@ -4322,7 +4322,7 @@ sub push_mktags ($$ $$ $) { $dsc->{$ourdscfield[0]} = join " ", $tagwants->[0]{Objid}, $declaredistro, $tagwants->[0]{Tag}, $reader_giturl; - $dsc->save("$dscfn.tmp") or confess $!; + $dsc->save("$dscfn.tmp") or confess "$!"; my $changes = parsecontrol($changesfile,$changesfilewhat); foreach my $field (qw(Source Distribution Version)) { @@ -4345,8 +4345,8 @@ sub push_mktags ($$ $$ $) { my $head = $tw->{Objid}; my $tag = $tw->{Tag}; - open TO, '>', $tfn->('.tmp') or confess $!; - print TO <<END or confess $!; + open TO, '>', $tfn->('.tmp') or confess "$!"; + print TO <<END or confess "$!"; object $head type commit tag $tag @@ -4357,12 +4357,12 @@ END print TO f_ <<ENDT, $package, $cversion, $clogsuite, $csuite %s release %s for %s (%s) [dgit] ENDT - or confess $!; - print TO <<END or confess $!; + or confess "$!"; + print TO <<END or confess "$!"; [dgit distro=$declaredistro$delibs] END foreach my $ref (sort keys %previously) { - print TO <<END or confess $!; + print TO <<END or confess "$!"; [dgit previously:$ref=$previously{$ref}] END } @@ -4372,12 +4372,12 @@ END (maintainer view tag generated by dgit --quilt=%s) END $quilt_mode - or confess $!; + or confess "$!"; } else { confess Dumper($tw)."?"; } - close TO or confess $!; + close TO or confess "$!"; my $tagobjfn = $tfn->('.tmp'); if ($sign) { @@ -4387,7 +4387,7 @@ END if (!defined $keyid) { $keyid = getfield $clogp, 'Maintainer'; } - unlink $tfn->('.tmp.asc') or $!==&ENOENT or confess $!; + 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'); @@ -4994,11 +4994,11 @@ sub pre_remote_push_build_host { $we_are_responder = 1; $us .= " (build host)"; - open PI, "<&STDIN" or confess $!; - open STDIN, "/dev/null" or confess $!; - open PO, ">&STDOUT" or confess $!; + open PI, "<&STDIN" or confess "$!"; + open STDIN, "/dev/null" or confess "$!"; + open PO, ">&STDOUT" or confess "$!"; autoflush PO 1; - open STDOUT, ">&STDERR" or confess $!; + open STDOUT, ">&STDERR" or confess "$!"; autoflush STDOUT 1; $vsnwant //= 1; @@ -5122,7 +5122,7 @@ sub i_resp_complete { $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; - confess $! unless $got == $pid; + confess "$!" unless $got == $pid; fail f_ "build host child failed: %s", waitstatusmsg() if $?; i_cleanup(); @@ -5178,7 +5178,7 @@ sub i_resp_want ($) { foreach my $localpath (@localpaths) { protocol_send_file \*RI, $localpath; } - print RI "files-end\n" or confess $!; + print RI "files-end\n" or confess "$!"; } our ($i_clogp, $i_version, $i_dscfn, $i_changesfn, @i_buildinfos); @@ -5285,13 +5285,13 @@ sub quiltify_dpkg_commit ($$$;$) { my $descfn = ".git/dgit/quilt-description.tmp"; open O, '>', $descfn or confess "$descfn: $!"; $msg =~ s/\n+/\n\n/; - print O <<END or confess $!; + print O <<END or confess "$!"; From: $author ${xinfo}Subject: $msg --- END - close O or confess $!; + close O or confess "$!"; { local $ENV{'EDITOR'} = cmdoutput qw(realpath --), $0; @@ -5473,12 +5473,12 @@ ENDU close GIPATCH or die "$gipatch: $!"; runcmd shell_cmd "exec >>$gipatch", @git, qw(diff), $unapplied, $headref, "--", sort keys %$editedignores; - open SERIES, "+>>", "debian/patches/series" or confess $!; - defined seek SERIES, -1, 2 or $!==EINVAL or confess $!; + open SERIES, "+>>", "debian/patches/series" or confess "$!"; + defined seek SERIES, -1, 2 or $!==EINVAL or confess "$!"; my $newline; - defined read SERIES, $newline, 1 or confess $!; - print SERIES "\n" or confess $! unless $newline eq "\n"; - print SERIES "auto-gitignore\n" or confess $!; + 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 @@ -5848,7 +5848,7 @@ END sub unpack_playtree_mkwork ($) { my ($headref) = @_; - mkdir "work" or confess $!; + mkdir "work" or confess "$!"; changedir "work"; mktree_in_ud_here(); runcmd @git, qw(reset -q --hard), $headref; @@ -5920,8 +5920,8 @@ sub quilt_make_fake_dsc ($) { my $fakeversion="$upstreamversion-~~DGITFAKE"; - my $fakedsc=new IO::File 'fake.dsc', '>' or confess $!; - print $fakedsc <<END or confess $!; + my $fakedsc=new IO::File 'fake.dsc', '>' or confess "$!"; + print $fakedsc <<END or confess "$!"; Format: 3.0 (quilt) Source: $package Version: $fakeversion @@ -5934,11 +5934,11 @@ END my $md = new Digest::MD5; my $fh = new IO::File $leaf, '<' or die "$leaf $!"; - stat $fh or confess $!; + stat $fh or confess "$!"; my $size = -s _; $md->addfile($fh); - print $fakedsc " ".$md->hexdigest." $size $leaf\n" or confess $!; + print $fakedsc " ".$md->hexdigest." $size $leaf\n" or confess "$!"; }; unpack_playtree_linkorigs($upstreamversion, $dscaddfile); @@ -5955,7 +5955,7 @@ END runcmd qw(env GZIP=-1n tar -zcf), "./$debtar", qw(-C), $maindir, @files; $dscaddfile->($debtar); - close $fakedsc or confess $!; + close $fakedsc or confess "$!"; } sub quilt_fakedsc2unapplied ($$) { @@ -6148,7 +6148,7 @@ END progress __ "Tree already contains .pc - will use it then delete it."; $mustdeletepc=1; } else { - rename '../fake/.pc','.pc' or confess $!; + rename '../fake/.pc','.pc' or confess "$!"; } changedir '../fake'; @@ -6228,7 +6228,7 @@ END quiltify($clogp,$headref,$oldtiptree,\@failsuggestion); if (!open P, '>>', ".pc/applied-patches") { - $!==&ENOENT or confess $!; + $!==&ENOENT or confess "$!"; } else { close P; } @@ -6247,21 +6247,21 @@ sub quilt_fixup_editor () { 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 $!; + while (<I1>) { print O or confess "$!"; } I1->error and confess "$!"; my $copying = 0; while (<I2>) { $copying ||= m/^\-\-\- /; next unless $copying; - print O or confess $!; + print O or confess "$!"; } - I2->error and confess $!; + 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 confess $!; + 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. @@ -6291,7 +6291,7 @@ sub clean_tree_check_git ($$$) { push @cmd, qw(-x) unless $honour_ignores; my $leftovers = cmdoutput @cmd; if (length $leftovers) { - print STDERR $leftovers, "\n" or confess $!; + print STDERR $leftovers, "\n" or confess "$!"; $message .= $ignmessage if $honour_ignores; fail $message; } @@ -6550,7 +6550,7 @@ END "@changesfiles"; } printdone f_ "build successful, results in %s\n", $result - or confess $!; + or confess "$!"; } sub midbuild_checkchanges () { @@ -6648,7 +6648,7 @@ sub cmd_gbp_build { if ($gbp_make_orig) { my $priv = dgit_privdir(); my $ok = "$priv/origs-gen-ok"; - unlink $ok or $!==&ENOENT or confess $!; + unlink $ok or $!==&ENOENT or confess "$!"; my @origs_cmd = @cmd; push @origs_cmd, qw(--git-cleaner=true); push @origs_cmd, "--git-prebuild=". @@ -6880,7 +6880,7 @@ sub cmd_print_unapplied_treeish { my $uv = upstreamversion $version; quilt_make_fake_dsc($uv); my $u = quilt_fakedsc2unapplied($headref, $uv); - print $u, "\n" or confess $!; + print $u, "\n" or confess "$!"; } sub import_dsc_result { @@ -7131,7 +7131,7 @@ sub cmd_print_dgit_repos_server_source_url { "no arguments allowed to dgit print-dgit-repos-server-source-url" if @ARGV; my $url = repos_server_url(); - print $url, "\n" or confess $!; + print $url, "\n" or confess "$!"; } sub pre_print_dpkg_source_ignores { @@ -7141,7 +7141,7 @@ sub cmd_print_dpkg_source_ignores { badusage __ "no arguments allowed to dgit print-dpkg-source-ignores" if @ARGV; - print "@dpkg_source_ignores\n" or confess $!; + print "@dpkg_source_ignores\n" or confess "$!"; } sub cmd_setup_mergechangelogs { @@ -7172,7 +7172,7 @@ sub cmd_setup_new_tree { #---------- argument parsing and main program ---------- sub cmd_version { - print "dgit version $our_version\n" or confess $!; + print "dgit version $our_version\n" or confess "$!"; finish 0; } @@ -7429,7 +7429,7 @@ sub parseopts () { sub check_env_sanity () { my $blocked = new POSIX::SigSet; - sigprocmask SIG_UNBLOCK, $blocked, $blocked or confess $!; + sigprocmask SIG_UNBLOCK, $blocked, $blocked or confess "$!"; eval { foreach my $name (qw(PIPE CHLD)) { @@ -7546,7 +7546,7 @@ print STDERR __ "DRY RUN ONLY\n" if $dryrun_level > 1; print STDERR __ "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n" if $dryrun_level == 1; if (!@ARGV) { - print STDERR __ $helpmsg or confess $!; + print STDERR __ $helpmsg or confess "$!"; finish 8; } $cmd = $subcommand = shift @ARGV; diff --git a/git-debrebase b/git-debrebase index efb0cea..71bf39d 100755 --- a/git-debrebase +++ b/git-debrebase @@ -144,10 +144,10 @@ sub run_ref_updates_now ($$) { my @upd_cmd = (git_update_ref_cmd "debrebase: $mrest", qw(--stdin)); debugcmd '>|', @upd_cmd; - open U, "|-", @upd_cmd or confess $!; + open U, "|-", @upd_cmd or confess "$!"; foreach (@$updates) { printdebug ">= ", $_, "\n"; - print U $_, "\n" or confess $!; + print U $_, "\n" or confess "$!"; } printdebug ">\$\n"; close U or failedcmd @upd_cmd; @@ -611,7 +611,7 @@ sub merge_series ($$$;@) { if ($any) { open S, $seriesfile or confess "$seriesfile $!"; while (my $patch = <S>) { - chomp $patch or confess $!; + chomp $patch or confess "$!"; $prereq{$patch} //= {}; foreach my $earlier (@earlier) { $prereq{$patch}{$earlier}{$s}++ and confess; @@ -708,7 +708,7 @@ sub merge_series ($$$;@) { }; }; - open NS, '>', $seriesfile or confess $!; + open NS, '>', $seriesfile or confess "$!"; while (keys %prereq) { my $best; @@ -723,7 +723,7 @@ sub merge_series ($$$;@) { $best = $try; } printdebug "merge_series series next $best\n"; - print NS "$best\n" or confess $!; + print NS "$best\n" or confess "$!"; delete $prereq{$best}; foreach my $gp (values %prereq) { delete $gp->{$best}; @@ -765,9 +765,9 @@ sub merge_series_patchqueue_convert ($$$) { 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 confess $!; - print C $commit or confess $!; - close C or confess $!; + 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; @@ -1586,7 +1586,7 @@ sub walk ($;$$$) { confess __ "internal error" unless $build eq (pop @processed)->{CommitId}; in_workarea sub { - mkdir $rd or $!==EEXIST or confess $!; + mkdir $rd or $!==EEXIST or confess "$!"; my $current_method; my $want_debian = $build; my $want_upstream = $build; @@ -1696,9 +1696,9 @@ sub walk ($;$$$) { or confess "$ch ?"; } my $cf = "$rd/m$rewriting"; - open CD, ">", $cf or confess $!; - print CD $ch, "\n", $cl->{Msg} or confess $!; - close CD or confess $!; + 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; @@ -1811,7 +1811,7 @@ sub cmd_analyse () { $old = git_rev_parse 'HEAD'; } my ($dummy,$breakwater) = walk $old, 1,*STDOUT; - STDOUT->error and confess $!; + STDOUT->error and confess "$!"; } sub ffq_check ($;$$) { @@ -1828,7 +1828,7 @@ sub ffq_check ($;$$) { # normally $currentval should be HEAD my ($currentval, $ff, $notff) =@_; - $ff //= sub { print $_[0] or confess $!; }; + $ff //= sub { print $_[0] or confess "$!"; }; $notff //= \&snag; my ($status, $message, $current, $ffq_prev, $gdrlast) @@ -2261,7 +2261,7 @@ sub cmd_record_ffq_prev () { 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 confess $!; + print __ "Previous head already recorded\n" or confess "$!"; } elsif ($status eq 'deferred') { run_deferred_updates 'record-ffq-prev'; } else { @@ -2272,13 +2272,13 @@ sub cmd_record_ffq_prev () { sub cmd_anchor () { badusage __ "no arguments allowed" if @ARGV; my ($anchor, $bw) = keycommits +(git_rev_parse 'HEAD'), 0,0; - print "$anchor\n" or confess $!; + print "$anchor\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 confess $!; + print "$bw\n" or confess "$!"; } sub cmd_status () { @@ -2311,7 +2311,7 @@ sub cmd_status () { my $prcommitinfo = sub { my ($cid) = @_; - flush STDOUT or confess $!; + flush STDOUT or confess "$!"; runcmd @git, qw(--no-pager log -n1), '--pretty=format: %h %s%n', $cid; @@ -2674,7 +2674,7 @@ END }; complete_convert_from $old_head, $work, $gdrlastinfo, 'convert-from-gbp'; - print f_ <<END, $us or confess $!; + print f_ <<END, $us or confess "$!"; %s: converted from patched-unapplied (gbp) branch format, OK END } @@ -2703,7 +2703,7 @@ sub cmd_convert_to_gbp () { } snags_maybe_bail(); update_head_checkout $head, $out, "convert to gbp (v0)"; - print f_ <<END, $us,$us,$us or confess $!; + print f_ <<END, $us,$us,$us or confess "$!"; %s: converted to git-buildpackage branch format %s: WARNING: do not now run "git-debrebase" any more %s: WARNING: doing so would drop all upstream patches! @@ -3030,7 +3030,7 @@ getoptions_main push @$opt_defaultcmd_interactive, @ARGV; @ARGV=(); }, - 'help' => sub { print __ $usage_message or confess $!; finish 0; }, + 'help' => sub { print __ $usage_message or confess "$!"; finish 0; }, ); initdebug('git-debrebase '); |