dgit: rename $ignoredirty -> $includedirty

[dgit.git] / dgit

diff --git a/dgit b/dgit
index c813a11f4f5fa842278e4e96169e7f95dd597080..a5470d4d9b3bc94d44b03122b6c64607def0e146 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -63,9 +63,10 @@ our @ropts;
 our $sign = 1;
 our $dryrun_level = 0;
 our $changesfile;
 our $sign = 1;
 our $dryrun_level = 0;
 our $changesfile;

-our $buildproductsdir = '..';
+our $buildproductsdir;
+our $bpd_glob;

 our $new_package = 0;
 our $new_package = 0;

-our $ignoredirty = 0;
+our $includedirty = 0;

 our $rmonerror = 1;
 our @deliberatelies;
 our %previously;
 our $rmonerror = 1;
 our @deliberatelies;
 our %previously;


@@ -189,11 +190,6 @@ sub debiantag ($$) {
     return $tagformatfn->($v, $distro);
 }
 
     return $tagformatfn->($v, $distro);
 }
 

-sub debiantag_maintview ($$) { 
-    my ($v,$distro) = @_;
-    return "$distro/".dep14_version_mangle $v;
-}
-

 sub madformat ($) { $_[0] eq '3.0 (quilt)' }
 
 sub lbranch () { return "$branchprefix/$csuite"; }
 sub madformat ($) { $_[0] eq '3.0 (quilt)' }
 
 sub lbranch () { return "$branchprefix/$csuite"; }


@@ -293,6 +289,11 @@ sub dgit_privdir () {
     our $dgit_privdir_made //= ensure_a_playground 'dgit';
 }
 
     our $dgit_privdir_made //= ensure_a_playground 'dgit';
 }
 

+sub bpd_abs () {
+    my $r = $buildproductsdir;
+    $r = "$maindir/$r" unless $r =~ m{^/};
+}
+

 sub branch_gdr_info ($$) {
     my ($symref, $head) = @_;
     my ($status, $msg, $current, $ffq_prev, $gdrlast) =
 sub branch_gdr_info ($$) {
     my ($symref, $head) = @_;
     my ($status, $msg, $current, $ffq_prev, $gdrlast) =


@@ -1242,7 +1243,14 @@ END
     }
     my @inreleasefiles = grep { m#/InRelease$# } @releasefiles;
     @releasefiles = @inreleasefiles if @inreleasefiles;
     }
     my @inreleasefiles = grep { m#/InRelease$# } @releasefiles;
     @releasefiles = @inreleasefiles if @inreleasefiles;

-    die "apt updated wrong number of Release files (@releasefiles), erk"
+    if (!@releasefiles) {
+       fail <<END;
+apt seemed to not to update dgit's cached Release files for $isuite.
+(Perhaps $cache
+ is on a filesystem mounted `noatime'; if so, please use `relatime'.)
+END
+    }
+    die "apt updated too many Release files (@releasefiles), erk"

        unless @releasefiles == 1;
 
     ($aptget_releasefile) = @releasefiles;
        unless @releasefiles == 1;
 
     ($aptget_releasefile) = @releasefiles;


@@ -2110,7 +2118,7 @@ sub generate_commits_from_dsc () {
     foreach my $fi (@dfi) {
        my $f = $fi->{Filename};
        die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#;
     foreach my $fi (@dfi) {
        my $f = $fi->{Filename};
        die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#;

-       my $upper_f = "$maindir/../$f";
+       my $upper_f = (bpd_abs()."/$f");

 
        printdebug "considering reusing $f: ";
 
 
        printdebug "considering reusing $f: ";
 


@@ -2118,12 +2126,12 @@ sub generate_commits_from_dsc () {
            printdebug "linked (using ...,fetch).\n";
        } elsif ((printdebug "($!) "),
                 $! != ENOENT) {
            printdebug "linked (using ...,fetch).\n";
        } elsif ((printdebug "($!) "),
                 $! != ENOENT) {

-           fail "accessing ../$f,fetch: $!";
+           fail "accessing $buildproductsdir/$f,fetch: $!";

        } elsif (link_ltarget $upper_f, $f) {
            printdebug "linked.\n";
        } elsif ((printdebug "($!) "),
                 $! != ENOENT) {
        } elsif (link_ltarget $upper_f, $f) {
            printdebug "linked.\n";
        } elsif ((printdebug "($!) "),
                 $! != ENOENT) {

-           fail "accessing ../$f: $!";
+           fail "accessing $buildproductsdir/$f: $!";

        } else {
            printdebug "absent.\n";
        }
        } else {
            printdebug "absent.\n";
        }


@@ -2138,14 +2146,14 @@ sub generate_commits_from_dsc () {
            printdebug "linked.\n";
        } elsif ((printdebug "($!) "),
                 $! != EEXIST) {
            printdebug "linked.\n";
        } elsif ((printdebug "($!) "),
                 $! != EEXIST) {

-           fail "saving ../$f: $!";
+           fail "saving $buildproductsdir/$f: $!";

        } elsif (!$refetched) {
            printdebug "no need.\n";
        } elsif (link $f, "$upper_f,fetch") {
            printdebug "linked (using ...,fetch).\n";
        } elsif ((printdebug "($!) "),
                 $! != EEXIST) {
        } elsif (!$refetched) {
            printdebug "no need.\n";
        } elsif (link $f, "$upper_f,fetch") {
            printdebug "linked (using ...,fetch).\n";
        } elsif ((printdebug "($!) "),
                 $! != EEXIST) {

-           fail "saving ../$f,fetch: $!";
+           fail "saving $buildproductsdir/$f,fetch: $!";

        } else {
            printdebug "cannot.\n";
        }
        } else {
            printdebug "cannot.\n";
        }


@@ -2289,22 +2297,14 @@ sub generate_commits_from_dsc () {
     }
 
     my @clogcmd = qw(dpkg-parsechangelog --format rfc822 --all);
     }
 
     my @clogcmd = qw(dpkg-parsechangelog --format rfc822 --all);

-    debugcmd "|",@clogcmd;
-    open CLOGS, "-|", @clogcmd or die $!;
-

     my $clogp;
     my $r1clogp;
 
     printdebug "import clog search...\n";
     my $clogp;
     my $r1clogp;
 
     printdebug "import clog search...\n";

+    parsechangelog_loop \@clogcmd, "package changelog", sub {
+       my ($thisstanza, $desc) = @_;
+       no warnings qw(exiting);

 
 

-    for (;;) {
-       my $stanzatext = do { local $/=""; <CLOGS>; };
-       printdebug "import clogp ".Dumper($stanzatext) if $debuglevel>1;
-       last if !defined $stanzatext;
-
-       my $desc = "package changelog, entry no.$.";
-       open my $stanzafh, "<", \$stanzatext or die;
-       my $thisstanza = parsecontrolfh $stanzafh, $desc, 1;

        $clogp //= $thisstanza;
 
        printdebug "import clog $thisstanza->{version} $desc...\n";
        $clogp //= $thisstanza;
 
        printdebug "import clog $thisstanza->{version} $desc...\n";


@@ -2339,9 +2339,7 @@ sub generate_commits_from_dsc () {
        $r1clogp = $thisstanza;
 
        printdebug "import clog $r1clogp->{version} becomes r1\n";
        $r1clogp = $thisstanza;
 
        printdebug "import clog $r1clogp->{version} becomes r1\n";

-    }
-    die $! if CLOGS->error;
-    close CLOGS or $?==SIGPIPE or failedcmd @clogcmd;
+    };

 
     $clogp or fail "package changelog has no entries!";
 
 
     $clogp or fail "package changelog has no entries!";
 


@@ -2582,7 +2580,7 @@ sub ensure_we_have_orig () {
     foreach my $fi (@dfi) {
        my $f = $fi->{Filename};
        next unless is_orig_file_in_dsc($f, \@dfi);
     foreach my $fi (@dfi) {
        my $f = $fi->{Filename};
        next unless is_orig_file_in_dsc($f, \@dfi);

-       complete_file_from_dsc('..', $fi)
+       complete_file_from_dsc($buildproductsdir, $fi)

            or next;
     }
 }
            or next;
     }
 }


@@ -3738,7 +3736,7 @@ sub check_not_dirty () {
        }
     }
 
        }
     }
 

-    return if $ignoredirty;
+    return if $includedirty;

 
     git_check_unmodified();
 }
 
     git_check_unmodified();
 }


@@ -4000,7 +3998,7 @@ sub splitbrain_pseudomerge ($$$$) {
         $@ =~ s/^\n//; chomp $@;
        print STDERR <<END;
 $@
         $@ =~ s/^\n//; chomp $@;
        print STDERR <<END;
 $@

-| Not fast forward; maybe --overwrite is needed, see dgit(1)
+| Not fast forward; maybe --overwrite is needed ?  Please see dgit(1).

 END
        finish -1;
     }
 END
        finish -1;
     }


@@ -5640,7 +5638,7 @@ END
         @git, qw(pull --ff-only -q), "$playground/work", qw(master);
 }
 
         @git, qw(pull --ff-only -q), "$playground/work", qw(master);
 }
 

-sub quilt_fixup_mkwork ($) {
+sub unpack_playtree_mkwork ($) {

     my ($headref) = @_;
 
     mkdir "work" or die $!;
     my ($headref) = @_;
 
     mkdir "work" or die $!;


@@ -5649,12 +5647,13 @@ sub quilt_fixup_mkwork ($) {
     runcmd @git, qw(reset -q --hard), $headref;
 }
 
     runcmd @git, qw(reset -q --hard), $headref;
 }
 

-sub quilt_fixup_linkorigs ($$) {
+sub unpack_playtree_linkorigs ($$) {

     my ($upstreamversion, $fn) = @_;
     # calls $fn->($leafname);
 
     my ($upstreamversion, $fn) = @_;
     # calls $fn->($leafname);
 

-    foreach my $f (<$maindir/../*>) { #/){
-       my $b=$f; $b =~ s{.*/}{};
+    opendir QFD, bpd_abs();
+    while ($!=0, defined(my $b = readdir QFD)) {
+       my $f = bpd_abs()."/".$b;

        {
            local ($debuglevel) = $debuglevel-1;
            printdebug "QF linkorigs $b, $f ?\n";
        {
            local ($debuglevel) = $debuglevel-1;
            printdebug "QF linkorigs $b, $f ?\n";


@@ -5664,6 +5663,8 @@ sub quilt_fixup_linkorigs ($$) {
        link_ltarget $f, $b or die "$b $!";
         $fn->($b);
     }
        link_ltarget $f, $b or die "$b $!";
         $fn->($b);
     }

+    die "$buildproductsdir: $!" if $!;
+    closedir QFD;

 }
 
 sub quilt_fixup_delete_pc () {
 }
 
 sub quilt_fixup_delete_pc () {


@@ -5685,8 +5686,8 @@ sub quilt_fixup_singlepatch ($$$) {
     # get it to generate debian/patches/debian-changes, it is
     # necessary to build the source package.
 
     # get it to generate debian/patches/debian-changes, it is
     # necessary to build the source package.
 

-    quilt_fixup_linkorigs($upstreamversion, sub { });
-    quilt_fixup_mkwork($headref);
+    unpack_playtree_linkorigs($upstreamversion, sub { });
+    unpack_playtree_mkwork($headref);

 
     rmtree("debian/patches");
 
 
     rmtree("debian/patches");
 


@@ -5726,7 +5727,7 @@ END
        print $fakedsc " ".$md->hexdigest." $size $b\n" or die $!;
     };
 
        print $fakedsc " ".$md->hexdigest." $size $b\n" or die $!;
     };
 

-    quilt_fixup_linkorigs($upstreamversion, $dscaddfile);
+    unpack_playtree_linkorigs($upstreamversion, $dscaddfile);

 
     my @files=qw(debian/source/format debian/rules
                  debian/control debian/changelog);
 
     my @files=qw(debian/source/format debian/rules
                  debian/control debian/changelog);


@@ -5794,7 +5795,7 @@ sub quilt_check_splitbrain_cache ($$) {
        next unless m/^(\w+) (\S.*\S)$/ && $2 eq $splitbrain_cachekey;
            
        my $cachehit = $1;
        next unless m/^(\w+) (\S.*\S)$/ && $2 eq $splitbrain_cachekey;
            
        my $cachehit = $1;

-       quilt_fixup_mkwork($headref);
+       unpack_playtree_mkwork($headref);

        my $saved = maybe_split_brain_save $headref, $cachehit, "cache-hit";
        if ($cachehit ne $headref) {
            progress "dgit view: found cached ($saved)";
        my $saved = maybe_split_brain_save $headref, $cachehit, "cache-hit";
        if ($cachehit ne $headref) {
            progress "dgit view: found cached ($saved)";


@@ -5925,13 +5926,13 @@ sub quilt_fixup_multipatch ($$$) {
 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
 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

- anomaly (depending on the quilt mode).  See --quilt= in dgit(1).
+ anomaly (depending on the quilt mode).  Please see --quilt= in dgit(1).

 END
     }
 
     changedir '..';
 
 END
     }
 
     changedir '..';
 

-    quilt_fixup_mkwork($headref);
+    unpack_playtree_mkwork($headref);

 
     my $mustdeletepc=0;
     if (stat_exists ".pc") {
 
     my $mustdeletepc=0;
     if (stat_exists ".pc") {


@@ -6230,15 +6231,16 @@ sub massage_dbp_args ($;$) {
     return $r;
 }
 
     return $r;
 }
 

-sub in_parent (&) {
+sub in_bpd (&) {

     my ($fn) = @_;
     my $wasdir = must_getcwd();
     my ($fn) = @_;
     my $wasdir = must_getcwd();

-    changedir "..";
+    changedir $buildproductsdir;

     $fn->();
     changedir $wasdir;
 }    
 
     $fn->();
     changedir $wasdir;
 }    
 

-sub postbuild_mergechanges ($) { # must run with CWD=.. (eg in in_parent)
+# this sub must run with CWD=$buildproductsdir (eg in in_bpd)
+sub postbuild_mergechanges ($) {

     my ($msg_if_onlyone) = @_;
     # If there is only one .changes file, fail with $msg_if_onlyone,
     # or if that is undef, be a no-op.
     my ($msg_if_onlyone) = @_;
     # If there is only one .changes file, fail with $msg_if_onlyone,
     # or if that is undef, be a no-op.


@@ -6280,7 +6282,7 @@ END
 sub midbuild_checkchanges () {
     my $pat = changespat $version;
     return if $rmchanges;
 sub midbuild_checkchanges () {
     my $pat = changespat $version;
     return if $rmchanges;

-    my @unwanted = map { s#^\.\./##; $_; } glob "../$pat";
+    my @unwanted = map { s#.*/##; $_; } glob "$bpd_glob/$pat";

     @unwanted = grep { $_ ne changespat $version,'source' } @unwanted;
     fail <<END
 changes files other than source matching $pat already present; building would result in ambiguity about the intended results.
     @unwanted = grep { $_ ne changespat $version,'source' } @unwanted;
     fail <<END
 changes files other than source matching $pat already present; building would result in ambiguity about the intended results.


@@ -6297,7 +6299,7 @@ sub midbuild_checkchanges_vanilla ($) {
 sub postbuild_mergechanges_vanilla ($) {
     my ($wantsrc) = @_;
     if ($wantsrc == 1) {
 sub postbuild_mergechanges_vanilla ($) {
     my ($wantsrc) = @_;
     if ($wantsrc == 1) {

-       in_parent {
+       in_bpd {

            postbuild_mergechanges(undef);
        };
     } else {
            postbuild_mergechanges(undef);
        };
     } else {


@@ -6339,7 +6341,7 @@ sub cmd_gbp_build {
     # orig is absent.
     my $upstreamversion = upstreamversion $version;
     my $origfnpat = srcfn $upstreamversion, '.orig.tar.*';
     # orig is absent.
     my $upstreamversion = upstreamversion $version;
     my $origfnpat = srcfn $upstreamversion, '.orig.tar.*';

-    my $gbp_make_orig = $version =~ m/-/ && !(() = glob "../$origfnpat");
+    my $gbp_make_orig = $version =~ m/-/ && !(() = glob "$bpd_glob/$origfnpat");

 
     if ($gbp_make_orig) {
        clean_tree();
 
     if ($gbp_make_orig) {
        clean_tree();


@@ -6411,7 +6413,7 @@ sub build_source {
     build_prep();
     $sourcechanges = changespat $version,'source';
     if (act_local()) {
     build_prep();
     $sourcechanges = changespat $version,'source';
     if (act_local()) {

-       unlink "../$sourcechanges" or $!==ENOENT
+       unlink "$buildproductsdir/$sourcechanges" or $!==ENOENT

            or fail "remove $sourcechanges: $!";
     }
     $dscfn = dscfn($version);
            or fail "remove $sourcechanges: $!";
     }
     $dscfn = dscfn($version);


@@ -6428,7 +6430,7 @@ sub build_source {
               ($f =~ m/\.debian\.tar(?:\.\w+)$/ &&
                $f eq srcfn($version, $&));
             printdebug "source copy, found $f - renaming\n";
               ($f =~ m/\.debian\.tar(?:\.\w+)$/ &&
                $f eq srcfn($version, $&));
             printdebug "source copy, found $f - renaming\n";

-            rename "$playground/$f", "../$f" or $!==ENOENT
+            rename "$playground/$f", "$buildproductsdir/$f" or $!==ENOENT

               or fail "put in place new source file ($f): $!";
         }
     } else {
               or fail "put in place new source file ($f): $!";
         }
     } else {


@@ -6440,7 +6442,7 @@ sub build_source {
     }
     runcmd_ordryrun_local qw(sh -ec),
       'exec >$1; shift; exec "$@"','x',
     }
     runcmd_ordryrun_local qw(sh -ec),
       'exec >$1; shift; exec "$@"','x',

-      "../$sourcechanges",
+      "$buildproductsdir/$sourcechanges",

       @dpkggenchanges, qw(-S), changesopts();
 }
 
       @dpkggenchanges, qw(-S), changesopts();
 }
 


@@ -6455,7 +6457,7 @@ sub cmd_build_source {
 sub cmd_sbuild {
     build_source();
     midbuild_checkchanges();
 sub cmd_sbuild {
     build_source();
     midbuild_checkchanges();

-    in_parent {
+    in_bpd {

        if (act_local()) {
            stat_exists $dscfn or fail "$dscfn (in parent directory): $!";
            stat_exists $sourcechanges
        if (act_local()) {
            stat_exists $dscfn or fail "$dscfn (in parent directory): $!";
            stat_exists $sourcechanges


@@ -6464,7 +6466,7 @@ sub cmd_sbuild {
        runcmd_ordryrun_local @sbuild, qw(-d), $isuite, @ARGV, $dscfn;
     };
     maybe_unapply_patches_again();
        runcmd_ordryrun_local @sbuild, qw(-d), $isuite, @ARGV, $dscfn;
     };
     maybe_unapply_patches_again();

-    in_parent {
+    in_bpd {

        postbuild_mergechanges(<<END);
 perhaps you need to pass -A ?  (sbuild's default is to build only
 arch-specific binaries; dgit 1.4 used to override that.)
        postbuild_mergechanges(<<END);
 perhaps you need to pass -A ?  (sbuild's default is to build only
 arch-specific binaries; dgit 1.4 used to override that.)


@@ -6600,7 +6602,7 @@ END
     my @dfi = dsc_files_info();
     foreach my $fi (@dfi) {
        my $f = $fi->{Filename};
     my @dfi = dsc_files_info();
     foreach my $fi (@dfi) {
        my $f = $fi->{Filename};

-       my $here = "../$f";
+       my $here = "$buildproductsdir/$f";

        if (lstat $here) {
            next if stat $here;
            fail "lstat $here works but stat gives $! !";
        if (lstat $here) {
            next if stat $here;
            fail "lstat $here works but stat gives $! !";


@@ -6863,7 +6865,7 @@ sub parseopts () {
                $quilt_mode = $1;
            } elsif (m/^--ignore-dirty$/s) {
                push @ropts, $_;
                $quilt_mode = $1;
            } elsif (m/^--ignore-dirty$/s) {
                push @ropts, $_;

-               $ignoredirty = 1;
+               $includedirty = 1;

            } elsif (m/^--no-quilt-fixup$/s) {
                push @ropts, $_;
                $quilt_mode = 'nocheck';
            } elsif (m/^--no-quilt-fixup$/s) {
                push @ropts, $_;
                $quilt_mode = 'nocheck';


@@ -7072,6 +7074,11 @@ sub parseopts_late_defaults () {
        badcfg "unknown clean-mode \`$cleanmode'" unless
            $cleanmode =~ m/^($cleanmode_re)$(?!\n)/s;
     }
        badcfg "unknown clean-mode \`$cleanmode'" unless
            $cleanmode =~ m/^($cleanmode_re)$(?!\n)/s;
     }

+
+    $buildproductsdir //= access_cfg('build-products-dir', 'RETURN-UNDEF');
+    $buildproductsdir //= '..';
+    $bpd_glob = $buildproductsdir;
+    $bpd_glob =~ s#[][\\{}*?~]#\\$&#g;

 }
 
 if ($ENV{$fakeeditorenv}) {
 }
 
 if ($ENV{$fakeeditorenv}) {