END { $? = $Debian::Dgit::ExitStatus::desired // -1; };
use Debian::Dgit::ExitStatus;
+use Debian::Dgit::I18n;
use strict;
use Dpkg::Compression;
use Dpkg::Compression::Process;
use POSIX;
+use Locale::gettext;
use IPC::Open2;
use Digest::SHA;
use Digest::MD5;
our (@dput) = qw(dput);
our (@debsign) = qw(debsign);
our (@gpg) = qw(gpg);
-our (@sbuild) = qw(sbuild);
+our (@sbuild) = (qw(sbuild --no-source));
our (@ssh) = 'ssh';
our (@dgit) = qw(dgit);
our (@git_debrebase) = qw(git-debrebase);
}
};
-sub badcfg { print STDERR "$us: invalid configuration: @_\n"; finish 12; }
+sub badcfg {
+ print STDERR f_ "%s: invalid configuration: %s\n", $us, "@_";
+ finish 12;
+}
sub forceable_fail ($$) {
my ($forceoptsl, $msg) = @_;
fail $msg unless grep { $forceopts{$_} } @$forceoptsl;
- print STDERR "warning: overriding problem due to --force:\n". $msg;
+ print STDERR +(__ "warning: overriding problem due to --force:\n"). $msg;
}
sub forceing ($) {
my ($forceoptsl) = @_;
my @got = grep { $forceopts{$_} } @$forceoptsl;
return 0 unless @got;
- print STDERR
- "warning: skipping checks or functionality due to --force-$got[0]\n";
+ print STDERR f_
+ "warning: skipping checks or functionality due to --force-%s\n",
+ $got[0];
}
sub no_such_package () {
- print STDERR "$us: package $package does not exist in suite $isuite\n";
+ print STDERR f_ "%s: package %s does not exist in suite %s\n",
+ $us, $package, $isuite;
finish 4;
}
return ($ffq_prev, $gdrlast);
}
-sub branch_is_gdr ($$) {
- my ($symref, $head) = @_;
- my ($ffq_prev, $gdrlast) = branch_gdr_info($symref, $head);
- return 0 unless $ffq_prev || $gdrlast;
- return 1;
-}
-
sub branch_is_gdr_unstitched_ff ($$$) {
my ($symref, $head, $ancestor) = @_;
my ($ffq_prev, $gdrlast) = branch_gdr_info($symref, $head);
return 1;
}
+sub branch_is_gdr ($) {
+ my ($head) = @_;
+ # This is quite like git-debrebase's keycommits.
+ # We have our own implementation because:
+ # - our algorighm can do fewer tests so is faster
+ # - it saves testing to see if gdr is installed
+
+ # NB we use this jsut for deciding whether to run gdr make-patches
+ # Before reusing this algorithm for somthing else, its
+ # suitability should be reconsidered.
+
+ my $walk = $head;
+ local $Debian::Dgit::debugcmd_when_debuglevel = 3;
+ printdebug "branch_is_gdr $head...\n";
+ my $get_patches = sub {
+ my $t = git_cat_file "$_[0]:debian/patches", [qw(missing tree)];
+ return $t // '';
+ };
+ my $tip_patches = $get_patches->($head);
+ WALK:
+ for (;;) {
+ my $cdata = git_cat_file $walk, 'commit';
+ my ($hdrs,$msg) = $cdata =~ m{\n\n} ? ($`,$') : ($cdata,'');
+ if ($msg =~ m{^\[git-debrebase\ (
+ anchor | changelog | make-patches |
+ merged-breakwater | pseudomerge
+ ) [: ] }mx) {
+ # no need to analyse this - it's sufficient
+ # (gdr classifications: Anchor, MergedBreakwaters)
+ # (made by gdr: Pseudomerge, Changelog)
+ printdebug "branch_is_gdr $walk gdr $1 YES\n";
+ return 1;
+ }
+ my @parents = ($hdrs =~ m/^parent (\w+)$/gm);
+ if (@parents==2) {
+ my $walk_tree = get_tree_of_commit $walk;
+ foreach my $p (@parents) {
+ my $p_tree = get_tree_of_commit $p;
+ if ($p_tree eq $walk_tree) { # pseudomerge contriburor
+ # (gdr classification: Pseudomerge; not made by gdr)
+ printdebug "branch_is_gdr $walk unmarked pseudomerge\n"
+ if $debuglevel >= 2;
+ $walk = $p;
+ next WALK;
+ }
+ }
+ # some other non-gdr merge
+ # (gdr classification: VanillaMerge, DgitImportUnpatched, ?)
+ printdebug "branch_is_gdr $walk ?-2-merge NO\n";
+ return 0;
+ }
+ if (@parents>2) {
+ # (gdr classification: ?)
+ printdebug "branch_is_gdr $walk ?-octopus NO\n";
+ return 0;
+ }
+ if ($get_patches->($walk) ne $tip_patches) {
+ # Our parent added, removed, or edited patches, and wasn't
+ # a gdr make-patches commit. gdr make-patches probably
+ # won't do that well, then.
+ # (gdr classification of parent: AddPatches or ?)
+ printdebug "branch_is_gdr $walk ?-patches NO\n";
+ return 0;
+ }
+ if ($tip_patches eq '' and
+ !defined git_cat_file "$walk:debian") {
+ # (gdr classification of parent: BreakwaterStart
+ printdebug "branch_is_gdr $walk unmarked BreakwaterStart YES\n";
+ return 1;
+ }
+ # (gdr classification: Upstream Packaging Mixed Changelog)
+ printdebug "branch_is_gdr $walk plain\n"
+ if $debuglevel >= 2;
+ $walk = $parents[0];
+ }
+}
+
#---------- remote protocol support, common ----------
# remote push initiator/responder protocol:
die unless $got == $i_child_pid;
$i_child_pid = undef;
return undef unless $?;
- return "build host child ".waitstatusmsg();
+ return f_ "build host child %s", waitstatusmsg();
}
sub badproto ($$) {
my ($fh, $m) = @_;
- fail "connection lost: $!" if $fh->error;
- fail "protocol violation; $m not expected";
+ fail f_ "connection lost: %s", $! if $fh->error;
+ fail f_ "protocol violation; %s not expected", $m;
}
sub badproto_badread ($$) {
my ($fh, $wh) = @_;
- fail "connection lost: $!" if $!;
+ fail f_ "connection lost: %s", $! if $!;
my $report = i_child_report();
fail $report if defined $report;
- badproto $fh, "eof (reading $wh)";
+ badproto $fh, f_ "eof (reading %s)", $wh;
}
sub protocol_expect (&$) {
sub canonicalise_suite_madison {
# madison canonicalises for us
my @r = madison_get_parse(@_);
- @r or fail
- "unable to canonicalise suite using package $package".
- " which does not appear to exist in suite $isuite;".
- " --existing-package may help";
+ @r or fail f_
+ "unable to canonicalise suite using package %s".
+ " which does not appear to exist in suite %s;".
+ " --existing-package may help",
+ $package, $isuite;
return $r[0][2];
}
if ($quilt_mode eq 'linear'
&& !$fopts->{'single-debian-patch'}
- && branch_is_gdr($symref, $headref)) {
+ && branch_is_gdr($headref)) {
# This is much faster. It also makes patches that gdr
# likes better for future updates without laundering.
#
my $dmode = '-F';
foreach my $l ($cmd, $xargs) {
next unless $l;
- @$l = grep { !(m/^-[SgGFABb]$/s and $dmode=$_) } @$l;
+ @$l = grep { !(m/^-[SgGFABb]$|^--build=/s and $dmode=$_) } @$l;
}
push @$cmd, '-nc';
#print STDERR "MASS1 ",Dumper($cmd, $xargs, $dmode);
my $r = WANTSRC_BUILDER;
printdebug "massage split $dmode.\n";
- $r = $dmode =~ m/[S]/ ? WANTSRC_SOURCE :
- $dmode =~ y/gGF/ABb/ ? WANTSRC_SOURCE | WANTSRC_BUILDER :
- $dmode =~ m/[ABb]/ ? WANTSRC_BUILDER :
- die "$dmode ?";
+ if ($dmode =~ s/^--build=//) {
+ $r = 0;
+ my @d = split /,/, $dmode;
+ $r |= WANTSRC_SOURCE if grep { s/^full$/binary/ } @d;
+ $r |= WANTSRC_SOURCE if grep { s/^source$// } @d;
+ $r |= WANTSRC_BUILDER if grep { m/./ } @d;
+ fail "Wanted to build nothing!" unless $r;
+ $dmode = '--build='. join ',', grep m/./, @d;
+ } else {
+ $r =
+ $dmode =~ m/[S]/ ? WANTSRC_SOURCE :
+ $dmode =~ y/gGF/ABb/ ? WANTSRC_SOURCE | WANTSRC_BUILDER :
+ $dmode =~ m/[ABb]/ ? WANTSRC_BUILDER :
+ die "$dmode ?";
+ }
printdebug "massage done $r $dmode.\n";
push @$cmd, $dmode;
#print STDERR "MASS2 ",Dumper($cmd, $xargs, $r);
sub cmd_build {
build_prep_early();
$buildproductsdir eq '..' or print STDERR <<END;
-$us: warning: build-products-dir set, but not supported by dgit build
-$us: warning: things may go wrong or files may go to the wrong place
+$us: warning: build-products-dir set, but not supported by dpkg-buildpackage
+$us: warning: build-products-dir will be ignored; files will go to ..
END
+ $buildproductsdir = '..';
my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts_initial(), @ARGV);
my $wantsrc = massage_dbp_args \@dbp;
build_prep($wantsrc);
$$vr = $v;
}
- fail "dgit: --include-dirty is not supported in split view quilt mode"
+ fail __ "dgit: --include-dirty is not supported in split view quilt mode"
if $split_brain && $includedirty;
if (!defined $cleanmode) {
$bpd_glob =~ s#[][\\{}*?~]#\\$&#g;
}
+setlocale(LC_MESSAGES, "");
+textdomain("dgit");
+
if ($ENV{$fakeeditorenv}) {
git_slurp_config();
quilt_fixup_editor();
~ianmdlvl / dgit.git / blobdiff