[SCM] Debian package checker branch, master, updated. 2.2.6-58-g63c78f2

["Russ Allbery" <rra@debian.org>]

The following commit has been merged in the master branch:
commit a35fe8c42df00ca6b795bfb1742919b276f12aed
Author: Russ Allbery <rra@debian.org>
Date:   Sun Mar 8 15:31:14 2009 -0700

    Use real files for version information and fix collect script reaping
    
    Use real files rather than symlinks to store the version information
    for each collect script, with a minimal dpkg control format giving the
    Lintian version and timestamp.
    
    Correctly check the reap status and catch errors when changing unpack
    levels as well as when finishing with all unpacks.  Move the reaping
    of collect scripts into a sub to reduce code duplication.
    
    Remove old version marker files in pure Perl rather than forking a
    shell.

diff --git a/frontend/lintian b/frontend/lintian
index 54e431c..fdcdaf3 100755
--- a/frontend/lintian
+++ b/frontend/lintian
@@ -1445,9 +1445,18 @@ foreach my $pkg_info ($schedule->get_all) {
 	    # current type?
 	    next unless ($ci->{'type'} =~ m/$type/);
 
-	    # info already available?
-	    next if (-l "$base/.${coll}$ci->{'version'}");
-	    system('sh', '-c', 'rm -f '."'$base'/.${coll}*");
+	    # If a file named .SCRIPT-VERSION already exists, we've already
+	    # collected this information and we can skip it.  Otherwise,
+	    # remove any .SCRIPT-* files (which are old version information).
+	    next if (-f "$base/.${coll}-$ci->{'version'}");
+	    opendir(BASE, $base)
+		or fail("cannot read directory $base: $!");
+	    for my $file (readdir BASE) {
+		if ($file =~ /^\.\Q$coll-/) {
+		    unlink("$base/$file");
+		}
+	    }
+	    closedir(BASE);
 
 	    # unpack to desired unpack level (if necessary)
 	    $act_unpack_level = unpack_pkg($type,$base,$file,$act_unpack_level,$ci->{'unpack-level'});
@@ -1469,8 +1478,11 @@ foreach my $pkg_info ($schedule->get_all) {
 	    $current_order = $ci->{'order'} if ($current_order == -1);
 	    if ($current_order != $ci->{'order'}) {
 		debug_msg(1, "Waiting for jobs from order $current_order ...");
-		# wait until the jobs of the previous order finish:
-		reap(@pending_jobs);
+		unless (reap_collect_jobs($pkg, $base, @pending_jobs)) {
+		    warning("skipping $action of $long_type package $pkg");
+		    $exit_code = 2;
+		    next PACKAGE;
+		}
 		undef @pending_jobs;
 		$current_order = $ci->{'order'};
 	    }
@@ -1491,13 +1503,7 @@ foreach my $pkg_info ($schedule->get_all) {
 	# wait until all the jobs finish and skip this package if any of them
 	# failed.
 	debug_msg(1, "Waiting for jobs from order $current_order ...");
-	unless (reap(@pending_jobs)) {
-	    for my $job (@pending_jobs) {
-		unless ($job->{success}) {
-		    warning("collect info $job->{'description'} about package"
-			    . " $pkg failed");
-		}
-	    }
+	unless (reap_collect_jobs($pkg, $base, @pending_jobs)) {
 	    warning("skipping $action of $long_type package $pkg");
 	    $exit_code = 2;
 	    next PACKAGE;
@@ -1570,7 +1576,6 @@ foreach my $pkg_info ($schedule->get_all) {
 	    } elsif ($fail_on_warnings && $stats->{types}{W}) {
 		$exit_code = 1;
 	    }
-	    symlink $$, ".${coll}$ci->{'version'}";
 	}
 
 	# report unused overrides
@@ -1733,6 +1738,32 @@ sub unpack_pkg {
     return $cur_level;
 }
 
+# Given a list of jobs corresponding to collect scripts, reap each of the
+# jobs.  For each successful job, record that it was successful by creating
+# the corresponding version marker file in the lab.  For each unsuccessful
+# job, warn that it was unsuccessful.
+#
+# Takes the current package, base directory, and the list of pending jobs.
+# Return true if all jobs were successful, false otherwise.
+sub reap_collect_jobs {
+    my ($pkg, $base, @pending_jobs) = @_;
+    my $status = reap(@pending_jobs);
+    for my $job (@pending_jobs) {
+	my $coll = $job->{'description'};
+	if ($job->{success}) {
+	    my $ci = $collection_info{$coll};
+	    open(VERSION, '>', "$base/.${coll}-$ci->{'version'}")
+		or fail("cannot create $base/.${coll}-$ci->{'version'}: $!");
+	    print VERSION "Lintian-Version: $LINTIAN_VERSION\n"
+		. "Timestamp: " . time . "\n";
+	    close(VERSION);
+	} else {
+	    warning("collect info $coll about package $pkg failed");
+	}
+    }
+    return $status;
+}
+
 # TODO: is this the best way to clean dirs in perl?
 # no, look at File::Path module
 sub clean_pkg {

-- 
Debian package checker