lintian: r1361 - in trunk: checks lib/Lintian/Collect

[rra@debian.org]

Author: rra
Date: 2008-06-07 10:14:30 +0200 (Sat, 07 Jun 2008)
New Revision: 1361

Modified:
   trunk/checks/standards-version
   trunk/lib/Lintian/Collect/Source.pm
Log:
Add a function to Lintian::Collect::Source to retrieve the source
package changelog as a Parse::DebianChangelog object and use that
function in checks/standards-version.


Modified: trunk/checks/standards-version
===================================================================
--- trunk/checks/standards-version	2008-06-07 08:01:34 UTC (rev 1360)
+++ trunk/checks/standards-version	2008-06-07 08:14:30 UTC (rev 1361)
@@ -77,16 +77,15 @@
 
 my $pkg = shift;
 my $type = shift;
+my $collect = shift;
 
 # udebs aren't required to conform to policy, so they don't need
 # Standards-Version. (If they have it, though, it should be valid.)
-unless (open(STANDARD, '<', 'fields/standards-version')) {
+my $version = $collect->field('standards-version');
+if (not defined $version) {
     tag 'no-standards-version-field' unless $type eq 'udeb';
     return 0;
 }
-my $version = <STANDARD>;
-close STANDARD;
-chomp $version;
 
 # Check basic syntax and strip off the fourth digit.  People are allowed to
 # include the fourth digit if they want, but it indicates a non-normative
@@ -99,13 +98,14 @@
 my $stdver = $1;
 my ($major, $minor, $patch) = $stdver =~ m/^(\d+)\.(\d+)\.(\d+)/;
 
+my $tag = "$version (current is $current)";
 if (not exists $standards{$stdver}) {
     # Unknown standards version.  Perhaps newer?
     if (   ($major > $current[0])
         or ($major == $current[0] and $minor > $current[1])
         or ($major == $current[0] and $minor == $current[1]
             and $patch > $current[2])) {
-        tag 'newer-standards-version', "$version (current is $current)";
+        tag 'newer-standards-version', $tag;
     } else {
         tag 'invalid-standards-version', $version;
     }
@@ -118,24 +118,21 @@
     # time the package was uploaded.
     my $stddate = $standards{$stdver};
     if (str2time($stddate) < time - (60 * 60 * 24 * 365 * 2)) {
-        tag 'ancient-standards-version', "$version (current is $current)";
+        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.
-        if (-l 'debfiles/changelog' || ! -f 'debfiles/changelog') {
-            tag 'out-of-date-standards-version',
-                "$version (current is $current)";
+        my $changes = $collect->changelog;
+        if (not defined $changes) {
+            tag 'out-of-date-standards-version', $tag;
             return 0;
         }
-        my %opts = (infile => 'debfiles/changelog', quiet => 1);
-        my $changes = Parse::DebianChangelog->init(\%opts);
         my ($entry) = $changes->data;
         my $timestamp = $entry ? $entry->Timestamp : 0;
         for my $standard (@standards) {
             last if $standard->[0] eq $stdver;
             if (str2time($standard->[1]) < $timestamp) {
-                tag 'out-of-date-standards-version',
-                    "$version (current is $current)";
+                tag 'out-of-date-standards-version', $tag;
             }
         }
     }

Modified: trunk/lib/Lintian/Collect/Source.pm
===================================================================
--- trunk/lib/Lintian/Collect/Source.pm	2008-06-07 08:01:34 UTC (rev 1360)
+++ trunk/lib/Lintian/Collect/Source.pm	2008-06-07 08:14:30 UTC (rev 1361)
@@ -19,6 +19,9 @@
 package Lintian::Collect::Source;
 use strict;
 
+use Lintian::Collect;
+use Parse::DebianChangelog;
+
 our @ISA = qw(Lintian::Collect);
 
 # Initialize a new source package collect object.  Takes the package name,
@@ -30,6 +33,20 @@
     return $self;
 }
 
+# Get the changelog file of a source package as a Parse::DebianChangelog
+# object.  Returns undef if the changelog file couldn't be found.
+sub changelog {
+    my ($self) = @_;
+    return $self->{changelog} if exists $self->{changelog};
+    if (-l 'debfiles/changelog' || ! -f 'debfiles/changelog') {
+        $self->{changelog} = undef;
+    } else {
+        my %opts = (infile => 'debfiles/changelog', quiet => 1);
+        $self->{changelog} = Parse::DebianChangelog->init(\%opts);
+    }
+    return $self->{changelog};
+}
+
 # Returns whether the package is a native package.  For everything except
 # format 3.0 (quilt) packages, we base this on whether we have a Debian
 # *.diff.gz file.  3.0 (quilt) packages are always non-native.  Returns true
@@ -90,6 +107,13 @@
 
 =over 4
 
+=item changelog()
+
+Returns the changelog of the source package as a Parse::DebianChangelog
+object, or undef if the changelog is a symlink or doesn't exist.  The
+debfiles collection script must have been run to create the changelog
+file, which this method expects to find in F<debfiles/changelog>.
+
 =item native()
 
 Returns true if the source package is native and false otherwise.