git.maemo.org Git - maemian/blob - nokia-lintian/lib/Lintian/Collect/Source.pm

   1 # -*- perl -*-
   2 # Lintian::Collect::Source -- interface to source package data collection
   3
   4 # Copyright (C) 2008 Russ Allbery
   5 #
   6 # This program is free software; you can redistribute it and/or modify it
   7 # under the terms of the GNU General Public License as published by the Free
   8 # Software Foundation; either version 2 of the License, or (at your option)
   9 # any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful, but WITHOUT
  12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13 # FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
  14 # more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # this program.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 package Lintian::Collect::Source;
  20 use strict;
  21
  22 use Lintian::Collect;
  23 use Parse::DebianChangelog;
  24
  25 our @ISA = qw(Lintian::Collect);
  26
  27 # Initialize a new source package collect object.  Takes the package name,
  28 # which is currently unused.
  29 sub new {
  30     my ($class, $pkg) = @_;
  31     my $self = {};
  32     bless($self, $class);
  33     return $self;
  34 }
  35
  36 # Get the changelog file of a source package as a Parse::DebianChangelog
  37 # object.  Returns undef if the changelog file couldn't be found.
  38 sub changelog {
  39     my ($self) = @_;
  40     return $self->{changelog} if exists $self->{changelog};
  41     if (-l 'debfiles/changelog' || ! -f 'debfiles/changelog') {
  42         $self->{changelog} = undef;
  43     } else {
  44         my %opts = (infile => 'debfiles/changelog', quiet => 1);
  45         $self->{changelog} = Parse::DebianChangelog->init(\%opts);
  46     }
  47     return $self->{changelog};
  48 }
  49
  50 # Returns whether the package is a native package.  For everything except
  51 # format 3.0 (quilt) packages, we base this on whether we have a Debian
  52 # *.diff.gz file.  3.0 (quilt) packages are always non-native.  Returns true
  53 # if the package is native and false otherwise.
  54 sub native {
  55     my ($self) = @_;
  56     return $self->{native} if exists $self->{native};
  57     my $format = $self->field('format');
  58     if ($format =~ /^\s*3\.0\s+\(quilt\)\s*$/) {
  59         $self->{native} = 0;
  60     } else {
  61         my $version = $self->field('version');
  62         $version =~ s/^\d+://;
  63         my $name = $self->{name};
  64         $self->{native} = (-f "${name}_${version}.diff.gz" ? 0 : 1);
  65     }
  66     return $self->{native};
  67 }
  68
  69 =head1 NAME
  70
  71 Lintian::Collect::Source - Lintian interface to source package data collection
  72
  73 =head1 SYNOPSIS
  74
  75     my $collect = Lintian::Collect->new($name, $type);
  76     if ($collect->native) {
  77         print "Package is native\n";
  78     }
  79
  80 =head1 DESCRIPTION
  81
  82 Lintian::Collect::Source provides an interface to package data for source
  83 packages.  It implements data collection methods specific to source
  84 packages.
  85
  86 This module is in its infancy.  Most of Lintian still reads all data from
  87 files in the laboratory whenever that data is needed and generates that
  88 data via collect scripts.  The goal is to eventually access all data about
  89 source packages via this module so that the module can cache data where
  90 appropriate and possibly retire collect scripts in favor of caching that
  91 data in memory.
  92
  93 =head1 CLASS METHODS
  94
  95 =item new(PACKAGE)
  96
  97 Creates a new Lintian::Collect::Source object.  Currently, PACKAGE is
  98 ignored.  Normally, this method should not be called directly, only via
  99 the Lintian::Collect constructor.
 100
 101 =back
 102
 103 =head1 INSTANCE METHODS
 104
 105 In addition to the instance methods listed below, all instance methods
 106 documented in the Lintian::Collect module are also available.
 107
 108 =over 4
 109
 110 =item changelog()
 111
 112 Returns the changelog of the source package as a Parse::DebianChangelog
 113 object, or undef if the changelog is a symlink or doesn't exist.  The
 114 debfiles collection script must have been run to create the changelog
 115 file, which this method expects to find in F<debfiles/changelog>.
 116
 117 =item native()
 118
 119 Returns true if the source package is native and false otherwise.
 120
 121 =back
 122
 123 =head1 AUTHOR
 124
 125 Originally written by Russ Allbery <rra@debian.org> for Lintian.
 126
 127 =head1 SEE ALSO
 128
 129 lintian(1), Lintian::Collect(3)
 130
 131 =cut
 132
 133 1;
 134
 135 # Local Variables:
 136 # indent-tabs-mode: nil
 137 # cperl-indent-level: 4
 138 # End:
 139 # vim: syntax=perl sw=4 sts=4 ts=4 et shiftround