Break out commit_admin (nfc)

[dgit.git] / dgit

diff --git a/dgit b/dgit
index f571933a1a505a8717fc182a0df4b964c06170c4..9d8f9d428e4f6752fe247ecc2133f91b0b47e9b0 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -177,6 +177,13 @@ sub changedir ($) {
     chdir $newdir or die "chdir: $newdir: $!";
 }
 
+sub stat_exists ($) {
+    my ($f) = @_;
+    return 1 if stat $f;
+    return 0 if $!==&ENOENT;
+    die "stat $f: $!";
+}
+
 #---------- remote protocol support, common ----------
 
 # remote push initiator/responder protocol:
@@ -969,6 +976,12 @@ sub prep_ud () {
     mkdir $ud or die $!;
 }
 
+sub mktree_in_ud_here () {
+    runcmd qw(git init -q);
+    rmtree('.git/objects');
+    symlink '../../../../objects','.git/objects' or die $!;
+}
+
 sub mktree_in_ud_from_only_subdir () {
     # changes into the subdir
     my (@dirs) = <*/.>;
@@ -976,11 +989,8 @@ sub mktree_in_ud_from_only_subdir () {
     $dirs[0] =~ m#^([^/]+)/\.$# or die;
     my $dir = $1;
     changedir $dir;
-    fail "source package contains .git directory" if stat '.git';
-    die $! unless $!==&ENOENT;
-    runcmd qw(git init -q);
-    rmtree('.git/objects');
-    symlink '../../../../objects','.git/objects' or die $!;
+    fail "source package contains .git directory" if stat_exists '.git';
+    mktree_in_ud_here();
     runcmd @git, qw(add -Af);
     my $tree = cmdoutput @git, qw(write-tree);
     $tree =~ m/^\w+$/ or die "$tree ?";
@@ -1018,9 +1028,12 @@ sub dsc_files () {
     map { $_->{Filename} } dsc_files_info();
 }
 
-sub is_orig_file ($) {
-    local ($_) = @_;
-    m/\.orig(?:-\w+)?\.tar\.\w+$/;
+sub is_orig_file ($;$) {
+    local ($_) = $_[0];
+    my $base = $_[1];
+    m/\.orig(?:-\w+)?\.tar\.\w+$/ or return 0;
+    defined $base or return 1;
+    return $` eq $base;
 }
 
 sub make_commit ($) {
@@ -1140,11 +1153,9 @@ sub complete_file_from_dsc ($$) {
     my $tf = "$dstdir/$f";
     my $downloaded = 0;
 
-    if (stat $tf) {
+    if (stat_exists $tf) {
        progress "using existing $f";
     } else {
-       die "$tf $!" unless $!==&ENOENT;
-
        my $furl = $dscurl;
        $furl =~ s{/[^/]+$}{};
        $furl .= "/$f";
@@ -1355,6 +1366,12 @@ sub check_not_dirty () {
     }
 }
 
+sub commit_admin ($) {
+    my ($m) = @_;
+    progress "$m";
+    runcmd_ordryrun_local @git, qw(commit -m), $m;
+}
+
 sub commit_quilty_patch () {
     my $output = cmdoutput @git, qw(status --porcelain);
     my %adds;
@@ -1369,9 +1386,7 @@ sub commit_quilty_patch () {
        return;
     }
     runcmd_ordryrun_local @git, qw(add), sort keys %adds;
-    my $m = "Commit Debian 3.0 (quilt) metadata";
-    progress "$m";
-    runcmd_ordryrun_local @git, qw(commit -m), $m;
+    commit_admin "Commit Debian 3.0 (quilt) metadata";
 }
 
 sub madformat ($) {
@@ -1490,7 +1505,7 @@ sub dopush () {
        push_parse_changelog("$clogpfn");
 
     my $dscpath = "$buildproductsdir/$dscfn";
-    stat $dscpath or
+    stat_exists $dscpath or
        fail "looked for .dsc $dscfn, but $!;".
            " maybe you forgot to build";
 
@@ -1535,10 +1550,9 @@ sub dopush () {
     if (!$changesfile) {
        my $multi = "$buildproductsdir/".
            "${package}_".(stripepoch $cversion)."_multi.changes";
-       if (stat "$multi") {
+       if (stat_exists "$multi") {
            $changesfile = $multi;
        } else {
-           $!==&ENOENT or die "$multi: $!";
            my $pat = "${package}_".(stripepoch $cversion)."_*.changes";
            my @cs = glob "$buildproductsdir/$pat";
            fail "failed to find unique changes file".
@@ -1621,10 +1635,8 @@ sub cmd_clone {
     }
     $dstdir ||= "$package";
 
-    if (stat $dstdir) {
+    if (stat_exists $dstdir) {
        fail "$dstdir already exists";
-    } elsif ($! != &ENOENT) {
-       die "$dstdir: $!";
     }
 
     my $cwd_remove;
@@ -1848,7 +1860,8 @@ sub i_resp_file ($) {
     my ($keyword) = @_;
     my $localname = i_method "i_localname", $keyword;
     my $localpath = "$i_tmp/$localname";
-    stat $localpath and badproto \*RO, "file $keyword ($localpath) twice";
+    stat_exists $localpath and
+       badproto \*RO, "file $keyword ($localpath) twice";
     protocol_receive_file \*RO, $localpath;
     i_method "i_file", $keyword;
 }
@@ -2118,8 +2131,9 @@ sub cmd_sbuild {
     changedir "..";
     my $pat = "${package}_".(stripepoch $version)."_*.changes";
     if (act_local()) {
-       stat $dscfn or fail "$dscfn (in parent directory): $!";
-       stat $sourcechanges or fail "$sourcechanges (in parent directory): $!";
+       stat_exist $dscfn or fail "$dscfn (in parent directory): $!";
+       stat_exists $sourcechanges
+           or fail "$sourcechanges (in parent directory): $!";
        foreach my $cf (glob $pat) {
            next if $cf eq $sourcechanges;
            unlink $cf or fail "remove $cf: $!";
@@ -2136,7 +2150,7 @@ sub cmd_sbuild {
     runcmd_ordryrun_local @mergechanges, @changesfiles;
     my $multichanges = "${package}_".(stripepoch $version)."_multi.changes";
     if (act_local()) {
-       stat $multichanges or fail "$multichanges: $!";
+       stat_exists $multichanges or fail "$multichanges: $!";
     }
     printdone "build successful, results in $multichanges\n" or die $!;
 }