Replace many calls to stat with new wrapper stat_exists; improves error handling...

[dgit.git] / dgit

diff --git a/dgit b/dgit
index 53ca56c0bc014a5d89fca5180524db39e5ab8fa6..6fd8f7d768fc7058e4db69f5000f33e7f4b01dee 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:
@@ -641,7 +648,6 @@ sub parsecontrolfh ($$;$) {
     for (;;) {
        my %opts = ('name' => $desc);
        $opts{allow_pgp}= $allowsigned || !$dpkgcontrolhash_noissigned;
-print STDERR Dumper(\%opts);
        $c = Dpkg::Control::Hash->new(%opts);
        $c->parse($fh,$desc) or die "parsing of $desc failed";
        last if $allowsigned;
@@ -767,7 +773,7 @@ sub madison_parse ($) {
        $5 eq 'source' or die "$rmad ?";
        push @out, [$vsn,pool_dsc_subpath($vsn,$component),$newsuite];
     }
-    return sort { -version_compare_string($a->[0],$b->[0]); } @out;
+    return sort { -version_compare($a->[0],$b->[0]); } @out;
 }
 
 sub canonicalise_suite_madison ($$) {
@@ -825,7 +831,7 @@ sub archive_query_sshpsql ($$) {
            AND source.source='$package'
            AND files.filename LIKE '%.dsc';
 END
-    @rows = sort { -version_compare_string($a->[0],$b->[0]) } @rows;
+    @rows = sort { -version_compare($a->[0],$b->[0]) } @rows;
     my $digester = Digest::SHA->new(256);
     @rows = map {
        my ($vsn,$component,$filename,$sha256sum) = @$_;
@@ -883,7 +889,7 @@ sub archive_query_dummycat ($$) {
     }
     C->error and die "$dpath: $!";
     close C;
-    return sort { -version_compare_string($a->[0],$b->[0]); } @rows;
+    return sort { -version_compare($a->[0],$b->[0]); } @rows;
 }
 
 sub canonicalise_suite () {
@@ -977,7 +983,7 @@ 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';
+    fail "source package contains .git directory" if stat_exists '.git';
     die $! unless $!==&ENOENT;
     runcmd qw(git init -q);
     rmtree('.git/objects');
@@ -1097,7 +1103,7 @@ END
        my $oldclogp = parsecontrol('../changelogold.tmp','previous changelog');
        my $oversion = getfield $oldclogp, 'Version';
        my $vcmp =
-           version_compare_string($oversion, $cversion);
+           version_compare($oversion, $cversion);
        if ($vcmp < 0) {
            # git upload/ is earlier vsn than archive, use archive
            open C, ">../commit2.tmp" or die $!;
@@ -1141,11 +1147,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";
@@ -1279,7 +1283,7 @@ END
        my $gotclogp = parsechangelog("-l$clogf");
        my $got_vsn = getfield $gotclogp, 'Version';
        printdebug "SKEW CHECK GOT $got_vsn\n";
-       if (version_compare_string($got_vsn, $skew_warning_vsn) < 0) {
+       if (version_compare($got_vsn, $skew_warning_vsn) < 0) {
            print STDERR <<END or die $!;
 
 Warning: archive skew detected.  Using the available version:
@@ -1491,7 +1495,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";
 
@@ -1536,10 +1540,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".
@@ -1622,10 +1625,8 @@ sub cmd_clone {
     }
     $dstdir ||= "$package";
 
-    if (stat $dstdir) {
+    if (stat_exists $dstdir) {
        fail "$dstdir already exists";
-    } elsif ($! != &ENOENT) {
-       die "$dstdir: $!";
     }
 
     my $cwd_remove;
@@ -1849,7 +1850,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;
 }
@@ -2054,7 +2056,7 @@ sub changesopts () {
        }
        if (@vsns) {
            @vsns = map { $_->[0] } @vsns;
-           @vsns = sort { -version_compare_string($a, $b) } @vsns;
+           @vsns = sort { -version_compare($a, $b) } @vsns;
            $changes_since_version = $vsns[0];
            progress "changelog will contain changes since $vsns[0]";
        } else {
@@ -2119,8 +2121,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: $!";
@@ -2137,7 +2140,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 $!;
 }