[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index] [Thread Index]

lintian: r1358 - in trunk: checks debian lib/Lintian lib/Lintian/Collect



Author: rra
Date: 2008-06-07 09:47:11 +0200 (Sat, 07 Jun 2008)
New Revision: 1358

Added:
   trunk/lib/Lintian/Collect.pm
   trunk/lib/Lintian/Collect/
   trunk/lib/Lintian/Collect/Source.pm
Modified:
   trunk/checks/cruft
   trunk/debian/changelog
Log:
* checks/cruft:
  + [RA] Use the new Lintian::Collect interface to check whether a
    package is native.
* lib/Lintian/Collect.pm:
  + [RA] New module to retrieve package information.
* lib/Lintian/Collect/Source.pm:
  + [RA] New module to retrieve source package information.


Modified: trunk/checks/cruft
===================================================================
--- trunk/checks/cruft	2008-06-07 04:59:05 UTC (rev 1357)
+++ trunk/checks/cruft	2008-06-07 07:47:11 UTC (rev 1358)
@@ -78,13 +78,17 @@
 my $native;
 
 my $dir;
-my $pkg;
 my $atdinbd;
 
+# Used in the find function.
+my $pkg;
+my $collect;
+
 sub run {
 
 $pkg = shift;
 my $type = shift;
+$collect = Lintian::Collect->new($pkg, $type);
 
 if (-e "debfiles/files" and not -z "debfiles/files") {
     tag 'debian-files-list-in-source';
@@ -92,21 +96,9 @@
 
 # This doens't really belong here, but there isn't a better place at the
 # moment to put this check.
-open (FORMAT, '<', "fields/format")
-    or fail("cannot open fields/format: $!");
-my $format = <FORMAT>;
-chomp $format;
-close FORMAT;
-if ($format =~ /^\s*3\.0\s+\(quilt\)\s*$/) {
-    $native = 0;
-} else {
-    open (VERSION, '<', "fields/version")
-        or fail("cannot open fields/version: $!");
-    chomp(my $version = <VERSION>);
-    close VERSION;
-    $version =~ s/^\d+://; #Remove epoch
-    $native = (! -f "${pkg}_${version}.diff.gz");
-    if ($native and $version =~ /-/ and $version !~ /-0\.[^-]+$/) {
+if ($collect->native) {
+    my $version = $collect->field('version');
+    if ($version =~ /-/ and $version !~ /-0\.[^-]+$/) {
         tag 'native-package-with-dash-version';
     }
 }
@@ -199,7 +191,7 @@
 # than creating yet a third set of tags, and this gets the severity right.
 sub find_cruft {
     (my $name = $File::Find::name) =~ s,^(\./)?unpacked/,,;
-    my $prefix = ($native ? "diff-contains" : "source-contains");
+    my $prefix = ($collect->native ? "diff-contains" : "source-contains");
     if (-d and not $warned{$name}) {
         for my $rule (@directory_checks) {
             if ($name =~ /$rule->[0]/) {
@@ -211,7 +203,7 @@
 
     unless ($warned{$name}) {
         for my $rule (@file_checks) {
-            next if ($rule->[2] and not $native);
+            next if ($rule->[2] and not $collect->native);
             if ($name =~ /$rule->[0]/) {
                 tag "${prefix}-$rule->[1]", $name unless $pkg eq 'lintian';
             }

Modified: trunk/debian/changelog
===================================================================
--- trunk/debian/changelog	2008-06-07 04:59:05 UTC (rev 1357)
+++ trunk/debian/changelog	2008-06-07 07:47:11 UTC (rev 1358)
@@ -18,6 +18,8 @@
   * checks/cruft:
     + [RA] Format: 3.0 (quilt) packages are not native even though they
       have no *.diff.gz.  Thanks, Raphael Hertzog.  (Closes: #483384)
+    + [RA] Use the new Lintian::Collect interface to check whether a
+      package is native.
   * checks/fields:
     + [RA] Syntax-check Breaks like other relationship fields.  Warn if
       any packages use Breaks for right now.  Only check for duplicate
@@ -81,7 +83,12 @@
   * debian/control:
     + [RA] Update standards version to 3.8.0.
     + [RA] Depend on libtimedate-perl for convenient date parsing.
-  
+
+  * lib/Lintian/Collect.pm:
+    + [RA] New module to retrieve package information.
+  * lib/Lintian/Collect/Source.pm:
+    + [RA] New module to retrieve source package information.
+
   * reporting/html_reports:
     + [RA] Copy over images.  Set the maintainer name to "Unknown
       Maintainer" if not known.  Pass the code for a tag into the per-tag

Added: trunk/lib/Lintian/Collect/Source.pm
===================================================================
--- trunk/lib/Lintian/Collect/Source.pm	                        (rev 0)
+++ trunk/lib/Lintian/Collect/Source.pm	2008-06-07 07:47:11 UTC (rev 1358)
@@ -0,0 +1,115 @@
+# -*- perl -*-
+# Lintian::Collect::Source -- interface to source package data collection
+
+# Copyright (C) 2008 Russ Allbery
+#
+# This program is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by the Free
+# Software Foundation; either version 2 of the License, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+# more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program.  If not, see <http://www.gnu.org/licenses/>.
+
+package Lintian::Collect::Source;
+use strict;
+
+our @ISA = qw(Lintian::Collect);
+
+# Initialize a new source package collect object.  Takes the package name,
+# which is currently unused.
+sub new {
+    my ($class, $pkg) = @_;
+    my $self = {};
+    bless($self, $class);
+    return $self;
+}
+
+# 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
+# if the package is native and false otherwise.
+sub native {
+    my ($self) = @_;
+    return $self->{native} if exists $self->{native};
+    my $format = $self->field('format');
+    if ($format =~ /^\s*3\.0\s+\(quilt\)\s*$/) {
+        $self->{native} = 0;
+    } else {
+        my $version = $self->field('version');
+        $version =~ s/^\d+://;
+        my $name = $self->{name};
+        $self->{native} = (-f "${name}_${version}.diff.gz" ? 0 : 1);
+    }
+    return $self->{native};
+}
+
+=head1 NAME
+
+Lintian::Collect::Source - Lintian interface to source package data collection
+
+=head1 SYNOPSIS
+
+    my $collect = Lintian::Collect->new($name, $type);
+    if ($collect->native) {
+        print "Package is native\n";
+    }
+
+=head1 DESCRIPTION
+
+Lintian::Collect::Source provides an interface to package data for source
+packages.  It implements data collection methods specific to source
+packages.
+
+This module is in its infancy.  Most of Lintian still reads all data from
+files in the laboratory whenever that data is needed and generates that
+data via collect scripts.  The goal is to eventually access all data about
+source packages via this module so that the module can cache data where
+appropriate and possibly retire collect scripts in favor of caching that
+data in memory.
+
+=head1 CLASS METHODS
+
+=item new(PACKAGE)
+
+Creates a new Lintian::Collect::Source object.  Currently, PACKAGE is
+ignored.  Normally, this method should not be called directly, only via
+the Lintian::Collect constructor.
+
+=back
+
+=head1 INSTANCE METHODS
+
+In addition to the instance methods listed below, all instance methods
+documented in the Lintian::Collect module are also available.
+
+=over 4
+
+=item native()
+
+Returns true if the source package is native and false otherwise.
+
+=back
+
+=head1 AUTHOR
+
+Originally written by Russ Allbery <rra@debian.org> for Lintian.
+
+=head1 SEE ALSO
+
+lintian(1), Lintian::Collect::Source(3)
+
+=cut
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 ts=4 et shiftround

Added: trunk/lib/Lintian/Collect.pm
===================================================================
--- trunk/lib/Lintian/Collect.pm	                        (rev 0)
+++ trunk/lib/Lintian/Collect.pm	2008-06-07 07:47:11 UTC (rev 1358)
@@ -0,0 +1,153 @@
+# -*- perl -*-
+# Lintian::Collect -- interface to package data collection
+
+# Copyright (C) 2008 Russ Allbery
+#
+# This program is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by the Free
+# Software Foundation; either version 2 of the License, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+# more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program.  If not, see <http://www.gnu.org/licenses/>.
+
+package Lintian::Collect;
+use strict;
+
+use Lintian::Collect::Source;
+
+# Take the package name and type, initialize an appropriate collect object
+# based on the package type, and return it.  Returns undef for an unknown
+# package type.
+sub new {
+    my ($class, $pkg, $type) = @_;
+    if ($type eq 'source') {
+        my $object = Lintian::Collect::Source->new ($pkg);
+        $object->{name} = $pkg;
+        return $object;
+    } else {
+        return;
+    }
+}
+
+# Return the package name.
+sub name {
+    my ($self) = @_;
+    return $self->{name};
+}
+
+# Return the package type.
+sub type {
+    my ($self) = @_;
+    return $self->{type};
+}
+
+# Return the value of the specified control field of the package, or undef if
+# that field wasn't present in the control file for the package.  For source
+# packages, this is the *.dsc file; for binary packages, this is the control
+# file in the control section of the package.
+sub field {
+    my ($self, $field) = @_;
+    return $self->{field}{$field} if exists $self->{field}{$field};
+    if (open(FIELD, '<', "fields/$field")) {
+        local $/;
+        my $value = <FIELD>;
+        close FIELD;
+        $value =~ s/\n\z//;
+        $self->{field}{$field} = $value;
+    } else {
+        $self->{field}{$field} = undef;
+    }
+    return $self->{field}{$field};
+}
+
+=head1 NAME
+
+Lintian::Collect - Lintian interface to package data collection
+
+=head1 SYNOPSIS
+
+    my $collect = Lintian::Collect->new($name, $type);
+    $name = $collect->name;
+    $type = $collect->type;
+
+=head1 DESCRIPTION
+
+Lintian::Collect provides the shared interface to package data used by
+source, binary, and udeb packages.  It creates an object of the
+appropriate type and provides common functions used by the collection
+interface to all three types of packages.
+
+This module is in its infancy.  Most of Lintian still reads all data from
+files in the laboratory whenever that data is needed and generates that
+data via collect scripts.  The goal is to eventually access all data via
+this module and its subclasses so that the module can cache data where
+appropriate and possibly retire collect scripts in favor of caching that
+data in memory.
+
+=head1 CLASS METHODS
+
+=over 4
+
+=item new(PACKAGE, TYPE)
+
+Creates a new object appropriate to the package type.  Currently, the only
+TYPE supported is C<source>, which creates a new Lintian::Collect::Source
+object and returns it.  TYPE can be retrieved later with the type()
+method.  Returns undef an unknown TYPE.
+
+PACKAGE is the name of the package and is stored in the collect object.
+It can be retrieved with the name() method.
+
+=back
+
+=head1 INSTANCE METHODS
+
+In addition to the instance methods documented here, see the documentation
+of Lintian::Collect::Source for instance methods specific to source
+packages.
+
+=over 4
+
+=item field(FIELD)
+
+Returns the value of the control field FIELD in the control file for the
+package.  For a source package, this is the *.dsc file; for a binary
+package, this is the control file in the control section of the package.
+The value will be read from the F<fields/> subdirectory of the current
+directory if it hasn't previously been requested and cached in memory so
+that subsequent requests for the same field can be answered without file
+accesses.
+
+=item name()
+
+Returns the name of the package.
+
+=item type()
+
+Returns the type of the package.
+
+=back
+
+=head1 AUTHOR
+
+Originally written by Russ Allbery <rra@debian.org> for Lintian.
+
+=head1 SEE ALSO
+
+lintian(1), Lintian::Collect::Source(3)
+
+=cut
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 sts=4 ts=4 et shiftround


Reply to: