chiark / gitweb /
bugfixes from testing, for recent changes
[dgit.git] / dgit
diff --git a/dgit b/dgit
index fcc792d6cc432619e2fd93c83a412612a50e134a..93fb6fcd2a47beff177cab661b9a316ef2046958 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -42,14 +42,22 @@ our (@git) = qw(git);
 our (@dget) = qw(dget);
 our (@dput) = qw(dput);
 our (@debsign) = qw(debsign);
-our $keyid;
+our (@sbuild) = qw(sbuild -A);
+our (@dpkgbuildpackage) = qw(dpkg-buildpackage -i\.git/ -I.git);
+our (@mergechanges) = qw(mergechanges -f);
 
-our $debug = 0;
-open DEBUG, ">/dev/null" or die $!;
 
 our %opts_opt_map = ('dget' => \@dget,
                     'dput' => \@dput,
-                    'debsign' => \@debsign);
+                    'debsign' => \@debsign,
+                     'sbuild' => \@sbuild,
+                     'dpkg-buildpackage' => \@dpkgbuildpackage,
+                     'mergechanges' => \@mergechanges);
+
+our $keyid;
+
+our $debug = 0;
+open DEBUG, ">/dev/null" or die $!;
 
 our $remotename = 'dgit';
 our $ourdscfield = 'Vcs-Dgit-Master';
@@ -63,14 +71,16 @@ sub lrref () { return "refs/remotes/$remotename/$csuite"; }
 sub rrref () { return "refs/$branchprefix/$csuite"; }
 sub debiantag ($) { return "debian/$_[0]"; }
 
+sub dscfn ($) { return "${package}_$_[0].dsc"; }
+
 our $us = 'dgit';
 
-sub fail () { die "$us: @_\n"; }
+sub fail { die "$us: @_\n"; }
 
-sub badcfg () { print STDERR "$us: invalid configuration: @_\n"; exit 12; }
+sub badcfg { print STDERR "$us: invalid configuration: @_\n"; exit 12; }
 
 sub no_such_package () {
-    print STDERR "$us: package $package does not exist in suite $suite\n";
+    print STDERR "$us: package $package does not exist in suite $isuite\n";
     exit 4;
 }
 
@@ -266,13 +276,16 @@ sub access_giturl () {
 
 sub parsecontrolfh ($$@) {
     my ($fh, $desc, @opts) = @_;
-    my $c = Dpkg::Control::Hash->new({ 'name' => $desc, @opts });
+    my %opts = ('name' => $desc, @opts);
+    my $c = Dpkg::Control::Hash->new(%opts);
     $c->parse($fh) or die "parsing of $desc failed";
+    return $c;
 }
 
 sub parsecontrol {
     my ($file, $desc) = @_;
-    my $fh = new IO::File '<', $file or die "$file: $!";
+    my $fh = new IO::Handle;
+    open $fh, '<', $file or die "$file: $!";
     my $c = parsecontrolfh($fh,$desc);
     $fh->error and die $!;
     close $fh;
@@ -376,7 +389,7 @@ sub canonicalise_suite_madison ($$) {
     my @r = archive_query_madison($_[0],$_[1]);
     @r or fail
        "unable to canonicalise suite using package $package".
-       " which does not appear to exist in suite $suite;".
+       " which does not appear to exist in suite $isuite;".
        " --existing-package may help";
     return $r[2];
 }
@@ -399,7 +412,7 @@ sub get_archive_dsc () {
     print DEBUG Dumper($dscdata) if $debug>1;
     $dsc = parsecontrolfh($dscfh,$dscurl, allow_pgp=>1);
     print DEBUG Dumper($dsc) if $debug>1;
-    my $fmt = getfield $dsc 'Format';
+    my $fmt = getfield $dsc, 'Format';
     fail "unsupported source format $fmt, sorry" unless $format_ok{$fmt};
 }
 
@@ -463,7 +476,9 @@ sub mktree_in_ud_from_only_subdir () {
 
 sub dsc_files () {
     my $field = $dsc->{'Checksums-Sha256'} || $dsc->{Files};
-    fail "missing both Checksums-Sha256 and Files in ".$dsc->get_option('name');
+    defined $field or
+       fail "missing both Checksums-Sha256 and Files in ".
+       $dsc->get_option('name');
     map {
        m/^\w+ \d+ (\S+)$/ or
            fail "could not parse .dsc Files/Checksums line \`$_'";
@@ -515,7 +530,7 @@ tree $tree
 author $authline
 committer $authline
 
-$chhanges
+$changes
 
 # imported from the archive
 END
@@ -622,19 +637,19 @@ sub fetch_from_archive () {
     } else {
        die "$lrref_fn $!";
     }
-    print DEBUG "previous reference hash $upload_hash\n";
+    print DEBUG "previous reference hash=$upload_hash\n";
     my $hash;
     if (defined $dsc_hash) {
-       fail "missing git history even though dsc has hash -"
-           " could not find commit $dsc_hash"
-           " (should be in ".access_giturl()."#".rref().")";
+       fail "missing git history even though dsc has hash -".
+           " could not find commit $dsc_hash".
+           " (should be in ".access_giturl()."#".rref().")"
            unless $upload_hash;
        $hash = $dsc_hash;
        ensure_we_have_orig();
     } else {
        $hash = generate_commit_from_dsc();
     }
-    print DEBUG "current hash $hash\n";
+    print DEBUG "current hash=$hash\n";
     if ($upload_hash) {
        fail "not fast forward on last upload branch!".
            " (archive's version left in DGIT_ARCHIVE)"
@@ -691,7 +706,7 @@ sub pull () {
 }
 
 sub check_not_dirty () {
-    runcmd @git, qw(diff --quiet);
+    runcmd @git, qw(diff --quiet HEAD);
 }
 
 sub commit_quilty_patch ($) {
@@ -717,9 +732,9 @@ sub commit_quilty_patch ($) {
 sub dopush () {
     print DEBUG "actually entering push\n";
     my $clogp = parsechangelog();
-    $package = getfield $clogp 'Source';
+    $package = getfield $clogp, 'Source';
     my $cversion = getfield $clogp, 'Version';
-    my $dscfn = "${package}_${cversion}.dsc";
+    my $dscfn = dscfn($cversion);
     stat "../$dscfn" or
        fail "looked for .dsc $dscfn, but $!;".
            " maybe you forgot to build";
@@ -727,7 +742,7 @@ sub dopush () {
     my $dscpackage = getfield $dsc, 'Source';
     my $format = getfield $dsc, 'Format';
     my $dversion = getfield $dsc, 'Version';
-    ($dscpackage eq $package && $dversion eq $cversion)
+    ($dscpackage eq $package && $dversion eq $cversion) or
        fail "$dsc is for $dscpackage $dversion".
            " but debian/changelog is for $package $cversion";
     print DEBUG "format $format\n";
@@ -742,7 +757,7 @@ sub dopush () {
     runcmd qw(dpkg-source -x --), "../../../../$dscfn";
     my ($tree,$dir) = mktree_in_ud_from_only_subdir();
     chdir '../../../..' or die $!;
-    printcmd \@DEBUG,"+",@_;
+    printcmd \*DEBUG,"+",@_;
     my @diffcmd = (@git, qw(diff --exit-code), $tree);
     $!=0; $?=0;
     if (system @diffcmd) {
@@ -761,24 +776,31 @@ sub dopush () {
 #        (uploadbranch());
     $dsc->{$ourdscfield} = rev_parse('HEAD');
     $dsc->save("../$dscfn.tmp") or die $!;
-    if (!$dryrun) {
-       rename "../$dscfn.tmp","../$dscfn" or die "$dscfn $!";
-    } else {
-       print "[new .dsc left in $dscfn.tmp]\n";
-    }
     if (!$changesfile) {
-       my $pat = "${package}_c$version_*.changes";
-       my @cs = glob "../$pat";
-       fail "failed to find unique changes file".
-           " (looked for $pat in ..); perhaps you need to use dgit -C"
-           unless @cs==1;
-       ($changesfile) = @cs;
+       my $multi = "../${package}_${cversion}_multi.changes";
+       if (stat "$multi") {
+           $changesfile = $multi;
+       } else {
+           $!==&ENOENT or die "$multi: $!";
+           my $pat = "${package}_${cversion}_*.changes";
+           my @cs = glob "../$pat";
+           fail "failed to find unique changes file".
+               " (looked for $pat in .., or $multi);".
+               " perhaps you need to use dgit -C"
+               unless @cs==1;
+           ($changesfile) = @cs;
+       }
     }
     my $tag = debiantag($dversion);
     if (!check_for_git()) {
        create_remote_git_repo();
     }
     runcmd_ordryrun @git, qw(push),access_giturl(),"HEAD:".rrref();
+    if (!$dryrun) {
+       rename "../$dscfn.tmp","../$dscfn" or die "$dscfn $!";
+    } else {
+       print "[new .dsc left in $dscfn.tmp]\n";
+    }
     if ($sign) {
        my @tag_cmd = (@git, qw(tag -s -m),
                       "Release $dversion for $csuite [dgit]");
@@ -891,18 +913,48 @@ sub cmd_build {
     $package = getfield $clogp, 'Source';
     my @cmd =
        (qw(git-buildpackage -us -uc --git-no-sign-tags),
-        '--git-builder=dpkg-buildpackage -i\.git/ -I.git');
+        "--git-builder=@dpkgbuildpackage");
     unless (grep { m/^--git-debian-branch/ } @ARGV) {
        canonicalise_suite();
        push @cmd, "--git-debian-branch=".lbranch();
     }
     runcmd_ordryrun @cmd, @ARGV;
+    printdone "build successful\n";
 }
 
+sub cmd_sbuild {
+    check_not_dirty();
+    badusage "-p is not allowed with dgit sbuild" if defined $package;
+    my $clogp = parsechangelog();
+    $package = getfield $clogp, 'Source';
+    my $isuite = getfield $clogp, 'Distribution';
+    my $version = getfield $clogp, 'Version';
+    runcmd_ordryrun (@dpkgbuildpackage, qw(-us -uc -S));
+    chdir ".." or die $!;
+    my $sourcechanges = "${package}_${version}_source.changes";
+    my $dscfn = dscfn($version);
+    my $pat = "${package}_${version}_*.changes";
+    if (!$dryrun) {
+       stat $dscfn or fail "$dscfn (in parent directory): $!";
+       stat $sourcechanges or fail "$sourcechanges (in parent directory): $!";
+       foreach my $cf (glob $pat) {
+           next if $cf eq $sourcechanges;
+           unlink $cf or fail "remove $cf: $!";
+       }
+    }
+    runcmd_ordryrun @sbuild, @ARGV, qw(-d), $isuite, $dscfn;
+    runcmd_ordryrun @mergechanges, glob $pat;
+    my $multichanges = "${package}_${version}_multi.changes";
+    if (!$dryrun) {
+       stat $multichanges or fail "$multichanges: $!";
+    }
+    printdone "build successful, results in $multichanges\n" or die $!;
+}    
+
 sub cmd_quilt_fixup {
     badusage "incorrect arguments to dgit quilt-fixup";
     my $clogp = parsechangelog();
-    commit_quilty_patch((getfield $clogp, Version));
+    commit_quilty_patch((getfield $clogp, 'Version'));
 }
 
 sub parseopts () {