Import: Docuemnt absurdity in changelog

[dgit.git] / dgit

diff --git a/dgit b/dgit
index ae07145cb1e58d818d4a232a72cdf8c5737bf705..f821299f4d06e129de1be4ba6093fac50c867789 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -41,6 +41,7 @@ use Carp;
 use Debian::Dgit;
 
 our $our_version = 'UNRELEASED'; ###substituted###
+our $absurdity = undef; ###substituted###
 
 our @rpushprotovsn_support = qw(4 3 2); # 4 is new tag format
 our $protovsn;
@@ -73,6 +74,8 @@ our $tagformat_want;
 our $tagformat;
 our $tagformatfn;
 
+our %forceopts = map { $_=>0 } qw(unrepresentable);
+
 our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
 
 our $suite_re = '[-+.0-9a-z]+';
@@ -144,6 +147,11 @@ our @ourdscfield = qw(Dgit Vcs-Dgit-Master);
 our $csuite;
 our $instead_distro;
 
+if (!defined $absurdity) {
+    $absurdity = $0;
+    $absurdity =~ s{/[^/]+$}{/absurd} or die;
+}
+
 sub debiantag ($$) {
     my ($v,$distro) = @_;
     return $tagformatfn->($v, $distro);
@@ -222,6 +230,12 @@ END {
 
 sub badcfg { print STDERR "$us: invalid configuration: @_\n"; exit 12; }
 
+sub forceable_fail ($$) {
+    my ($forceoptsl, $msg) = @_;
+    fail $msg unless grep { $forceopts{$_} } @$forceoptsl;
+    print STDERR "warning: overriding problem due to --force:\n". $msg;
+}
+
 sub no_such_package () {
     print STDERR "$us: package $package does not exist in suite $isuite\n";
     exit 4;
@@ -1940,25 +1954,48 @@ END
        local $ENV{GIT_AUTHOR_EMAIL} = $authline[1];
        local $ENV{GIT_AUTHOR_DATE} =  $authline[2];
 
-       eval {
-           runcmd shell_cmd 'exec >/dev/null 2>../../gbp-pq-output',
-               gbp_pq, qw(import);
-       };
-       if ($@) {
-           { local $@; eval { runcmd qw(cat ../../gbp-pq-output); }; }
-           die $@;
-       }
+       my $path = $ENV{PATH} or die;
 
-       my $gapplied = git_rev_parse('HEAD');
-       my $gappliedtree = cmdoutput @git, qw(rev-parse HEAD:);
-       $gappliedtree eq $dappliedtree or
-           fail <<END;
+       foreach my $use_absurd (qw(0 1)) {
+           local $ENV{PATH} = $path;
+           if ($use_absurd) {
+               chomp $@;
+               progress "warning: $@";
+               $path = "$absurdity:$path";
+               progress "$us: trying slow absurd-git-apply...";
+               rename "../../gbp-pq-output","../../gbp-pq-output.0"
+                   or die $!;
+           }
+           eval {
+               local $ENV{PATH} = $path if $use_absurd;
+
+               my @showcmd = (gbp_pq, qw(import));
+               my @realcmd = shell_cmd
+                   'exec >/dev/null 2>../../gbp-pq-output', @showcmd;
+               debugcmd "+",@realcmd;
+               if (system @realcmd) {
+                   die +(shellquote @showcmd).
+                       " failed: ".
+                       failedcmd_waitstatus()."\n";
+               }
+
+               my $gapplied = git_rev_parse('HEAD');
+               my $gappliedtree = cmdoutput @git, qw(rev-parse HEAD:);
+               $gappliedtree eq $dappliedtree or
+                   fail <<END;
 gbp-pq import and dpkg-source disagree!
  gbp-pq import gave commit $gapplied
  gbp-pq import gave tree $gappliedtree
  dpkg-source --before-build gave tree $dappliedtree
 END
-       $rawimport_hash = $gapplied;
+               $rawimport_hash = $gapplied;
+           };
+           last unless $@;
+       }
+       if ($@) {
+           { local $@; eval { runcmd qw(cat ../../gbp-pq-output); }; }
+           die $@;
+       }
     }
 
     progress "synthesised git commit from .dsc $cversion";
@@ -4605,7 +4642,7 @@ END
     if (@unrepres) {
        print STDERR "dgit:  cannot represent change: $_->[1]: $_->[0]\n"
            foreach @unrepres;
-       fail <<END;
+       forceable_fail [qw(unrepresentable)], <<END;
 HEAD has changes to .orig[s] which are not representable by `3.0 (quilt)'
 END
     }
@@ -5176,6 +5213,10 @@ sub parseopts () {
            } elsif (m/^--deliberately-($deliberately_re)$/s) {
                push @ropts, $_;
                push @deliberatelies, $&;
+           } elsif (m/^--force-(.*)/ && defined $forceopts{$1}) {
+               push @ropts, $&;
+               $forceopts{$1} = 1;
+               $_='';
            } elsif (m/^--dgit-tag-format=(old|new)$/s) {
                # undocumented, for testing
                push @ropts, $_;