[SCM] Debian package checker branch, master, updated. 2.5.2-45-g29b6625

["Niels Thykier" <niels@thykier.net>]

The following commit has been merged in the master branch:
commit 29b662571fa328615ca5193694eee5471a2957e1
Author: Niels Thykier <niels@thykier.net>
Date:   Sun Aug 21 15:27:12 2011 +0200

    Made ancient-standards-version independent of system time
    
    The ancient standards-version check now relies on a manually
    updated constant.  For development versions, there is a test to
    ensure the date is regularly updated.

diff --git a/checks/standards-version b/checks/standards-version
index ee70d0d..872bc8e 100644
--- a/checks/standards-version
+++ b/checks/standards-version
@@ -25,11 +25,15 @@ use strict;
 use warnings;
 
 use POSIX qw(strftime);
+use Date::Parse qw(str2time);
 
 use Lintian::Data;
 use Lintian::Tags qw(tag);
 use Util;
 
+# Any Standards Version released before this day is "ancient"
+my $ANCIENT_DATE = str2time('21 Aug 2009') or fail "Cannot parse ANCIENT_DATE: $!";
+
 my $STANDARDS = Lintian::Data->new('standards-version/release-dates', qr/\s+/o);
 
 # In addition to the normal Lintian::Data structure, we also want a list of
@@ -124,19 +128,12 @@ if (not $STANDARDS->known($stdver)) {
     # A given standards version is considered obsolete if the version
     # following it has been out for at least two years (so the current version
     # is never obsolete).
-    my $obsdate = time;
-    for my $index (0 .. $#STANDARDS) {
-        if ($STANDARDS[$index][0] eq $stdver) {
-            $obsdate = $STANDARDS[$index - 1][1] if $index > 0;
-            last;
-        }
-    }
-    if ($obsdate + (60 * 60 * 24 * 365 * 2) < time) {
+    my $rdate = $STANDARDS->value($stdver);
+    if ($rdate < $ANCIENT_DATE) {
         tag 'ancient-standards-version', $tag;
     } else {
         # We have to get the package date from the changelog file.  If we
         # can't find the changelog file, always issue the tag.
-        my $changes = $info->changelog;
         if (not defined $changes) {
             tag 'out-of-date-standards-version', $tag;
             return 0;
diff --git a/debian/changelog b/debian/changelog
index 14b64d8..ae25fa4 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -21,6 +21,9 @@ lintian (2.5.3) UNRELEASED; urgency=low
       static libraries, .pc-, elf and pyshared-data-files.  This
       covers all the false-positives currently found in the liblicense
       package.  (Closes: #617901)
+  * checks/standards-version:
+    + [NT] Made the ancient-standards-version independent of the
+      system time.
 
   * collection/fields{,.desc}:
     + [NT] Removed, no longer used.
diff --git a/t/scripts/ancient-sv-date.t b/t/scripts/ancient-sv-date.t
new file mode 100755
index 0000000..0091406
--- /dev/null
+++ b/t/scripts/ancient-sv-date.t
@@ -0,0 +1,72 @@
+#!/usr/bin/perl
+#
+# Test for keeping "ancient standards version" date
+# recent.
+#
+
+use strict;
+use warnings;
+
+use Test::More;
+
+# How much out of date the check may be; measured in seconds
+# 1 month
+use constant ERROR_MARGIN => 3600 * 24 * 31;
+# How long before a SV is considered "Ancient" in seconds.
+# 2 years.
+use constant ANCIENT_AGE  => 3600 * 24 * 365 * 2;
+use Date::Parse qw(str2time);
+
+# STOP! Before you even consider to make this run always
+# remember that this test will fail (causing FTBFS) every
+# "ERROR_MARGIN" seconds!
+#   This check is here to remind us to update ANCIENT_DATE
+# in checks/standards-version every now and then during
+# development cycles!
+plan skip_all => 'Only checked for UNRELEASED versions'
+    if should_skip();
+
+plan tests => 2;
+
+my $check = "$ENV{'LINTIAN_ROOT'}/checks/standards-version";
+my $found = 0;
+open my $fd, '<', $check or die "opening $check: $!";
+while ( my $line = <$fd> ) {
+    # We are looking for:
+    #   my $ANCIENT_DATE = str2time('20 Aug 2009')
+    $line =~ s,\#.*+,,o;
+    if ($line =~ m/ANCIENT_DATE \s* = \s* str2time\s*\(\s*
+                  [\'\"]([^\'\"]+)[\'\"]/ox){
+        my $date = $1;
+        my $and = str2time($date) or die "Cannot parse date ($date, line $.): $!";
+        my $time = time - ANCIENT_AGE;
+        $found = 1;
+        cmp_ok($time, '<', $and + ERROR_MARGIN, "ANCIENT_DATE is up to date");
+        cmp_ok($time, '>', $and - ERROR_MARGIN, "ANCIENT_DATE is not too far ahead");
+        last;
+    }
+}
+close $fd;
+
+die "Cannot find ANCIENT_DATE.\n" unless $found;
+
+
+sub should_skip {
+    my $skip = 1;
+    my $pid;
+
+    $pid = open (DPKG, '-|', 'dpkg-parsechangelog', '-c0');
+
+    die("failed to execute dpkg-parsechangelog: $!")
+	unless defined ($pid);
+
+    while (<DPKG>) {
+	$skip = 0 if m/^Distribution: UNRELEASED$/;
+    }
+
+    close(DPKG)
+	or die ("dpkg-parsechangelog returned: $?");
+
+    return $skip;
+}
+

-- 
Debian package checker