} elsif ($here{$lref} eq $objid) {
lrfetchref_used $fullrefname;
} else {
- print STDERR
- "Not updating $lref from $here{$lref} to $objid.\n";
+ print STDERR f_ "Not updating %s from %s to %s.\n",
+ $lref, $here{$lref}, $objid;
}
});
}
}
if (!defined $f) {
- progress "$what: NO git hash";
+ progress f_ "%s: NO git hash", $what;
parse_dsc_field_def_dsc_distro();
} elsif (($dsc_hash, $dsc_distro, $dsc_hint_tag, $dsc_hint_url)
= $f =~ m/^(\w+)\s+($distro_re)\s+($versiontag_re)\s+(\S+)(?:\s|$)/) {
- progress "$what: specified git info ($dsc_distro)";
+ progress f_ "%s: specified git info (%s)", $what, $dsc_distro;
$dsc_hint_tag = [ $dsc_hint_tag ];
} elsif ($f =~ m/^\w+\s*$/) {
$dsc_hash = $&;
parse_dsc_field_def_dsc_distro();
$dsc_hint_tag = [ debiantags +(getfield $dsc, 'Version'),
$dsc_distro ];
- progress "$what: specified git hash";
+ progress f_ "%s: specified git hash", $what;
} else {
- fail "$what: invalid Dgit info";
+ fail f_ "%s: invalid Dgit info", $what;
}
}
my $lrf = lrfetchrefs;
if (!$chase_dsc_distro) {
- progress
- "not chasing .dsc distro $dsc_distro: not fetching $what";
+ progress f_ "not chasing .dsc distro %s: not fetching %s",
+ $dsc_distro, $what;
return 0;
}
- progress
- ".dsc names distro $dsc_distro: fetching $what";
+ progress f_ ".dsc names distro %s: fetching %s", $dsc_distro, $what;
my $url = access_giturl();
if (!defined $url) {
- defined $dsc_hint_url or fail <<END;
-.dsc Dgit metadata is in context of distro $dsc_distro
+ defined $dsc_hint_url or fail f_ <<END, $dsc_distro;
+.dsc Dgit metadata is in context of distro %s
for which we have no configured url and .dsc provides no hint
END
my $proto =
parse_cfg_bool "dsc-url-proto-ok", 'false',
cfg("dgit.dsc-url-proto-ok.$proto",
"dgit.default.dsc-url-proto-ok")
- or fail <<END;
-.dsc Dgit metadata is in context of distro $dsc_distro
+ or fail f_ <<END, $dsc_distro, $proto;
+.dsc Dgit metadata is in context of distro %s
for which we have no configured url;
-.dsc provides hinted url with protocol $proto which is unsafe.
+.dsc provides hinted url with protocol %s which is unsafe.
(can be overridden by config - consult documentation)
END
$url = $dsc_hint_url;
if (parse_cfg_bool 'rewrite-map-enable', 'true', $rewrite_enable) {
if (!defined $mapref) {
- my $lrf = $do_fetch->("rewrite map", $rewritemap) or return;
+ my $lrf = $do_fetch->((__ "rewrite map"), $rewritemap) or return;
$mapref = $lrf.'/'.$rewritemap;
}
my $rewritemapdata = git_cat_file $mapref.':map';
if (defined $rewritemapdata
&& $rewritemapdata =~ m/^$dsc_hash(?:[ \t](\w+))/m) {
- progress
+ progress __
"server's git history rewrite map contains a relevant entry!";
$dsc_hash = $1;
if (defined $dsc_hash) {
- progress "using rewritten git hash in place of .dsc value";
+ progress __ "using rewritten git hash in place of .dsc value";
} else {
- progress "server data says .dsc hash is to be disregarded";
+ progress __ "server data says .dsc hash is to be disregarded";
}
}
}
if (!defined git_cat_file $dsc_hash) {
my @tags = map { "tags/".$_ } @$dsc_hint_tag;
- my $lrf = $do_fetch->("additional commits", @tags) &&
+ my $lrf = $do_fetch->((__ "additional commits"), @tags) &&
defined git_cat_file $dsc_hash
- or fail <<END;
-.dsc Dgit metadata requires commit $dsc_hash
+ or fail f_ <<END, $dsc_hash;
+.dsc Dgit metadata requires commit %s
but we could not obtain that object anywhere.
END
foreach my $t (@tags) {
get_archive_dsc();
if ($dsc) {
- parse_dsc_field($dsc, 'last upload to archive');
+ parse_dsc_field($dsc, __ 'last upload to archive');
resolve_dsc_field_commit access_basedistro,
lrfetchrefs."/".$rewritemap
} else {
- progress "no version available from the archive";
+ progress __ "no version available from the archive";
}
# If the archive's .dsc has a Dgit field, there are three
printdebug "previous reference hash=$lastpush_hash\n";
$lastpush_mergeinput = $lastpush_hash && {
Commit => $lastpush_hash,
- Info => "dgit suite branch on dgit git server",
+ Info => (__ "dgit suite branch on dgit git server"),
};
my $lastfetch_hash = git_get_ref(lrref());
printdebug "fetch_from_archive: lastfetch=$lastfetch_hash\n";
my $lastfetch_mergeinput = $lastfetch_hash && {
Commit => $lastfetch_hash,
- Info => "dgit client's archive history view",
+ Info => (__ "dgit client's archive history view"),
};
my $dsc_mergeinput = $dsc_hash && {
Commit => $dsc_hash,
- Info => "Dgit field in .dsc from archive",
+ Info => (__ "Dgit field in .dsc from archive"),
};
my $cwd = getcwd();
# push. This can happen if the archive moves .dscs about.
# Just follow its lead.
if (is_fast_fwd($lastpush_hash,$dsc_hash)) {
- progress "archive .dsc names newer git commit";
+ progress __ "archive .dsc names newer git commit";
@mergeinputs = ($dsc_mergeinput);
} else {
- progress "archive .dsc names other git commit, fixing up";
+ progress __ "archive .dsc names other git commit, fixing up";
@mergeinputs = ($dsc_mergeinput, $lastpush_mergeinput);
}
}
} else {
printdebug "nothing found!\n";
if (defined $skew_warning_vsn) {
- print STDERR <<END or die $!;
+ print STDERR f_ <<END, $skew_warning_vsn or die $!;
Warning: relevant archive skew detected.
-Archive allegedly contains $skew_warning_vsn
+Archive allegedly contains %s
But we were not able to obtain any version from the archive or git.
END
if (defined $compat_info->{Message}) {
print MC $compat_info->{Message} or die $!;
} else {
- print MC <<END or die $!;
-Record $package ($cversion) in archive suite $csuite
+ print MC f_ <<END, $package, $cversion, $csuite or die $!;
+Record %s (%s) in archive suite %s
Record that
END
};
$message_add_info->($mergeinputs[0]);
- print MC <<END or die $!;
+ print MC __ <<END or die $!;
should be treated as descended from
END
$message_add_info->($_) foreach @mergeinputs[1..$#mergeinputs];
my $chkff = sub {
my ($lasth, $what) = @_;
return unless $lasth;
- die "$lasth $hash $what ?" unless is_fast_fwd($lasth, $hash);
+ confess "$lasth $hash $what ?" unless is_fast_fwd($lasth, $hash);
};
- $chkff->($lastpush_hash, 'dgit repo server tip (last push)')
+ $chkff->($lastpush_hash, __ 'dgit repo server tip (last push)')
if $lastpush_hash;
- $chkff->($lastfetch_hash, 'local tracking tip (last fetch)');
+ $chkff->($lastfetch_hash, __ 'local tracking tip (last fetch)');
fetch_from_archive_record_1($hash);
my $got_vsn = getfield $gotclogp, 'Version';
printdebug "SKEW CHECK GOT $got_vsn\n";
if (version_compare($got_vsn, $skew_warning_vsn) < 0) {
- print STDERR <<END or die $!;
+ print STDERR f_ <<END, $skew_warning_vsn, $got_vsn or die $!;
Warning: archive skew detected. Using the available version:
-Archive allegedly contains $skew_warning_vsn
-We were able to obtain only $got_vsn
+Archive allegedly contains %s
+We were able to obtain only %s
END
}
lrfetchref_used lrfetchref();
- check_gitattrs($hash, "fetched source tree");
+ check_gitattrs($hash, __ "fetched source tree");
unshift @end, $del_lrfetchrefs;
return $hash;
print NATTRS "debian/changelog merge=$driver\n" or die $!;
close NATTRS;
- set_local_git_config "$cb.name", 'debian/changelog merge driver';
+ set_local_git_config "$cb.name", __ 'debian/changelog merge driver';
set_local_git_config "$cb.driver", 'dpkg-mergechangelogs -m %O %A %B %A';
rename "$attrs.new", "$attrs" or die "$attrs: $!";
my $already = is_gitattrs_setup();
if ($already) {
- progress <<END;
+ progress __ <<END;
[attr]dgit-defuse-attrs already found, and proper, in .git/info/attributes
not doing further gitattributes setup
END
ensuredir "$maindir_gitcommon/info";
open GAO, "> $af.new" or die $!;
- print GAO <<END or die $! unless defined $already;
+ print GAO <<END, __ <<ENDT or die $! unless defined $already;
* dgit-defuse-attrs
$new
-# ^ see GITATTRIBUTES in dgit(7) and dgit setup-new-tree in dgit(1)
END
+# ^ see GITATTRIBUTES in dgit(7) and dgit setup-new-tree in dgit(1)
+ENDT
my $gai = open_main_gitattrs();
if ($gai) {
while (<$gai>) {
$gai->error and die $!;
}
close GAO or die $!;
- rename "$af.new", "$af" or die "install $af: $!";
+ rename "$af.new", "$af" or fail f_ "install %s: %s", $af, $!;
}
sub setup_new_tree () {
next unless m{(?:^|/)\.gitattributes$};
# oh dear, found one
- print STDERR <<END;
-dgit: warning: $what contains .gitattributes
+ print STDERR f_ <<END, $what;
+dgit: warning: %s contains .gitattributes
dgit: .gitattributes not (fully) defused. Recommended: dgit setup-new-tree.
END
close $gafl;
$isuite = $tsuite;
$us .= " [$isuite]";
$debugprefix .= " ";
- progress "fetching $tsuite...";
+ progress f_ "fetching %s...", $tsuite;
canonicalise_suite();
print $canonsuitefh $csuite, "\n" or die $!;
close $canonsuitefh or die $!;
return undef;
}
waitpid $pid,0 == $pid or die $!;
- fail "failed to obtain $tsuite: ".waitstatusmsg() if $? && $?!=256*4;
+ fail f_ "failed to obtain %s: %s", $tsuite, waitstatusmsg()
+ if $? && $?!=256*4;
seek $canonsuitefh,0,0 or die $!;
local $csuite = <$canonsuitefh>;
die $! unless defined $csuite && chomp $csuite;
sub { });
return 0 unless defined $cbasesuite;
- fail "package $package missing in (base suite) $cbasesuite"
+ fail f_ "package %s missing in (base suite) %s", $package, $cbasesuite
unless @mergeinputs;
my @csuites = ($cbasesuite);
if ($previous) {
unshift @mergeinputs, {
Commit => $previous,
- Info => "local combined tracking branch",
- Warning =>
- "archive seems to have rewound: local tracking branch is ahead!",
+ Info => (__ "local combined tracking branch"),
+ Warning => (__
+ "archive seems to have rewound: local tracking branch is ahead!"),
};
}
my $tree = cmdoutput qw(git rev-parse), $needed[0]{Commit}.':';
my $commit = "tree $tree\n";
- my $msg = "Combine archive branches $csuite [dgit]\n\n".
- "Input branches:\n";
+ my $msg = f_ "Combine archive branches %s [dgit]\n\n".
+ "Input branches:\n",
+ $csuite;
foreach my $mi (sort { $a->{Index} <=> $b->{Index} } @mergeinputs) {
printdebug "multisuite merge include $mi->{Info}\n";
$mi->{Info};
}
my $authline = clogp_authline mergeinfo_getclogp $needed[0];
- $msg .= "\nKey\n".
+ $msg .= __ "\nKey\n".
" * marks the highest version branch, which choose to use\n".
- " + marks each branch which was not already an ancestor\n\n".
+ " + marks each branch which was not already an ancestor\n\n";
+ $msg .=
"[dgit multi-suite $csuite]\n";
$commit .=
"author $authline\n".
fetch_from_archive_record_1($output);
fetch_from_archive_record_2($output);
- progress "calculated combined tracking suite $csuite";
+ progress f_ "calculated combined tracking suite %s", $csuite;
return 1;
}
git ls-tree -r --name-only -z HEAD | \
xargs -0r touch -h -r . --
END
- printdone "ready for work in $dstdir";
+ printdone f_ "ready for work in %s", $dstdir;
}
sub clone ($) {
# once in parent after first suite fetched,
# and then again in child after everything is finished
my ($dstdir) = @_;
- badusage "dry run makes no sense with clone" unless act_local();
+ badusage __ "dry run makes no sense with clone" unless act_local();
my $multi_fetched = fork_for_multisuite(sub {
printdebug "multi clone before fetch merge\n";
canonicalise_suite();
my $hasgit = check_for_git();
- mkdir $dstdir or fail "create \`$dstdir': $!";
+ mkdir $dstdir or fail f_ "create \`%s': %s", $dstdir, $!;
changedir $dstdir;
runcmd @git, qw(init -q);
record_maindir();
runcmd @git, qw(remote add), 'origin', $giturl;
}
if ($hasgit) {
- progress "fetching existing git history";
+ progress __ "fetching existing git history";
git_fetch_us();
runcmd_ordryrun_local @git, qw(fetch origin);
} else {
- progress "starting new git history";
+ progress __ "starting new git history";
}
fetch_from_archive() or no_such_package;
my $vcsgiturl = $dsc->{'Vcs-Git'};
cfg 'dgit.vcs-git.suites')) {
my $current = cfg 'remote.vcs-git.url', 'RETURN-UNDEF';
if (defined $current && $current ne $vcsgiturl) {
- print STDERR <<END;
-FYI: Vcs-Git in $csuite has different url to your vcs-git remote.
+ print STDERR f_ <<END, $csuite;
+FYI: Vcs-Git in %s has different url to your vcs-git remote.
Your vcs-git remote url may be out of date. Use dgit update-vcs-git ?
END
}
}
- printdone "fetched into ".lrref();
+ printdone f_ "fetched into %s", lrref();
}
sub dofetch () {
sub pull () {
dofetch();
- runcmd_ordryrun_local @git, qw(merge -m),"Merge from $csuite [dgit]",
+ runcmd_ordryrun_local @git, qw(merge -m),
+ (f_ "Merge from %s [dgit]", $csuite),
lrref();
- printdone "fetched to ".lrref()." and merged into HEAD";
+ printdone f_ "fetched to %s and merged into HEAD", lrref();
}
sub check_not_dirty () {
foreach my $f (qw(local-options local-patch-header)) {
if (stat_exists "debian/source/$f") {
- fail "git tree contains debian/source/$f";
+ fail f_ "git tree contains debian/source/%s", $f;
}
}
sub quiltify_nofix_bail ($$) {
my ($headinfo, $xinfo) = @_;
if ($quilt_mode eq 'nofix') {
- fail "quilt fixup required but quilt mode is \`nofix'\n".
- "HEAD commit".$headinfo." differs from tree implied by ".
- " debian/patches".$xinfo;
+ fail f_
+ "quilt fixup required but quilt mode is \`nofix'\n".
+ "HEAD commit%s differs from tree implied by debian/patches%s",
+ $headinfo, $xinfo;
}
}
}
delete $adds{'.pc'}; # if there wasn't one before, don't add it
if (!%adds) {
- progress "nothing quilty to commit, ok.";
+ progress __ "nothing quilty to commit, ok.";
return;
}
- quiltify_nofix_bail "", " (wanted to commit patch update)";
+ quiltify_nofix_bail "", __ " (wanted to commit patch update)";
my @adds = map { s/[][*?\\]/\\$&/g; $_; } sort keys %adds;
runcmd_ordryrun_local @git, qw(add -f), @adds;
- commit_admin <<END
+ commit_admin +(__ <<ENDT).<<END
Commit Debian 3.0 (quilt) metadata
+ENDT
[dgit ($our_version) quilt-fixup]
END
}
return 0 unless $format eq '3.0 (quilt)';
our $quilt_mode_warned;
if ($quilt_mode eq 'nocheck') {
- progress "Not doing any fixup of \`$format' due to".
- " ----no-quilt-fixup or --quilt=nocheck"
+ progress f_ "Not doing any fixup of \`%s'".
+ " due to ----no-quilt-fixup or --quilt=nocheck", $format
unless $quilt_mode_warned++;
return 0;
}
- progress "Format \`$format', need to check/update patch stack"
+ progress f_ "Format \`%s', need to check/update patch stack", $format
unless $quilt_mode_warned++;
return 1;
}
sub maybe_split_brain_save ($$$) {
my ($headref, $dgitview, $msg) = @_;
# => message fragment "$saved" describing disposition of $dgitview
+ # (used inside parens, in the English texts)
my $save = $internal_object_save{'dgit-view'};
- return "commit id $dgitview" unless defined $save;
+ return f_ "commit id %s", $dgitview unless defined $save;
my @cmd = (shell_cmd 'cd "$1"; shift', $maindir,
git_update_ref_cmd
"dgit --dgit-view-save $msg HEAD=$headref",
$save, $dgitview);
runcmd @cmd;
- return "and left in $save";
+ return f_ "and left in %s", $save;
}
# An "infopair" is a tuple [ $thing, $what ]
printdebug "infopair_lrfetchref_tag_lookup $tagobj $tagname $what\n";
return [ git_rev_parse($tagobj), $what ];
}
- fail @tagnames==1 ? <<END : <<END;
-Wanted tag $what (@tagnames) on dgit server, but not found
+ fail @tagnames==1 ? (f_ <<END, $what, "@tagnames")
+Wanted tag %s (%s) on dgit server, but not found
END
-Wanted tag $what (one of: @tagnames) on dgit server, but not found
+ : (f_ <<END, $what, "@tagnames");
+Wanted tag %s (one of: %s) on dgit server, but not found
END
}
sub infopair_cond_ff ($$) {
my ($anc,$desc) = @_;
- is_fast_fwd($anc->[0], $desc->[0]) or fail <<END;
-$anc->[1] ($anc->[0]) .. $desc->[1] ($desc->[0]) is not fast forward
+ is_fast_fwd($anc->[0], $desc->[0]) or
+ fail f_ <<END, $anc->[1], $anc->[0], $desc->[1], $desc->[0];
+%s (%s) .. %s (%s) is not fast forward
END
};
my $arch_clogp = commit_getclogp $archive_hash;
my $i_arch_v = [ (getfield $arch_clogp, 'Version'),
- 'version currently in archive' ];
+ __ 'version currently in archive' ];
if (defined $overwrite_version) {
if (length $overwrite_version) {
infopair_cond_equal([ $overwrite_version,
$i_arch_v);
} else {
my $v = $i_arch_v->[0];
- progress "Checking package changelog for archive version $v ...";
+ progress f_
+ "Checking package changelog for archive version %s ...", $v;
my $cd;
eval {
my @xa = ("-f$v", "-t$v");
my $gf = sub {
my ($fn) = @_;
[ (getfield $vclogp, $fn),
- "$fn field from dpkg-parsechangelog @xa" ];
+ (f_ "%s field from dpkg-parsechangelog %s",
+ $fn, "@xa") ];
};
my $cv = $gf->('Version');
infopair_cond_equal($i_arch_v, $cv);
if ($@) {
$@ =~ s/^dgit: //gm;
fail "$@".
- "Perhaps debian/changelog does not mention $v ?";
+ f_ "Perhaps debian/changelog does not mention %s ?", $v;
}
- fail <<END if $cd->[0] =~ m/UNRELEASED/;
-$cd->[1] is $cd->[0]
-Your tree seems to based on earlier (not uploaded) $v.
+ fail f_ <<END, $cd->[1], $cd->[0], $v
+%s is %s
+Your tree seems to based on earlier (not uploaded) %s.
END
+ if $cd->[0] =~ m/UNRELEASED/;
}
}
sub pseudomerge_make_commit ($$$$ $$) {
my ($clogp, $dgitview, $archive_hash, $i_arch_v,
$msg_cmd, $msg_msg) = @_;
- progress "Declaring that HEAD inciudes all changes in $i_arch_v->[0]...";
+ progress f_ "Declaring that HEAD inciudes all changes in %s...",
+ $i_arch_v->[0];
my $tree = cmdoutput qw(git rev-parse), "${dgitview}:";
my $authline = clogp_authline $clogp;
my $i_arch_v = pseudomerge_version_check($clogp, $archive_hash);
if (!defined $overwrite_version) {
- progress "Checking that HEAD inciudes all changes in archive...";
+ progress __ "Checking that HEAD inciudes all changes in archive...";
}
return $dgitview if is_fast_fwd $archive_hash, $dgitview;
if (defined $overwrite_version) {
} elsif (!eval {
my $t_dep14 = debiantag_maintview $i_arch_v->[0], access_nomdistro;
- my $i_dep14 = infopair_lrf_tag_lookup($t_dep14, "maintainer view tag");
+ my $i_dep14 = infopair_lrf_tag_lookup($t_dep14,
+ __ "maintainer view tag");
my $t_dgit = debiantag_new $i_arch_v->[0], access_nomdistro;
- my $i_dgit = infopair_lrf_tag_lookup($t_dgit, "dgit view tag");
- my $i_archive = [ $archive_hash, "current archive contents" ];
+ my $i_dgit = infopair_lrf_tag_lookup($t_dgit, __ "dgit view tag");
+ my $i_archive = [ $archive_hash, __ "current archive contents" ];
printdebug "splitbrain_pseudomerge i_archive @$i_archive\n";
1;
}) {
$@ =~ s/^\n//; chomp $@;
- print STDERR <<END;
+ print STDERR <<END.(__ <<ENDT);
$@
-| Not fast forward; maybe --overwrite is needed ? Please see dgit(1).
END
+| Not fast forward; maybe --overwrite is needed ? Please see dgit(1).
+ENDT
finish -1;
}
+ my $arch_v = $i_arch_v->[0];
my $r = pseudomerge_make_commit
$clogp, $dgitview, $archive_hash, $i_arch_v,
"dgit --quilt=$quilt_mode",
- (defined $overwrite_version ? <<END_OVERWR : <<END_MAKEFF);
-Declare fast forward from $i_arch_v->[0]
-END_OVERWR
-Make fast forward from $i_arch_v->[0]
-END_MAKEFF
+ (defined $overwrite_version
+ ? f_ "Declare fast forward from %s\n", $arch_v
+ : f_ "Make fast forward from %s\n", $arch_v);
maybe_split_brain_save $maintview, $r, "pseudomerge";
- progress "Made pseudo-merge of $i_arch_v->[0] into dgit view.";
+ progress f_ "Made pseudo-merge of %s into dgit view.", $arch_v;
return $r;
}
return $head if is_fast_fwd $archive_hash, $head;
- my $m = "Declare fast forward from $i_arch_v->[0]";
+ my $m = f_ "Declare fast forward from %s", $i_arch_v->[0];
my $r = pseudomerge_make_commit
$clogp, $head, $archive_hash, $i_arch_v,
runcmd git_update_ref_cmd $m, 'HEAD', $r, $head;
- progress "Make pseudo-merge of $i_arch_v->[0] into your HEAD.";
+ progress f_ "Make pseudo-merge of %s into your HEAD.", $i_arch_v->[0];
return $r;
}
my $clogpackage = getfield $clogp, 'Source';
$package //= $clogpackage;
- fail "-p specified $package but changelog specified $clogpackage"
+ fail f_ "-p specified %s but changelog specified %s",
+ $package, $clogpackage
unless $package eq $clogpackage;
my $cversion = getfield $clogp, 'Version';
my $dversion = getfield $dsc, 'Version';
my $dscpackage = getfield $dsc, 'Source';
($dscpackage eq $package && $dversion eq $cversion) or
- fail "$dscfn is for $dscpackage $dversion".
- " but debian/changelog is for $package $cversion";
+ fail f_ "%s is for %s %s but debian/changelog is for %s %s",
+ $dscfn, $dscpackage, $dversion,
+ $package, $cversion;
}
sub push_tagwants ($$$$) {
my $changes = parsecontrol($changesfile,$changesfilewhat);
foreach my $field (qw(Source Distribution Version)) {
$changes->{$field} eq $clogp->{$field} or
- fail "changes field $field \`$changes->{$field}'".
- " does not match changelog \`$clogp->{$field}'";
+ fail f_ "changes field %s \`%s' does not match changelog \`%s'",
+ $field, $changes->{$field}, $clogp->{$field};
}
my $cversion = getfield $clogp, 'Version';
END
if ($tw->{View} eq 'dgit') {
+ print TO f_ <<ENDT, $package, $cversion, $clogsuite, $csuite
+%s release %s for %s (%s) [dgit]
+ENDT
+ or die $!;
print TO <<END or die $!;
-$package release $cversion for $clogsuite ($csuite) [dgit]
[dgit distro=$declaredistro$delibs]
END
foreach my $ref (sort keys %previously) {
END
}
} elsif ($tw->{View} eq 'maint') {
- print TO <<END or die $!;
-$package release $cversion for $clogsuite ($csuite)
-(maintainer view tag generated by dgit --quilt=$quilt_mode)
+ print TO f_ <<END, $package, $cversion, $clogsuite, $csuite,
+%s release %s for %s (%s)
+(maintainer view tag generated by dgit --quilt=%s)
END
+ $quilt_mode
+ or die $!;
} else {
- die Dumper($tw)."?";
+ confess Dumper($tw)."?";
}
close TO or die $!;
sub dopush () {
printdebug "actually entering push\n";
- supplementary_message(<<'END');
+ supplementary_message(__ <<'END');
Push failed, while checking state of the archive.
You can retry the push, after fixing the problem, if you like.
END
my $archive_hash = fetch_from_archive();
if (!$archive_hash) {
$new_package or
- fail "package appears to be new in this suite;".
- " if this is intentional, use --new";
+ fail __ "package appears to be new in this suite;".
+ " if this is intentional, use --new";
}
- supplementary_message(<<'END');
+ supplementary_message(__ <<'END');
Push failed, while preparing your push.
You can retry the push, after fixing the problem, if you like.
END
my $dscpath = "$buildproductsdir/$dscfn";
stat_exists $dscpath or
- fail "looked for .dsc $dscpath, but $!;".
- " maybe you forgot to build";
+ fail f_ "looked for .dsc %s, but %s; maybe you forgot to build",
+ $dscpath, $!;
responder_send_file('dsc', $dscpath);
if (branch_is_gdr_unstitched_ff($symref, $actualhead, $archive_hash)) {
if (quiltmode_splitbrain()) {
my ($ffq_prev, $gdrlast) = branch_gdr_info($symref, $actualhead);
- fail <<END;
-Branch is managed by git-debrebase ($ffq_prev
-exists), but quilt mode ($quilt_mode) implies a split view.
+ fail f_ <<END, $ffq_prev, $quilt_mode;
+Branch is managed by git-debrebase (%s
+exists), but quilt mode (%s) implies a split view.
Pass the right --quilt option or adjust your git config.
Or, maybe, run git-debrebase forget-was-ever-debrebase.
END
my $cachekey;
($dgithead, $cachekey) =
quilt_check_splitbrain_cache($actualhead, $upstreamversion);
- $dgithead or fail
- "--quilt=$quilt_mode but no cached dgit view:
- perhaps HEAD changed since dgit build[-source] ?";
+ $dgithead or fail f_
+ "--quilt=%s but no cached dgit view:
+ perhaps HEAD changed since dgit build[-source] ?",
+ $quilt_mode;
$split_brain = 1;
$dgithead = splitbrain_pseudomerge($clogp,
$actualhead, $dgithead,
} elsif (deliberately_not_fast_forward) {
$forceflag = '+';
} else {
- fail "dgit push: HEAD is not a descendant".
+ fail __ "dgit push: HEAD is not a descendant".
" of the archive's version.\n".
"To overwrite the archive's contents,".
" pass --overwrite[=VERSION].\n".
}
changedir $playground;
- progress "checking that $dscfn corresponds to HEAD";
+ progress f_ "checking that %s corresponds to HEAD", $dscfn;
runcmd qw(dpkg-source -x --),
$dscpath =~ m#^/# ? $dscpath : "$maindir/$dscpath";
my ($tree,$dir) = mktree_in_ud_from_only_subdir("source package");
}
}
if (@mode_changes) {
- fail <<END.(join '', @mode_changes).<<END;
-HEAD specifies a different tree to $dscfn:
+ fail +(f_ <<ENDT, $dscfn).<<END
+HEAD specifies a different tree to %s:
+ENDT
$diffs
END
+ .(join '', @mode_changes)
+ .(f_ <<ENDT, $tree, $referent);
There is a problem with your source tree (see dgit(7) for some hints).
-To see a full diff, run git diff $tree $referent
-END
+To see a full diff, run git diff %s %s
+ENDT
}
- fail <<END;
-HEAD specifies a different tree to $dscfn:
+ fail +(f_ <<ENDT, $dscfn).<<END.(f_ <<ENDT, $tree, $referent);
+HEAD specifies a different tree to %s:
+ENDT
$diffs
+END
Perhaps you forgot to build. Or perhaps there is a problem with your
source tree (see dgit(7) for some hints). To see a full diff, run
- git diff $tree $referent
-END
+ git diff %s %s
+ENDT
} else {
failedcmd @diffcmd;
}
if (!$changesfile) {
my $pat = changespat $cversion;
my @cs = glob "$buildproductsdir/$pat";
- fail "failed to find unique changes file".
- " (looked for $pat in $buildproductsdir);".
- " perhaps you need to use dgit -C"
+ fail f_ "failed to find unique changes file".
+ " (looked for %s in %s);".
+ " perhaps you need to use dgit -C",
+ $pat, $buildproductsdir
unless @cs==1;
($changesfile) = @cs;
} else {
if ($sourceonlypolicy eq 'ok') {
} elsif ($sourceonlypolicy eq 'always') {
forceable_fail [qw(uploading-binaries)],
- "uploading binaries, although distroy policy is source only"
+ __ "uploading binaries, although distroy policy is source only"
if $hasdebs;
} elsif ($sourceonlypolicy eq 'never') {
forceable_fail [qw(uploading-source-only)],
- "source-only upload, although distroy policy requires .debs"
+ __ "source-only upload, although distroy policy requires .debs"
if !$hasdebs;
} elsif ($sourceonlypolicy eq 'not-wholly-new') {
forceable_fail [qw(uploading-source-only)],
- "source-only upload, even though package is entirely NEW\n".
- "(this is contrary to policy in ".(access_nomdistro()).")"
+ f_ "source-only upload, even though package is entirely NEW\n".
+ "(this is contrary to policy in %s)",
+ access_nomdistro()
if !$hasdebs
&& $new_package
&& !(archive_query('package_not_wholly_new', $package) // 1);
} else {
- badcfg "unknown source-only-uploads policy \`$sourceonlypolicy'";
+ badcfg f_ "unknown source-only-uploads policy \`%s'",
+ $sourceonlypolicy;
}
# Perhaps adjust .dsc to contain right set of origs
dgit_privdir()."/tag");
my @tagobjfns;
- supplementary_message(<<'END');
+ supplementary_message(__ <<'END');
Push failed, while signing the tag.
You can retry the push, after fixing the problem, if you like.
END
$changesfile,$changesfile,
\@tagwants);
}
- supplementary_message(<<'END');
+ supplementary_message(__ <<'END');
Push failed, *after* signing the tag.
If you want to try again, you should use a new version number.
END
@git, qw(update-ref), "refs/tags/$tag", $tag_obj_hash;
}
- supplementary_message(<<'END');
+ supplementary_message(__ <<'END');
Push failed, while updating the remote git repository - see messages above.
If you want to try again, you should use a new version number.
END
qw(-c push.followTags=false push), access_giturl(), @pushrefs;
runcmd_ordryrun git_update_ref_cmd 'dgit push', lrref(), $dgithead;
- supplementary_message(<<'END');
+ supplementary_message(__ <<'END');
Push failed, while obtaining signatures on the .changes and .dsc.
If it was just that the signature failed, you may try again by using
debsign by hand to sign the changes file (see the command dgit tried,
if (act_local()) {
rename "$dscpath.tmp",$dscpath or die "$dscfn $!";
} else {
- progress "[new .dsc left in $dscpath.tmp]";
+ progress f_ "[new .dsc left in %s.tmp]", $dscpath;
}
sign_changes $changesfile;
}
- supplementary_message(<<END);
+ supplementary_message(f_ <<END, $changesfile);
Push failed, while uploading package(s) to the archive server.
You can retry the upload of exactly these same files with dput of:
- $changesfile
+ %s
If that .changes file is broken, you will need to use a new version
number for your next attempt at the upload.
END
my $host = access_cfg('upload-host','RETURN-UNDEF');
my @hostarg = defined($host) ? ($host,) : ();
runcmd_ordryrun @dput, @hostarg, $changesfile;
- printdone "pushed and uploaded $cversion";
+ printdone f_ "pushed and uploaded %s", $cversion;
supplementary_message('');
responder_send_command("complete");
sub cmd_clone {
parseopts();
my $dstdir;
- badusage "-p is not allowed with clone; specify as argument instead"
+ badusage __ "-p is not allowed with clone; specify as argument instead"
if defined $package;
if (@ARGV==1) {
($package) = @ARGV;
} elsif (@ARGV==3) {
($package,$isuite,$dstdir) = @ARGV;
} else {
- badusage "incorrect arguments to dgit clone";
+ badusage __ "incorrect arguments to dgit clone";
}
notpushing();
$dstdir ||= "$package";
if (stat_exists $dstdir) {
- fail "$dstdir already exists";
+ fail f_ "%s already exists", $dstdir;
}
my $cwd_remove;
return unless defined $cwd_remove;
if (!chdir "$cwd_remove") {
return if $!==&ENOENT;
- die "chdir $cwd_remove: $!";
+ confess "chdir $cwd_remove: $!";
}
printdebug "clone rmonerror removing $dstdir\n";
if (stat $dstdir) {
- rmtree($dstdir) or die "remove $dstdir: $!\n";
+ rmtree($dstdir) or fail f_ "remove %s: %s\n", $dstdir, $!;
} elsif (grep { $! == $_ }
(ENOENT, ENOTDIR, EACCES, EPERM, ELOOP)) {
} else {
- print STDERR "check whether to remove $dstdir: $!\n";
+ print STDERR f_ "check whether to remove %s: %s\n",
+ $dstdir, $!;
}
};
}
} elsif (@ARGV==1) {
($isuite) = @ARGV;
} else {
- badusage "incorrect arguments to dgit fetch or dgit pull";
+ badusage __ "incorrect arguments to dgit fetch or dgit pull";
}
notpushing();
}
fetchpullargs();
if (quiltmode_splitbrain()) {
my ($format, $fopts) = get_source_format();
- madformat($format) and fail <<END
-dgit pull not yet supported in split view mode (--quilt=$quilt_mode)
+ madformat($format) and fail f_ <<END, $quilt_mode
+dgit pull not yet supported in split view mode (--quilt=%s)
END
}
pull();
sub cmd_checkout {
parseopts();
package_from_d_control();
- @ARGV==1 or badusage "dgit checkout needs a suite argument";
+ @ARGV==1 or badusage __ "dgit checkout needs a suite argument";
($isuite) = @ARGV;
notpushing();
my @cmd;
my $orgurl = cfg 'remote.vcs-git.url', 'RETURN-UNDEF';
if (!defined $orgurl) {
- print STDERR "setting up vcs-git: $url\n";
+ print STDERR f_ "setting up vcs-git: %s\n", $url;
@cmd = (@git, qw(remote add vcs-git), $url);
} elsif ($orgurl eq $url) {
- print STDERR "vcs git already configured: $url\n";
+ print STDERR f_ "vcs git already configured: %s\n", $url;
} else {
- print STDERR "changing vcs-git url to: $url\n";
+ print STDERR f_ "changing vcs-git url to: %s\n", $url;
@cmd = (@git, qw(remote set-url vcs-git), $url);
}
runcmd_ordryrun_local @cmd;
if ($dofetch) {
- print "fetching (@ARGV)\n";
+ print f_ "fetching (%s)\n", "@ARGV";
runcmd_ordryrun_local @git, qw(fetch vcs-git), @ARGV;
}
}
} elsif (@ARGV==1) {
($specsuite) = (@ARGV);
} else {
- badusage "incorrect arguments to dgit $subcommand";
+ badusage f_ "incorrect arguments to dgit %s", $subcommand;
}
if ($new_package) {
local ($package) = $existing_package; # this is a hack
if (defined $specsuite &&
$specsuite ne $isuite &&
$specsuite ne $csuite) {
- fail "dgit $subcommand: changelog specifies $isuite ($csuite)".
- " but command line specifies $specsuite";
+ fail f_ "dgit %s: changelog specifies %s (%s)".
+ " but command line specifies %s",
+ $subcommand, $isuite, $csuite, $specsuite;
}
}
$vsnwant =~ m{^(?:.*,)?$_(?:,.*)?$}
} @rpushprotovsn_support;
- fail "build host has dgit rpush protocol versions ".
- (join ",", @rpushprotovsn_support).
- " but invocation host has $vsnwant"
+ fail f_ "build host has dgit rpush protocol versions %s".
+ " but invocation host has %s",
+ (join ",", @rpushprotovsn_support), $vsnwant
unless defined $protovsn;
changedir $dir;
if (defined $initiator_tempdir) {
rmtree $initiator_tempdir;
- mkdir $initiator_tempdir, 0700 or die "$initiator_tempdir: $!";
+ mkdir $initiator_tempdir, 0700
+ or fail f_ "create %s: %s", $initiator_tempdir, $!;
$i_tmp = $initiator_tempdir;
} else {
$i_tmp = tempdir();
printdebug "waiting for build host child $pid...\n";
my $got = waitpid $pid, 0;
die $! unless $got == $pid;
- die "build host child failed $?" if $?;
+ fail f_ "build host child failed: %s", waitstatusmsg() if $?;
i_cleanup();
- printdebug "all done\n";
+ printdebug __ "all done\n";
finish 0;
}
my $localname = i_method "i_localname", $keyword;
my $localpath = "$i_tmp/$localname";
stat_exists $localpath and
- badproto \*RO, "file $keyword ($localpath) twice";
+ badproto \*RO, f_ "file %s (%s) twice", $keyword, $localpath;
protocol_receive_file \*RO, $localpath;
i_method "i_file", $keyword;
}
our %i_param;
sub i_resp_param ($) {
- $_[0] =~ m/^(\S+) (.*)$/ or badproto \*RO, "bad param spec";
+ $_[0] =~ m/^(\S+) (.*)$/ or badproto \*RO, __ "bad param spec";
$i_param{$1} = $2;
}
sub i_resp_previously ($) {
$_[0] =~ m#^(refs/tags/\S+)=(\w+)$#
- or badproto \*RO, "bad previously spec";
+ or badproto \*RO, __ "bad previously spec";
my $r = system qw(git check-ref-format), $1;
- die "bad previously ref spec ($r)" if $r;
+ confess "bad previously ref spec ($r)" if $r;
$previously{$1} = $2;
}
pushing();
rpush_handle_protovsn_bothends();
- fail "rpush negotiated protocol version $protovsn".
- " which does not support quilt mode $quilt_mode"
+ fail f_ "rpush negotiated protocol version %s".
+ " which does not support quilt mode %s",
+ $protovsn, $quilt_mode
if quiltmode_splitbrain;
my @localpaths = i_method "i_want", $keyword;
if (!forceing [qw(buildinfo-changes-mismatch)]) {
files_compare_inputs($bd, $ch);
(getfield $bd, $_) eq (getfield $ch, $_) or
- fail "buildinfo mismatch $_"
+ fail f_ "buildinfo mismatch in field %s", $_
foreach qw(Source Version);
!defined $bd->{$_} or
- fail "buildinfo contains $_"
+ fail f_ "buildinfo contains forbidden field %s", $_
foreach qw(Changes Changed-by Distribution);
}
push @i_buildinfos, $bi;
return
push_mktags $i_clogp, $i_dscfn,
- $i_changesfn, 'remote changes',
+ $i_changesfn, (__ 'remote changes file'),
\@tagwants;
}
mkpath '.git/dgit'; # we are in playtree
my $descfn = ".git/dgit/quilt-description.tmp";
- open O, '>', $descfn or die "$descfn: $!";
+ open O, '>', $descfn or confess "$descfn: $!";
$msg =~ s/\n+/\n\n/;
print O <<END or die $!;
From: $author
if ($unrepres) {
eval {
- die "not a plain file or symlink\n"
+ die __ "not a plain file or symlink\n"
unless $newmode =~ m/^(?:10|12)\d{4}$/ ||
$oldmode =~ m/^(?:10|12)\d{4}$/;
if ($oldmode =~ m/[^0]/ &&
$newmode =~ m/[^0]/) {
# both old and new files exist
- die "mode or type changed\n" if $oldmode ne $newmode;
- die "modified symlink\n" unless $newmode =~ m/^10/;
+ die __ "mode or type changed\n" if $oldmode ne $newmode;
+ die __ "modified symlink\n" unless $newmode =~ m/^10/;
} elsif ($oldmode =~ m/[^0]/) {
# deletion
- die "deletion of symlink\n"
+ die __ "deletion of symlink\n"
unless $oldmode =~ m/^10/;
} else {
# creation
- die "creation with non-default mode\n"
+ die __ "creation with non-default mode\n"
unless $newmode =~ m/^100644$/ or
$newmode =~ m/^120000$/;
}
sub quiltify_splitbrain_needed () {
if (!$split_brain) {
- progress "dgit view: changes are required...";
+ progress __ "dgit view: changes are required...";
runcmd @git, qw(checkout -q -b dgit-view);
$split_brain = 1;
}
my ($x,$y) = @_;
my $cmd = "git diff $x $y -- :/ ':!debian'";
$cmd .= " ':!/.gitignore' ':!*/.gitignore'" if $gitignore_special;
- return "\nFor full diff showing the problem(s), type:\n $cmd\n";
+ return f_ "\nFor full diff showing the problem(s), type:\n %s\n",
+ $cmd;
};
if ($quilt_mode =~ m/gbp|unapplied/ &&
($diffbits->{O2H} & 01)) {
- my $msg =
- "--quilt=$quilt_mode specified, implying patches-unapplied git tree\n".
- " but git tree differs from orig in upstream files.";
+ my $msg = f_
+ "--quilt=%s specified, implying patches-unapplied git tree\n".
+ " but git tree differs from orig in upstream files.",
+ $quilt_mode;
$msg .= $fulldiffhint->($unapplied, 'HEAD');
if (!stat_exists "debian/patches") {
- $msg .=
+ $msg .= __
"\n ... debian/patches is missing; perhaps this is a patch queue branch?";
}
fail $msg;
}
if ($quilt_mode =~ m/dpm/ &&
($diffbits->{H2A} & 01)) {
- fail <<END. $fulldiffhint->($oldtiptree,'HEAD');
---quilt=$quilt_mode specified, implying patches-applied git tree
+ fail +(f_ <<END, $quilt_mode). $fulldiffhint->($oldtiptree,'HEAD');
+--quilt=%s specified, implying patches-applied git tree
but git tree differs from result of applying debian/patches to upstream
END
}
if ($quilt_mode =~ m/gbp|unapplied/ &&
($diffbits->{O2A} & 01)) { # some patches
quiltify_splitbrain_needed();
- progress "dgit view: creating patches-applied version using gbp pq";
+ progress __ "dgit view: creating patches-applied version using gbp pq";
runcmd shell_cmd 'exec >/dev/null', gbp_pq, qw(import);
# gbp pq import creates a fresh branch; push back to dgit-view
runcmd @git, qw(update-ref refs/heads/dgit-view HEAD);
}
if ($quilt_mode =~ m/gbp|dpm/ &&
($diffbits->{O2A} & 02)) {
- fail <<END;
---quilt=$quilt_mode specified, implying that HEAD is for use with a
+ fail f_ <<END, $quilt_mode;
+--quilt=%s specified, implying that HEAD is for use with a
tool which does not create patches for changes to upstream
.gitignores: but, such patches exist in debian/patches.
END
if (($diffbits->{O2H} & 02) && # user has modified .gitignore
!($diffbits->{O2A} & 02)) { # patches do not change .gitignore
quiltify_splitbrain_needed();
- progress "dgit view: creating patch to represent .gitignore changes";
+ progress __
+ "dgit view: creating patch to represent .gitignore changes";
ensuredir "debian/patches";
my $gipatch = "debian/patches/auto-gitignore";
- open GIPATCH, ">>", "$gipatch" or die "$gipatch: $!";
- stat GIPATCH or die "$gipatch: $!";
- fail "$gipatch already exists; but want to create it".
- " to record .gitignore changes" if (stat _)[7];
- print GIPATCH <<END or die "$gipatch: $!";
+ open GIPATCH, ">>", "$gipatch" or confess "$gipatch: $!";
+ stat GIPATCH or confess "$gipatch: $!";
+ fail f_ "%s already exists; but want to create it".
+ " to record .gitignore changes",
+ $gipatch
+ if (stat _)[7];
+ 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
.gitignore file(s). This patch is autogenerated, to provide these
updates to users of the official Debian archive view of the package.
+END
[dgit ($our_version) update-gitignore]
---
-END
+ENDU
close GIPATCH or die "$gipatch: $!";
runcmd shell_cmd "exec >>$gipatch", @git, qw(diff),
$unapplied, $headref, "--", sort keys %$editedignores;
print SERIES "auto-gitignore\n" or die $!;
close SERIES or die $!;
runcmd @git, qw(add -f -- debian/patches/series), $gipatch;
- commit_admin <<END
+ commit_admin <<END.<<ENDU
Commit patch to update .gitignore
+END
[dgit ($our_version) update-gitignore-quilt-fixup]
-END
+ENDU
}
my $dgitview = git_rev_parse 'HEAD';
$x =~ s/(.*?[0-9a-z]{8})[0-9a-z]*$/$1/;
return $x;
};
- my $reportnot = sub {
- my ($notp) = @_;
- my $s = $abbrev->($notp);
- my $c = $notp->{Child};
- $s .= "..".$abbrev->($c) if $c;
- $s .= ": ".$notp->{Whynot};
- return $s;
- };
if ($quilt_mode eq 'linear') {
print STDERR "\n$us: error: quilt fixup cannot be linear. Stopped at:\n";
my $all_gdr = !!@nots;
foreach my $notp (@nots) {
- print STDERR "$us: ", $reportnot->($notp), "\n";
+ my $c = $notp->{Child};
+ my $cprange = $abbrev->($notp);
+ $cprange .= "..".$abbrev->($c) if $c;
+ print STDERR "$us: $cprange: $notp->{Whynot}\n";
$all_gdr &&= $notp->{Child} &&
(git_cat_file $notp->{Child}{Commit}, 'commit')
=~ m{^\[git-debrebase(?! split[: ]).*\]$}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" if length > 200;
+ die "too long\n" if length > 200;
};
return $_ unless $@;
print STDERR "quiltifying commit $cc:".
sub quilt_fixup_delete_pc () {
runcmd @git, qw(rm -rqf .pc);
- commit_admin <<END
+ commit_admin <<END.<<ENDU
Commit removal of .pc (quilt series tracking data)
+END
[dgit ($our_version) upgrade quilt-remove-pc]
-END
+ENDU
}
sub quilt_fixup_singlepatch ($$$) {
~ianmdlvl / dgit.git / blobdiff