The following commit has been merged in the master branch:
commit 00d84d8544b1f5a374a1dfda53465412dcb1380e
Author: Niels Thykier <[email protected]>
Date: Sun Jul 10 22:37:32 2011 +0200
Created and migrated to $info->debfiles
Also fixed some "Needs-Info" in Lintian::Collect* that was
incorrectly set to "<>" (e.g. fields now comes from coll/fields)
diff --git a/checks/control-file b/checks/control-file
index f87a440..2fdfc26 100644
--- a/checks/control-file
+++ b/checks/control-file
@@ -38,20 +38,23 @@ sub run {
my $pkg = shift;
my $type = shift;
+my $info = shift;
-if (-l 'debfiles/control') {
+my $dcontrol = $info->debfiles('control');
+
+if (-l $dcontrol) {
tag 'debian-control-file-is-a-symlink';
}
# check that control is UTF-8 encoded
-my $line = file_is_encoded_in_non_utf8('debfiles/control', $type, $pkg);
+my $line = file_is_encoded_in_non_utf8($dcontrol, $type, $pkg);
if ($line) {
tag 'debian-control-file-uses-obsolete-national-encoding', "at line $line"
}
# Check that each field is only used once:
my $seen_fields = {};
-open (CONTROL, '<', 'debfiles/control')
+open (CONTROL, '<', $dcontrol)
or fail "Couldn't read debfiles/control: $!";
while (<CONTROL>) {
s/\s*\n$//;
@@ -83,7 +86,7 @@ while (<CONTROL>) {
}
close CONTROL;
-my ($header, @binary_controls) = read_dpkg_control('debfiles/control');
+my ($header, @binary_controls) = read_dpkg_control($dcontrol);
for my $binary_control (@binary_controls) {
tag 'build-info-in-binary-control-file-section', 'Package
'.$binary_control->{'package'}
diff --git a/checks/cruft b/checks/cruft
index 70aec83..556980e 100644
--- a/checks/cruft
+++ b/checks/cruft
@@ -92,7 +92,9 @@ my $pkg = shift;
my $type = shift;
my $info = shift;
-if (-e 'debfiles/files' and not -z 'debfiles/files') {
+my $droot = $info->debfiles;
+
+if (-e "$droot/files" and not -z "$droot/files") {
tag 'debian-files-list-in-source';
}
@@ -119,8 +121,8 @@ my $ltinbd =
$info->relation('build-depends-all')->implies('libtool');
my %warned;
my $format = $info->field('format');
if ($format =~ /^\s*2\.0\s*\z/ or $format =~ /^\s*3\.0\s*\(quilt\)/) {
- my $wanted = sub { check_debfiles($pkg, $info, \%warned) };
- find($wanted, 'debfiles');
+ my $wanted = sub { check_debfiles($pkg, $info, $droot, \%warned) };
+ find($wanted, $droot);
} elsif (not $info->native) {
check_diffstat('diffstat', \%warned);
}
@@ -244,8 +246,8 @@ sub check_diffstat {
# output. Record any files we warn about in $warned so that we don't warn
# again when checking the full unpacked source.
sub check_debfiles {
- my ($pkg, $info, $warned) = @_;
- (my $name = $File::Find::name) =~ s,^(\./)?debfiles/,,;
+ my ($pkg, $info, $droot, $warned) = @_;
+ (my $name = $File::Find::name) =~ s,^$droot/,,;
# Check for unwanted directories and files. This really duplicates the
# find_cruft function and we should find a way to combine them.
diff --git a/checks/debconf b/checks/debconf
index c767ba0..0865f24 100644
--- a/checks/debconf
+++ b/checks/debconf
@@ -75,7 +75,7 @@ if ($type eq 'source') {
push @files, 'templates';
foreach my $file (@files) {
- my $templates_file = "debfiles/$file";
+ my $templates_file = $info->debfiles($file);
my $binary = $file;
$binary =~ s/\.?templates$//;
# Single binary package (so @files contains "templates" and
diff --git a/checks/debhelper b/checks/debhelper
index d522c52..5895422 100644
--- a/checks/debhelper
+++ b/checks/debhelper
@@ -54,6 +54,8 @@ my $pkg = shift;
my $type = shift;
my $info = shift;
+my $droot = $info->debfiles;
+
my $seencommand = '';
my $needbuilddepends = '';
my $needtomodifyscripts = '';
@@ -74,7 +76,7 @@ my $seenmaintscript = 0;
my $bdepends_noarch;
my $bdepends;
-open(RULES, '<', 'debfiles/rules') or fail("cannot read debian/rules: $!");
+open(RULES, '<', "$droot/rules") or fail("cannot read debian/rules: $!");
while (<RULES>) {
if (/^ifn?(?:eq|def)\s/) {
@@ -204,8 +206,8 @@ for my $binpkg (keys %$pkgs) {
my $compatnan = 0;
# Check the compat file. Do this separately from looping over all of the
# other files since we use the compat value when checking for brace expansion.
-if (-f 'debfiles/compat') {
- my $compat_file = slurp_entire_file('debfiles/compat');
+if (-f "$droot/compat") {
+ my $compat_file = slurp_entire_file("$droot/compat");
($compat) = split(/\n/, $compat_file);
$compat =~ s/^\s+$//;
if ($compat) {
@@ -250,7 +252,7 @@ if ($seendhcleank and $level >= 7) {
# Check the files in the debian directory for various debhelper-related
# things.
my @indebfiles = ();
-opendir(DEBIAN, 'debfiles')
+opendir(DEBIAN, $droot)
or fail("Can't open debfiles directory.");
foreach my $file (sort readdir(DEBIAN)) {
if ($file =~ m/^(?:(.*)\.)?(?:post|pre)(?:inst|rm)$/) {
@@ -259,7 +261,7 @@ foreach my $file (sort readdir(DEBIAN)) {
# They need to have #DEBHELPER# in their scripts. Search for scripts
# that look like maintainer scripts and make sure the token is there.
my $binpkg = $1 || '';
- open(IN, '<', "debfiles/$file")
+ open(IN, '<', "$droot/$file")
or fail("Can't open debfiles/$file: $!");
my $seentag = '';
while (<IN>) {
@@ -293,7 +295,7 @@ foreach my $file (sort readdir(DEBIAN)) {
# supported.
if ($filename_configs->known($base)) {
next if $level < 3;
- open (IN, '<', "debfiles/$file")
+ open (IN, '<', "$droot/$file")
or fail("Can't open debfiles/$file: $!");
local $_;
while (<IN>) {
diff --git a/checks/debian-source-dir b/checks/debian-source-dir
index 5a3e442..87fe65e 100644
--- a/checks/debian-source-dir
+++ b/checks/debian-source-dir
@@ -37,8 +37,10 @@ my $pkg = shift;
my $type = shift;
my $info = shift;
-if (-e 'debfiles/source/format') {
- open(FORMAT, '<', 'debfiles/source/format') or
+my $dsrc = $info->debfiles('source');
+
+if (-e "$dsrc/format") {
+ open(FORMAT, '<', "$dsrc/format") or
fail("cannot read debian/source/format: $!");
my $format = <FORMAT>;
chomp $format;
@@ -47,18 +49,19 @@ if (-e 'debfiles/source/format') {
tag 'missing-debian-source-format';
}
-if (-s 'debfiles/source/git-patches') {
- open (GITPATCHES, 'debfiles/source/git-patches')
+if (-s "$dsrc/git-patches") {
+ open (GITPATCHES, "$dsrc/git-patches")
or fail("cannot open debian/source/git-patches: $!");
if (grep !/^\s*+#|^\s*+$/o, <GITPATCHES>) {
- if (! -r "debfiles/patches/series" ) {
- tag "git-patches-not-exported";
+ my $dpseries = $info->debfiles('patches/series');
+ if (! -r $dpseries ) {
+ tag 'git-patches-not-exported';
} else {
- open (DEBSERIES, 'debfiles/patches/series')
+ open (DEBSERIES, $dpseries)
or fail("cannot open debian/patches/series: $!");
my $comment_line = <DEBSERIES>;
my $count = grep !/^\s*+\#|^\s*+$/o, <DEBSERIES>;
- tag "git-patches-not-exported"
+ tag 'git-patches-not-exported'
unless ($count && ($comment_line =~
m/^\s*\#.*quilt-patches-deb-export-hook/o));
close(DEBSERIES);
}
@@ -66,8 +69,8 @@ if (-s 'debfiles/source/git-patches') {
close(GITPATCHES);
}
-if (-d 'debfiles/source') {
- opendir(DEBSRC, 'debfiles/source') or fail("cannot opendir debian/source/:
$!");
+if (-d $dsrc ) {
+ opendir(DEBSRC, $dsrc) or fail("cannot opendir debian/source/: $!");
my $file;
while ($file = readdir(DEBSRC)) {
next if $file eq '.' or $file eq '..';
diff --git a/checks/nmu b/checks/nmu
index 7cd4542..d59c14e 100644
--- a/checks/nmu
+++ b/checks/nmu
@@ -48,8 +48,8 @@ my $changelog_mentions_team_upload = 0;
# This isn't really an NMU check, but right now no other check looks at
# debian/changelog in source packages. Catch a debian/changelog file that's a
# symlink.
-if (-l 'debfiles/changelog') {
- tag 'changelog-is-symlink', '';
+if (-l $info->debfiles('changelog')) {
+ tag 'changelog-is-symlink';
return 0;
}
diff --git a/checks/patch-systems b/checks/patch-systems
index 515561c..3f4100f 100644
--- a/checks/patch-systems
+++ b/checks/patch-systems
@@ -29,10 +29,6 @@ use Cwd qw(realpath);
sub run {
my ($pkg, $type, $info) = @_;
- unless (-d "fields") {
- fail("directory in lintian laboratory for $type package $pkg missing:
fields");
- }
-
#Some (cruft) checks are valid for every patch system, so we need to
record that:
my $uses_patch_system = 0;
@@ -46,17 +42,18 @@ sub run {
}
my $quilt_format = ($format =~ /3\.\d+ \(quilt\)/) ? 1 : 0;
- my $cwd = realpath('.');
+ my $droot = realpath($info->debfiles);
+ my $dpdir = "$droot/patches";
#----- dpatch
if ($build_deps->implies("dpatch")) {
$uses_patch_system++;
#check for a debian/patches file:
- if (! -r "debfiles/patches/00list") {
- tag "dpatch-build-dep-but-no-patch-list";
+ if (! -r "$dpdir/00list") {
+ tag 'dpatch-build-dep-but-no-patch-list';
} else {
my $list_uses_cpp = 0;
- if (open(OPTS, '<', "debfiles/patches/00options")) {
+ if (open(OPTS, '<', "$dpdir/00options")) {
while(<OPTS>) {
if (/DPATCH_OPTION_CPP=1/) {
$list_uses_cpp = 1;
@@ -65,7 +62,7 @@ sub run {
}
close(OPTS);
}
- foreach my $listfile (glob("debfiles/patches/00list*"))
{
+ foreach my $listfile (glob("$dpdir/00list*")) {
my @patches;
if (open(IN, '<', $listfile)) {
while(<IN>) {
@@ -85,17 +82,17 @@ sub run {
# Check each patch.
foreach my $patch_file (@patches) {
- $patch_file .= ".dpatch" if -e
"debfiles/patches/$patch_file.dpatch"
- and not -e
"debfiles/patches/$patch_file";
- next if ( -l
"debfiles/patches/$patch_file" );
- unless
(realpath("debfiles/patches/$patch_file") =~ m,^\Q$cwd\E/debfiles/,) {
+ $patch_file .= '.dpatch' if -e
"$dpdir/$patch_file.dpatch"
+ and not -e "$dpdir/$patch_file";
+ next if ( -l "$dpdir/$patch_file" );
+ unless (realpath("$dpdir/$patch_file")
=~ m,^\Q$droot/,) {
next;
}
- if (! -r
"debfiles/patches/$patch_file") {
- tag
"dpatch-index-references-non-existent-patch", $patch_file;
+ if (! -r "$dpdir/$patch_file") {
+ tag
'dpatch-index-references-non-existent-patch', $patch_file;
next;
}
- if (open(PATCH_FILE, '<',
"debfiles/patches/$patch_file")) {
+ if (open(PATCH_FILE, '<',
"$dpdir/$patch_file")) {
my $has_comment = 0;
while (<PATCH_FILE>) {
#stop if something
looking like a patch starts:
@@ -109,7 +106,7 @@ sub run {
tag
"dpatch-missing-description", $patch_file;
}
}
- check_patch($patch_file);
+ check_patch($dpdir, $patch_file);
}
}
}
@@ -122,10 +119,10 @@ sub run {
tag "unneeded-build-dep-on-quilt";
}
#check for a debian/patches file:
- if (! -r "debfiles/patches/series") {
- tag "quilt-build-dep-but-no-series-file" unless
$quilt_format;
+ if (! -r "$dpdir/series") {
+ tag 'quilt-build-dep-but-no-series-file' unless
$quilt_format;
} else {
- if (open(IN, '<', "debfiles/patches/series")) {
+ if (open(IN, '<', "$dpdir/series")) {
my @patches;
my @badopts;
while(<IN>) {
@@ -147,15 +144,15 @@ sub run {
# Check each patch.
foreach my $patch_file (@patches) {
- next if ( -l
"debfiles/patches/$patch_file" );
- unless
(realpath("debfiles/patches/$patch_file") =~ m,^\Q$cwd\E/debfiles/,) {
+ next if ( -l "$dpdir/$patch_file" );
+ unless (realpath("$dpdir/$patch_file")
=~ m,^\Q$droot\E/,) {
next;
}
- if (! -r
"debfiles/patches/$patch_file") {
- tag
"quilt-series-references-non-existent-patch", $patch_file;
+ if (! -r "$dpdir/$patch_file") {
+ tag
'quilt-series-references-non-existent-patch', $patch_file;
next;
}
- if (open(PATCH_FILE, '<',
"debfiles/patches/$patch_file")) {
+ if (open(PATCH_FILE, '<',
"$dpdir/$patch_file")) {
my $has_description = 0;
while (<PATCH_FILE>) {
# stop if something
looking like a patch starts:
@@ -169,28 +166,28 @@ sub run {
tag
"quilt-patch-missing-description", $patch_file;
}
}
- check_patch($patch_file);
+ check_patch($dpdir, $patch_file);
}
}
}
if ($quilt_format) { # 3.0 (quilt) specific checks
# Format 3.0 packages may generate a
debian-changes-$version patch
my $version = $info->field('version');
- if (-f "debfiles/patches/debian-changes-$version" &&
- ! -f 'debfiles/debian/source/patch-header') {
+ if (-f "$dpdir/debian-changes-$version" &&
+ ! -f "$droot/source/patch-header") {
tag 'format-3.0-but-debian-changes-patch';
}
}
} else {
- if (-r "debfiles/patches/series" and
- -f "debfiles/patches/series") {
+ if (-r "$dpdir/series" and
+ -f "$dpdir/series") {
# 3.0 (quilt) sources don't need quilt as dpkg-source
will do the work
- tag "quilt-series-but-no-build-dep" unless
$quilt_format;
+ tag 'quilt-series-but-no-build-dep' unless
$quilt_format;
}
}
#----- look for README.source
- if ($uses_patch_system && ! $quilt_format && ! -f
'debfiles/README.source') {
+ if ($uses_patch_system && ! $quilt_format && ! -f
"$droot/README.source") {
tag "patch-system-but-no-source-readme";
}
@@ -217,8 +214,8 @@ sub run {
}
# Checks on patches common to all build systems.
-sub check_patch($) {
- my $patch_file = shift;
+sub check_patch {
+ my ($dpdir, $patch_file) = @_;
# Use -p1 to strip off the first layer of directory in case the parent
# directory in which the patches were generated was named "debian".
@@ -226,7 +223,7 @@ sub check_patch($) {
# in the debian/* directory, but as of 2010-01-01, all cases where the
# first level of the patch path is "debian/" in the archive are false
# positives.
- open(DIFFSTAT, "-|", 'diffstat', '-p1', '-l',
"debfiles/patches/$patch_file")
+ open(DIFFSTAT, "-|", 'diffstat', '-p1', '-l', "$dpdir/$patch_file")
or fail("can't fork diffstat");
while (<DIFFSTAT>) {
chomp;
diff --git a/checks/po-debconf b/checks/po-debconf
index efd4504..c22a745 100644
--- a/checks/po-debconf
+++ b/checks/po-debconf
@@ -27,23 +27,25 @@ sub run {
my $pkg = shift;
my $type = shift;
+my $info = shift;
my $full_translation = 0;
+my $debfiles = $info->debfiles;
# First, check wether this package seems to use debconf but not po-debconf.
# Read the templates file and look at the template names it provides, since
# some shared templates aren't translated.
-opendir(DEB, 'debfiles')
+opendir(DEB, $debfiles)
or fail("Can't open debfiles directory.");
my $has_template = my $has_depends = my $has_config = 0;
my @lang_templates;
for my $file (readdir(DEB)) {
- next if -d "debfiles/$file";
+ next if -d "$debfiles/$file";
if ($file =~ m/^(.+\.)?templates(\..+)?$/) {
if ($file =~ m/templates\.\w\w(_\w\w)?$/) {
push (@lang_templates, $file);
} else {
- open(PO, '<', "debfiles/$file")
+ open(PO, '<', "$debfiles/$file")
or fail("Can't open debfiles/$file file.");
my $in_template = 0;
while (<PO>) {
@@ -70,7 +72,7 @@ closedir(DEB);
#TODO: check whether all templates are named in TEMPLATES.pot
if ( $has_template ) {
- if ( ! -d "debfiles/po" ) {
+ if ( ! -d "$debfiles/po" ) {
tag "not-using-po-debconf", "";
return 0;
}
@@ -89,7 +91,7 @@ for (@lang_templates) {
# check).
my $missing_files = 0;
my $yada = 0;
-if (open (RULES, '<', 'debfiles/rules')) {
+if (open (RULES, '<', "$debfiles/rules")) {
local $_;
while (<RULES>) {
if (m%^\t\s*(?:perl debian/)?yada\s%) {
@@ -99,8 +101,8 @@ if (open (RULES, '<', 'debfiles/rules')) {
}
}
-if (!$yada && -f "debfiles/po/POTFILES.in") {
- open(POTFILES, '<', "debfiles/po/POTFILES.in")
+if (!$yada && -f "$debfiles/po/POTFILES.in") {
+ open(POTFILES, '<', "$debfiles/po/POTFILES.in")
or fail("Can't open debfiles/po/POTFILES.in.");
while (<POTFILES>) {
chomp;
@@ -108,7 +110,7 @@ if (!$yada && -f "debfiles/po/POTFILES.in") {
s/.*\]\s*//;
# Cannot check files which are not under debian/
next if m,^\.\./, or $_ eq '';
- unless (-f "debfiles/$_") {
+ unless (-f "$debfiles/$_") {
tag "missing-file-from-potfiles-in", $_;
$missing_files = 1;
}
@@ -118,7 +120,7 @@ if (!$yada && -f "debfiles/po/POTFILES.in") {
tag "missing-potfiles-in", "";
$missing_files = 1;
}
-if (! -f "debfiles/po/templates.pot") {
+if (! -f "$debfiles/po/templates.pot") {
tag "missing-templates-pot", "";
$missing_files = 1;
}
@@ -126,9 +128,9 @@ if (! -f "debfiles/po/templates.pot") {
if (-x "/usr/bin/msgcmp" && -x "/usr/share/intltool-debian/intltool-update" ) {
if ($missing_files == 0) {
$ENV{"INTLTOOL_EXTRACT"} ||=
"/usr/share/intltool-debian/intltool-extract";
- system_env("cd debfiles/po &&
/usr/share/intltool-debian/intltool-update --gettext-package=test --pot");
- system_env("/usr/bin/msgcmp --use-untranslated
debfiles/po/test.pot debfiles/po/templates.pot >/dev/null 2>&1"
- . "&& /usr/bin/msgcmp --use-untranslated
debfiles/po/templates.pot debfiles/po/test.pot >/dev/null 2>&1") == 0
+ system_env("cd \Q$debfiles/po\E &&
/usr/share/intltool-debian/intltool-update --gettext-package=test --pot");
+ system_env("/usr/bin/msgcmp --use-untranslated
\Q$debfiles/po/test.pot\E \Q$debfiles/po/templates.pot\E >/dev/null 2>&1"
+ . "&& /usr/bin/msgcmp --use-untranslated
\Q$debfiles/po/templates.pot\E \Q$debfiles/po/test.pot\E >/dev/null 2>&1") == 0
or tag "newer-debconf-templates";
}
} else {
@@ -138,7 +140,7 @@ if (-x "/usr/bin/msgcmp" && -x
"/usr/share/intltool-debian/intltool-update" ) {
if (! -x "/usr/bin/msgfmt" ) {
fail("msgfmt not found");
}
-opendir(DEBIAN, 'debfiles/po')
+opendir(DEBIAN, "$debfiles/po")
or fail("Can't open debfiles/po directory.");
while (defined(my $file=readdir(DEBIAN))) {
next unless $file =~ m/\.po$/;
@@ -146,7 +148,7 @@ while (defined(my $file=readdir(DEBIAN))) {
unless ($file =~ /^[a-z]{2,3}(_[A-Z]{2})?\.po$/);
local ($/) = "\n\n";
$_ = '';
- open(PO, '<', "debfiles/po/$file")
+ open(PO, '<', "$debfiles/po/$file")
or fail("Can't open debfiles/po/$file file.");
while (<PO>) {
last if m/^msgstr/m;
@@ -163,10 +165,10 @@ while (defined(my $file=readdir(DEBIAN))) {
}
tag "unknown-encoding-in-po-file", "debian/po/$file"
unless length($charset);
- system_env("msgfmt -o /dev/null \Qdebfiles/po/$file\E 2>/dev/null") == 0
+ system_env("msgfmt -o /dev/null \Q$debfiles/po/$file\E 2>/dev/null") == 0
or tag "invalid-po-file", "debian/po/$file";
- my $stats = `LANG=C msgfmt -o /dev/null --statistics
\Qdebfiles/po/$file\E 2>&1`;
+ my $stats = `LANG=C msgfmt -o /dev/null --statistics
\Q$debfiles/po/$file\E 2>&1`;
if (!$full_translation && $stats =~ m/^\w+ \w+ \w+\.$/) {
$full_translation = 1;
}
diff --git a/checks/rules b/checks/rules
index afbd0ac..19476ff 100644
--- a/checks/rules
+++ b/checks/rules
@@ -111,23 +111,20 @@ my $pkg = shift;
my $type = shift;
my $info = shift;
+my $rules = $info->debfiles('rules');
+
# Policy could be read as allowing debian/rules to be a symlink to some other
# file, and in a native Debian package it could be a symlink to a file that we
# didn't unpack. Warn if it's a symlink (dpkg-source does as well) and skip
# all the tests if we then can't read it.
-if (-l 'debfiles/rules') {
+if (-l $rules) {
tag 'debian-rules-is-symlink';
- return 0 unless -f 'debfiles/rules';
-}
-
-#get architecture field:
-unless (-d 'fields') {
- fail("directory in lintian laboratory for $type package $pkg missing:
fields");
+ return 0 unless -f $rules;
}
my $architecture = $info->field('architecture') || '';
-open(RULES, '<', 'debfiles/rules') or fail("Failed opening rules: $!");
+open(RULES, '<', $rules) or fail("Failed opening rules: $!");
# Check for required #!/usr/bin/make -f opening line. Allow -r or -e; a
# strict reading of Policy doesn't allow either, but they seem harmless.
diff --git a/checks/watch-file b/checks/watch-file
index 70b421b..cf6be8c 100644
--- a/checks/watch-file
+++ b/checks/watch-file
@@ -34,8 +34,9 @@ my $type = shift;
my $info = shift;
my $template = 0;
+my $wfile = $info->debfiles('watch');
-if (! -f 'debfiles/watch') {
+if (! -f $wfile) {
tag 'debian-watch-file-is-missing' unless ($info->native);
return;
}
@@ -57,7 +58,7 @@ if ($version =~ /(alpha|beta|rc)/i) {
# Gather information from the watch file and look for problems we can
# diagnose on the first time through.
-open(WATCH, '<', 'debfiles/watch') or fail("cannot open watch file: $!");
+open(WATCH, '<', $wfile) or fail("cannot open watch file: $!");
local $_;
my ($watchver, %dversions);
while (<WATCH>) {
diff --git a/lib/Lintian/Collect.pm b/lib/Lintian/Collect.pm
index 94e4992..faed3d3 100644
--- a/lib/Lintian/Collect.pm
+++ b/lib/Lintian/Collect.pm
@@ -72,7 +72,7 @@ sub base_dir {
# packages, this is the *.dsc file; for binary packages, this is the control
# file in the control section of the package. For .changes files, the
# information will be retrieved from the file itself.
-# sub field Needs-Info <>
+# sub field Needs-Info fields
sub field {
my ($self, $field) = @_;
return $self->{field}{$field} if exists $self->{field}{$field};
diff --git a/lib/Lintian/Collect/Package.pm b/lib/Lintian/Collect/Package.pm
index 19f77a1..1a0ae54 100644
--- a/lib/Lintian/Collect/Package.pm
+++ b/lib/Lintian/Collect/Package.pm
@@ -32,19 +32,7 @@ use Util qw(perm2oct);
# sub unpacked Needs-Info unpacked
sub unpacked {
my ($self, $file) = @_;
- my $unpacked = $self->{unpacked};
- if ( not defined $unpacked ) {
- my $base_dir = $self->base_dir;
- $unpacked = "$base_dir/unpacked";
- croak "Unpacked not available" unless defined $unpacked && -d
"$unpacked/";
- $self->{unpacked} = $unpacked;
- }
- if ($file) {
- # strip leading ./ - if that leaves something, return the path there
- $file =~ s,^\.?/*+,,go;
- return "$unpacked/$file" if $file;
- }
- return $unpacked;
+ return $self->_fetch_extracted_dir('unpacked', 'unpacked', $file);
}
# Returns the information from collect/file-info
@@ -147,6 +135,27 @@ sub sorted_index {
+# Backing method for unpacked, debfiles and others; this is not a part of the
+# API.
+# sub _fetch_extracted_dir Needs-Info <>
+sub _fetch_extracted_dir {
+ my ($self, $field, $dirname, $file) = @_;
+ my $dir = $self->{$field};
+ if ( not defined $dir ) {
+ my $base_dir = $self->base_dir;
+ $dir = "$base_dir/$dirname";
+ croak "$field ($dirname) is not available" unless -d "$dir/";
+ $self->{$field} = $dir;
+ }
+ if ($file) {
+ # strip leading ./ - if that leaves something, return the path there
+ $file =~ s,^\.?/*+,,go;
+ return "$dir/$file" if $file;
+ }
+ return $dir;
+}
+
+
1;
=head1 NAME
diff --git a/lib/Lintian/Collect/Source.pm b/lib/Lintian/Collect/Source.pm
index ab48a93..93ea78d 100644
--- a/lib/Lintian/Collect/Source.pm
+++ b/lib/Lintian/Collect/Source.pm
@@ -157,7 +157,7 @@ sub binary_relation {
# following special field names are supported: build-depends-all
# (build-depends and build-depends-indep) and build-conflicts-all
# (build-conflicts and build-conflicts-indep).
-# sub relation Needs-Info <>
+# sub relation Needs-Info fields
sub relation {
my ($self, $field) = @_;
$field = lc $field;
@@ -186,7 +186,7 @@ sub relation {
# Similar to relation(), return a Lintian::Relation object for the given build
# relationship field, but ignore architecture restrictions. It supports the
# same special field names.
-# sub relation_noarch Needs-Info <>
+# sub relation_noarch Needs-Info fields
sub relation_noarch {
my ($self, $field) = @_;
$field = lc $field;
@@ -214,6 +214,15 @@ sub relation_noarch {
return $self->{relation_noarch}->{$field};
}
+# Like unpacked except this only contains the contents of debian/ from a source
+# package.
+#
+# sub debfiles Needs-Info debfiles
+sub debfiles {
+ my ($self, $file) = @_;
+ return $self->_fetch_extracted_dir('debfiles', 'debfiles', $file);
+}
+
=head1 NAME
Lintian::Collect::Source - Lintian interface to source package data collection
--
Debian package checker
--
To UNSUBSCRIBE, email to [email protected]
with a subject of "unsubscribe". Trouble? Contact [email protected]
Archive: http://lists.debian.org/[email protected]
