[SCM] Debian package checker branch, master, updated. 2.5.10-49-gcb2eb24
The following commit has been merged in the master branch:
commit cb2eb249f53141d0c090523f496774d9cecc9ead
Author: Niels Thykier <niels@thykier.net>
Date: Mon Jul 16 16:49:23 2012 +0200
L::C::Package: Alter the API of index(-like) methods
Make index (and control_index) take an extra parameter, which is the
file to access. Furthermore, they no longer return a hashref (even if
the file parameter is not given).
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/checks/apache2 b/checks/apache2
index 759c13c..103f2d1 100644
--- a/checks/apache2
+++ b/checks/apache2
@@ -45,7 +45,7 @@ sub run {
if ($type eq 'binary') {
foreach my $file ($info->sorted_index) {
next if $file eq '';
- my $index_info = $info->index->{$file};
+ my $index_info = $info->index ($file);
# File is probably not relevant to us, ignore it
next if $index_info->is_dir;
@@ -120,7 +120,7 @@ sub check_web_application_package {
tag 'web-application-should-not-depend-unconditionally-on-apache2';
}
- if (defined $info->index->{$file}) {
+ if (defined $info->index ($file)) {
inspect_conf_file ($info, $pkgtype, $file);
}
@@ -163,13 +163,13 @@ sub check_module_package {
$load_file =~ s#^mod.(.*)$#etc/apache2/mods-available/$1.load#;
$conf_file =~ s#^mod.(.*)$#etc/apache2/mods-available/$1.conf#;
- if (defined $info->index->{$load_file}) {
+ if (defined $info->index ($load_file)) {
inspect_conf_file ($info, "mods", $load_file);
} else {
tag 'apache2-module-does-not-ship-load-file', $load_file;
}
- if (defined $info->index->{$conf_file}) {
+ if (defined $info->index ($conf_file)) {
inspect_conf_file ($info, "mods", $conf_file);
}
diff --git a/checks/binaries b/checks/binaries
index 051d24f..c5f58b1 100644
--- a/checks/binaries
+++ b/checks/binaries
@@ -201,7 +201,7 @@ foreach ($info->sorted_index) {
# create copy, don't modify the index
my $path = $_;
- my $index_info = $info->index->{$path};
+ my $index_info = $info->index ($path);
next unless $index_info->is_dir || $index_info->is_symlink;
$path =~ s,/\z,,;
$directories{"/$path"}++;
diff --git a/checks/changelog-file b/checks/changelog-file
index 718e3d8..7dc5b16 100644
--- a/checks/changelog-file
+++ b/checks/changelog-file
@@ -46,8 +46,8 @@ my @doc_files;
my %file_info;
# skip packages which have a /usr/share/doc/$pkg -> foo symlink
-return 0 if $info->index->{"usr/share/doc/$pkg"} and
- $info->index->{"usr/share/doc/$pkg"}->is_symlink;
+return 0 if $info->index ("usr/share/doc/$pkg") and
+ $info->index ("usr/share/doc/$pkg")->is_symlink;
# Modify the file_info by following symbolic links.
@@ -118,7 +118,7 @@ foreach ($info->sorted_index) {
}
}
if (not $max_compressed and $file_info{$file1} =~ m/gzip compressed/) {
- if (!$info->index->{$file1}->is_symlink) {
+ if (!$info->index ($file1)->is_symlink) {
tag 'changelog-not-compressed-with-max-compression', $file;
}
}
diff --git a/checks/conffiles b/checks/conffiles
index d669f35..6f99fb9 100644
--- a/checks/conffiles
+++ b/checks/conffiles
@@ -75,7 +75,7 @@ if (-f $cf) {
# Read package contents...
foreach my $file ($info->sorted_index) {
- my $index_info = $info->index->{$file};
+ my $index_info = $info->index ($file);
next unless $file =~ m,^etc, and $index_info->is_file;
# If there is a /etc/foo, it must be a conffile (with a few exceptions).
diff --git a/checks/control-files b/checks/control-files
index b86b6a7..98227d4 100644
--- a/checks/control-files
+++ b/checks/control-files
@@ -42,10 +42,9 @@ my $ctrl = $type eq 'udeb' ? $UDEB_PERMISSIONS : $DEB_PERMISSIONS;
my $ctrl_alt = $type eq 'udeb' ? $DEB_PERMISSIONS : $UDEB_PERMISSIONS;
# process control-index file
-my $cindex = $info->control_index;
-foreach my $file (sort keys %$cindex) {
+foreach my $file ($info->sorted_control_index) {
next unless $file;
- my $cindex_info = $cindex->{$file};
+ my $cindex_info = $info->control_index ($file);
my $owner;
my $operm;
my $experm;
diff --git a/checks/copyright-file b/checks/copyright-file
index 627a1fd..5ad1036 100644
--- a/checks/copyright-file
+++ b/checks/copyright-file
@@ -43,13 +43,13 @@ my $found = 0;
my $linked = 0;
my $path = "usr/share/doc/$pkg";
-if (exists $info->index->{"$path/copyright.gz"}) {
+if ($info->index ("$path/copyright.gz")) {
tag 'copyright-file-compressed';
$found = 1;
}
-if (exists $info->index->{"$path/copyright"}) {
- my $index_info = $info->index->{"$path/copyright"};
+if ($info->index ("$path/copyright")) {
+ my $index_info = $info->index ("$path/copyright");
$found = 1;
if ($index_info->is_symlink) {
tag 'copyright-file-is-symlink';
@@ -60,7 +60,7 @@ if (exists $info->index->{"$path/copyright"}) {
}
if (not $found) {
- my $index_info = $info->index->{$path};
+ my $index_info = $info->index ($path);
if (defined $index_info && $index_info->is_symlink) {
my $link = $index_info->link;
diff --git a/checks/duplicate-files b/checks/duplicate-files
index 5df3910..6810d14 100644
--- a/checks/duplicate-files
+++ b/checks/duplicate-files
@@ -36,11 +36,11 @@ foreach my $file ($info->sorted_index){
my $md5 = $info->md5sums->{$file};
my $fs;
next unless defined $md5;
- next unless $info->index->{$file}->is_regular_file;
+ next unless $info->index ($file)->is_regular_file;
# Ignore empty files; in some cases (e.g. python) a file is
# required even if it is empty and we are never looking at a
# substantial gain in such a case. Also see #632789
- next unless $info->index->{$file}->size;
+ next unless $info->index ($file)->size;
next unless $file =~ m@usr/share/doc/@o;
$fs = $hashmap{$md5};
unless (defined $fs){
diff --git a/checks/fields b/checks/fields
index 69bb103..d860e13 100644
--- a/checks/fields
+++ b/checks/fields
@@ -522,7 +522,7 @@ my $metapackage = 0;
if ($type eq 'binary') {
$metapackage = 1;
for my $file ($info->sorted_index) {
- next if $info->index->{$file}->is_dir;
+ next if $info->index ($file)->is_dir;
next if $file =~ m%^usr/share/doc/%;
next if $file =~ m%^usr/share/lintian/overrides/%;
next if $file =~ m%^usr/share/cdd/%;
diff --git a/checks/files b/checks/files
index 87b0824..8e59f6e 100644
--- a/checks/files
+++ b/checks/files
@@ -262,7 +262,7 @@ if (!$is_dummy) {
# Read package contents...
foreach my $file ($info->sorted_index) {
next if $file eq '';
- my $index_info = $info->index->{$file};
+ my $index_info = $info->index ($file);
my $owner = $index_info->owner . '/' . $index_info->group;
my $operm = $index_info->operm;
my $link = $index_info->link;
@@ -1387,7 +1387,7 @@ if ($pkg_section !~ m,games$, and $games > 0 and $other == 0) {
# python-support needs a directory for each package even it might be empty
if($pkg ne 'base-files'){
foreach my $dir ($info->sorted_index) {
- next if $dir eq '' or not $info->index->{$dir}->is_dir;
+ next if $dir eq '' or not $info->index ($dir)->is_dir;
next if ($dir =~ m{^var/} or $dir =~ m{^etc/});
if (dir_counts($info, $dir) == 0) {
if ($dir ne 'usr/lib/perl5/'
@@ -1432,8 +1432,8 @@ if ($x11_font_dirs{misc} and keys (%x11_font_dirs) > 1) {
sub dir_counts {
my ($info, $dir) = @_;
- if (defined $info->index->{$dir}) {
- return scalar $info->index->{$dir}->children;
+ if (defined $info->index ($dir)) {
+ return scalar $info->index ($dir)->children;
} else {
return 0;
}
diff --git a/checks/group-checks b/checks/group-checks
index b90ce66..576b263 100644
--- a/checks/group-checks
+++ b/checks/group-checks
@@ -134,7 +134,6 @@ sub _check_file_overlap {
sub _overlap_check {
my ($a_proc, $a_info, $b_proc, $b_info) = @_;
- my $b_index = $b_info->index;
foreach my $raw ($a_info->sorted_index) {
my $file;
my $a_file;
@@ -142,9 +141,9 @@ sub _overlap_check {
next unless $raw;
$file = $raw; # copy, because we have to modifiy it
$file =~ s,/$,,o;
- $b_file = $b_index->{$file} // $b_index->{"$file/"};
+ $b_file = $b_info->index ($file) // $b_info->index ("$file/");
if ($b_file) {
- $a_file = $a_info->index->{$file} // $a_info->index->{"$file/"};
+ $a_file = $a_info->index ($file) // $a_info->index ("$file/");
next if $a_file->is_dir and $b_file->is_dir;
tag 'binaries-have-file-conflict', $a_proc->pkg_name, $b_proc->pkg_name, $file;
}
diff --git a/checks/huge-usr-share b/checks/huge-usr-share
index ed56e17..7f79b13 100644
--- a/checks/huge-usr-share
+++ b/checks/huge-usr-share
@@ -43,10 +43,10 @@ return 0 if $arch eq 'all';
# Add up the space taken by the package and the space taken by just the files
# in /usr/share. Convert the totals to kilobytes.
my ($size, $size_usrshare) = (0, 0);
-for my $file (keys %{ $info->index }) {
- $size += $info->index->{$file}->size;
+for my $file ($info->sorted_index) {
+ $size += $info->index ($file)->size;
if ($file =~ m,usr/share/,) {
- $size_usrshare += $info->index->{$file}->size;
+ $size_usrshare += $info->index ($file)->size;
}
}
$size = int ($size / 1024);
diff --git a/checks/infofiles b/checks/infofiles
index 5a1a254..8dc32b8 100644
--- a/checks/infofiles
+++ b/checks/infofiles
@@ -36,7 +36,7 @@ my $info = shift;
# Read package contents...
foreach my $file ($info->sorted_index) {
- my $index_info = $info->index->{$file};
+ my $index_info = $info->index ($file);
my $file_info = $info->file_info->{$file};
my $link = $index_info->link || '';
my ($fname, $path) = fileparse($file);
diff --git a/checks/java b/checks/java
index 054d103..f86be3d 100644
--- a/checks/java
+++ b/checks/java
@@ -53,7 +53,7 @@ $need_cp = 1 if @java_lib_depends;
for my $jar_file (sort keys %{$java_info}) {
my $files = $java_info->{$jar_file}->{files};
my $manifest = $java_info->{$jar_file}->{manifest};
- my $operm = $info->index->{$jar_file}->operm;
+ my $operm = $info->index ($jar_file)->operm;
my $jar_dir;
my $classes = 0;
my $datafiles = 1;
diff --git a/checks/manpages b/checks/manpages
index 3b6fd90..98377b9 100644
--- a/checks/manpages
+++ b/checks/manpages
@@ -46,7 +46,7 @@ my %manpage;
# Read package contents...
foreach my $file ($info->sorted_index) {
- my $index_info = $info->index->{$file};
+ my $index_info = $info->index ($file);
my $file_info = $info->file_info->{$file};
my $link = $index_info->link || '';
my ($fname, $path, $suffix) = fileparse($file);
@@ -355,7 +355,7 @@ foreach my $depproc (@{ $ginfo->direct_dependencies ($proc) }) {
my $depinfo = $depproc->info();
foreach my $file ($depinfo->sorted_index){
next if $file eq '';
- my $index_info = $depinfo->index->{$file};
+ my $index_info = $depinfo->index ($file);
my ($fname, $path, $suffix) = fileparse($file, qr,\..+$,o);
my $lang = '';
next unless ($index_info->is_file or $index_info->is_symlink) and
diff --git a/checks/md5sums b/checks/md5sums
index b132bc5..9cddaff 100644
--- a/checks/md5sums
+++ b/checks/md5sums
@@ -62,7 +62,7 @@ unless (-f $control) {
my $only_conffiles = 1;
foreach my $file ($info->sorted_index) {
# Skip non-files, they will not appear in the md5sums file
- next unless $info->index->{$file}->is_regular_file;
+ next unless $info->index ($file)->is_regular_file;
unless ($conffile{$file}) {
$only_conffiles = 0;
last;
diff --git a/checks/menu-format b/checks/menu-format
index 5c3df12..e142fcb 100644
--- a/checks/menu-format
+++ b/checks/menu-format
@@ -343,7 +343,7 @@ closedir MENUDIR;
# Find the desktop files in the package for verification.
my @desktop_files;
foreach my $file ($info->sorted_index) {
- my $index_info = $info->index->{$file};
+ my $index_info = $info->index ($file);
my $operm = $index_info->operm;
tag 'deprecated-kdelnk-file', $file if ($file =~ m,\.kdelnk$,);
@@ -880,10 +880,10 @@ sub VerifyCmd {
}
my $okay = $cmd
&& ($cmd =~ /^[\'\"]/
- || $info->index->{$cmd_file}
+ || $info->index ($cmd_file)
|| $cmd =~ m,^(/bin/)?sh,
|| $cmd =~ m,^(/usr/bin/)?sensible-(pager|editor|browser),
- || grep { $info->index->{$_ . $cmd} } @path);
+ || grep { $info->index ($_ . $cmd) } @path);
return ($okay, $cmd_file);
}
diff --git a/checks/menus b/checks/menus
index af093b2..6a9c85c 100644
--- a/checks/menus
+++ b/checks/menus
@@ -88,7 +88,7 @@ for my $file ($info->sorted_index) {
next if $file eq '';
add_file_link_info ($info, $file, \%all_files, \%all_links);
- my $index_info = $info->index->{$file};
+ my $index_info = $info->index ($file);
my $operm = $index_info->operm;
if ($index_info->is_file) { # file checks
@@ -499,8 +499,8 @@ sub check_doc_base_file_section {
# links have to include a leading /.
sub add_file_link_info {
my ($info, $file, $all_files, $all_links) = @_;
- my $link = $info->index->{$file}->link;
- my $ishard = $info->index->{$file}->is_hardlink;
+ my $link = $info->index ($file)->link;
+ my $ishard = $info->index ($file)->is_hardlink;
$file = "/" . $file if (not $file =~ m%^/%); # make file absolute
$file =~ s%/+%/%g; # remove duplicated `/'
diff --git a/checks/scripts b/checks/scripts
index 3f7c203..3e4be62 100644
--- a/checks/scripts
+++ b/checks/scripts
@@ -206,7 +206,7 @@ foreach my $file ($info->sorted_index) {
next if $file eq '';
$ELF{$file} = 1 if $info->file_info->{$file} =~ /^[^,]*\bELF\b/o;
- my $index_info = $info->index->{$file};
+ my $index_info = $info->index ($file);
my $operm = $index_info->operm;
next unless $index_info->is_file and ($operm & 0111);
$executable{$file} = 1;
@@ -333,7 +333,7 @@ for my $filename (sort keys %{$info->scripts}) {
# Check if the package ships the interpreter (and it is
# executable).
my $interfile = substr $interpreter, 1;
- my $index_info = $info->index->{$interfile};
+ my $index_info = $info->index ($interfile);
$pinter = 1 if $index_info && ($index_info->operm & 0111);
}
script_tag('unusual-interpreter', $filename, "#!$interpreter")
@@ -976,7 +976,7 @@ for my $divert (keys %added_diversions) {
unless (grep { $_ =~ m/$divertrx/ } $info->sorted_index);
} else {
tag 'diversion-for-unknown-file', $divert, "$script:$line"
- unless (exists $info->index->{$divert});
+ unless $info->index ($divert);
}
}
diff --git a/checks/shared-libs b/checks/shared-libs
index f2209c0..75edab5 100644
--- a/checks/shared-libs
+++ b/checks/shared-libs
@@ -98,7 +98,7 @@ if (%SONAME) {
for my $cur_file ($info->sorted_index) {
# shared library?
- my $cur_file_data = $info->index->{$cur_file};
+ my $cur_file_data = $info->index ($cur_file);
if (exists $SONAME{$cur_file} or
(defined $cur_file_data->link and exists $SONAME{abs_path(dirname($cur_file).'/'.$cur_file_data->link)})) {
@@ -196,7 +196,7 @@ close(IN);
# 3rd step: check if shlib symlinks are present and in correct order
for my $shlib_file (keys %SONAME) {
# file found?
- if (not exists $info->index->{$shlib_file}) {
+ if (not $info->index ($shlib_file)) {
fail("shlib $shlib_file not found in package (should not happen!)");
}
@@ -207,7 +207,7 @@ for my $shlib_file (keys %SONAME) {
# symlink found?
my $link_file = "$dir/$SONAME{$shlib_file}";
- if (not exists $info->index->{$link_file}) {
+ if (not $info->index ($link_file)) {
tag 'ldconfig-symlink-missing-for-shlib', "$link_file $shlib_file $SONAME{$shlib_file}";
} else {
# $link_file really another file?
@@ -215,15 +215,15 @@ for my $shlib_file (keys %SONAME) {
# the library file uses its SONAME, this is ok...
} else {
# $link_file really a symlink?
- if ($info->index->{$link_file}->is_symlink) {
+ if ($info->index ($link_file)->is_symlink) {
# yes.
# $link_file pointing to correct file?
- if ($info->index->{$link_file}->link eq $shlib_name) {
+ if ($info->index ($link_file)->link eq $shlib_name) {
# ok.
} else {
tag 'ldconfig-symlink-referencing-wrong-file',
- "$link_file -> " . $info->index->{$link_file}->link . " instead of $shlib_name";
+ "$link_file -> " . $info->index ($link_file)->link . " instead of $shlib_name";
}
} else {
tag 'ldconfig-symlink-is-not-a-symlink', "$shlib_file $link_file";
@@ -239,7 +239,7 @@ for my $shlib_file (keys %SONAME) {
# shlib symlink may not exist.
# if shlib doesn't _have_ a version, then $link_file and $shlib_file will
# be equal, and it's not a development link, so don't complain.
- if (exists $info->index->{$link_file} and $link_file ne $shlib_file) {
+ if ($info->index ($link_file) and $link_file ne $shlib_file) {
tag 'non-dev-pkg-with-shlib-symlink', "$shlib_file $link_file";
} elsif (@devpkgs) {
# -dev package - it needs a shlib symlink
@@ -250,7 +250,7 @@ for my $shlib_file (keys %SONAME) {
$link_file = "usr/$link_file" unless $shlib_file =~ m,^usr/,;
foreach my $devpkg (@devpkgs) {
- if (exists $devpkg->info->index->{$link_file}) {
+ if ($devpkg->info->index ($link_file)) {
$ok = 1;
last;
}
diff --git a/checks/symlinks b/checks/symlinks
index 37a043a..7279c47 100644
--- a/checks/symlinks
+++ b/checks/symlinks
@@ -34,12 +34,11 @@ my $proc = shift;
my $group = shift;
my $ginfo = $group->info;
-my $index = $info->index;
my @brokenlinks;
my @dindexes;
foreach my $file ($info->sorted_index) {
- my $index_info = $index->{$file};
+ my $index_info = $info->index ($file);
if ($index_info->is_symlink){
my $target = $index_info->link//''; # the link target
my $path; # the target (from the pkg root)
@@ -53,7 +52,7 @@ foreach my $file ($info->sorted_index) {
next unless $path;
# Check if the destination is in the package itself
- next if $index->{$path} || $index->{"$path/"};
+ next if $info->index ($path) || $info->index ("$path/");
$target =~ s,^/++,,o; # strip leading slashes (for reporting)
@@ -77,7 +76,7 @@ foreach my $file ($info->sorted_index) {
}
# Possibly broken symlink
- push @brokenlinks, [$file, $path, $target] unless $index->{$path};
+ push @brokenlinks, [$file, $path, $target] unless $info->index ($path);
}
}
@@ -86,15 +85,15 @@ return unless @brokenlinks;
# Check our dependencies:
foreach my $depproc (@{ $ginfo->direct_dependencies ($proc)}) {
- push @dindexes, $depproc->info->index;
+ push @dindexes, $depproc->info;
}
BLINK:
foreach my $blink (@brokenlinks){
my ($file, $path, $target) = @$blink;
- foreach my $dindex (@dindexes){
+ foreach my $dinfo (@dindexes){
# Is it in our dependency?
- next BLINK if $dindex->{$path} || $dindex->{"$path/"};
+ next BLINK if $dinfo->index ($path) || $dinfo->index ("$path/");
}
# nope - not found in any of our direct dependencies.
tag 'package-contains-broken-symlink', $file, $target
diff --git a/collection/hardening-info b/collection/hardening-info
index d7ece8b..1c926a9 100755
--- a/collection/hardening-info
+++ b/collection/hardening-info
@@ -63,7 +63,7 @@ $opts{pipe_in}->blocking(1);
foreach my $bin ($info->sorted_index) {
- next unless $info->index->{$bin}->is_file;
+ next unless $info->index ($bin)->is_file;
# Skip kernel modules - most of the checks do not apply to the
# kernel.
next if $bin =~ m/\.ko/o;
diff --git a/collection/java-info b/collection/java-info
index 31c29ca..b96e7f6 100755
--- a/collection/java-info
+++ b/collection/java-info
@@ -53,7 +53,7 @@ chdir ("$dir/unpacked")
or fail "unable to chdir to unpacked: $!";
foreach my $file ($info->sorted_index) {
- my $ftype = $info->index->{$file};
+ my $ftype = $info->index ($file);
next unless $ftype->is_file;
next unless $info->file_info->{$file} =~ m/Zip archive/o;
if ($file =~ m#\S+\.jar$#i) {
diff --git a/collection/md5sums b/collection/md5sums
index 262c5d6..97b1472 100755
--- a/collection/md5sums
+++ b/collection/md5sums
@@ -48,7 +48,7 @@ $opts{pipe_in}->blocking(1);
foreach my $file ($info->sorted_index) {
next unless $file;
- next unless $info->index->{$file}->{type} =~ m/^[-h]/;
+ next unless $info->index ($file)->is_file;
printf {$opts{pipe_in}} "%s\0", $file;
}
diff --git a/collection/scripts b/collection/scripts
index 7a7abd4..d78c657 100755
--- a/collection/scripts
+++ b/collection/scripts
@@ -36,7 +36,7 @@ my $magic;
my $scriptpath;
foreach my $file ($info->sorted_index) {
- next unless $info->index->{$file}->{type} eq '-';
+ next unless $info->index ($file)->is_regular_file;
# This used to call fail() instead of next. However, the check to
# see if all files in the index can be opened should be done elsewhere.
diff --git a/lib/Lintian/Collect/Binary.pm b/lib/Lintian/Collect/Binary.pm
index 865e25c..3f40008 100644
--- a/lib/Lintian/Collect/Binary.pm
+++ b/lib/Lintian/Collect/Binary.pm
@@ -86,8 +86,21 @@ sub control {
#
# sub control_index Needs-Info bin-pkg-control
sub control_index {
+ my ($self, $file) = @_;
+ return $self->_fetch_index_data ('control-index', 'control-index',
+ undef, $file);
+}
+
+# Like sorted_index except it returns the index for the control/metadata of
+# binary package.
+#
+# sub sorted_control_index Needs-Info bin-pkg-control
+sub sorted_control_index {
my ($self) = @_;
- return $self->_fetch_index_data('control-index', 'control-index');
+ # control_index does all our work for us, so call it if
+ # sorted_control_index has not been created yet.
+ $self->control_index ('') unless exists $self->{'sorted_control-index'};
+ return @{ $self->{'sorted_control-index'} };
}
# Returns a handle with the strings in a given binary file (as computed
diff --git a/lib/Lintian/Collect/Package.pm b/lib/Lintian/Collect/Package.pm
index 2810f82..24d809e 100644
--- a/lib/Lintian/Collect/Package.pm
+++ b/lib/Lintian/Collect/Package.pm
@@ -66,8 +66,8 @@ sub file_info {
# Returns the information from the indices
# sub index Needs-Info index
sub index {
- my ($self) = @_;
- return $self->_fetch_index_data('index', 'index', 'index-owner-id');
+ my ($self, $file) = @_;
+ return $self->_fetch_index_data('index', 'index', 'index-owner-id', $file);
}
# Returns sorted file index (eqv to sort keys %{$info->index}), except it is cached.
@@ -76,7 +76,7 @@ sub sorted_index {
my ($self) = @_;
# index does all our work for us, so call it if sorted_index has
# not been created yet.
- $self->index unless exists $self->{sorted_index};
+ $self->index ('') unless exists $self->{sorted_index};
return @{ $self->{sorted_index} };
}
@@ -115,9 +115,13 @@ sub _dequote_name {
# Backing method for index and others; this is not a part of the API.
# sub _fetch_index_data Needs-Info <>
sub _fetch_index_data {
- my ($self, $field, $index, $indexown) = @_;
- return $self->{$field} if exists $self->{$index};
- my $base_dir = $self->base_dir();
+ my ($self, $field, $index, $indexown, $file) = @_;
+ if (exists $self->{$index}) {
+ return $self->{$field}->{$file}
+ if exists $self->{$index}->{$file};
+ return;
+ }
+ my $base_dir = $self->base_dir;
my (%idxh, %children);
my $num_idx;
my %rhlinks;
@@ -236,7 +240,8 @@ sub _fetch_index_data {
$self->{"sorted_$field"} = \@sorted;
close $idx;
close $num_idx if $num_idx;
- return $self->{$field};
+ return $self->{$field}->{$file} if $self->{$field}->{$file};
+ return;
}
1;
@@ -318,9 +323,10 @@ Returns a hashref mapping file names to the output of file for that file.
Note the file names do not have any leading "./" nor "/".
-=item index
+=item index (FILE)
-Returns a hashref to the index information (Lintian::Path objects).
+Looks up FILE in the package index and returns a L<Lintian::Path>
+for it or C<undef> (if FILE is not in the index).
Note the file names do not have any leading "./" nor "/".
diff --git a/lib/Lintian/Collect/Source.pm b/lib/Lintian/Collect/Source.pm
index 4277e93..2b0fd74 100644
--- a/lib/Lintian/Collect/Source.pm
+++ b/lib/Lintian/Collect/Source.pm
@@ -310,8 +310,8 @@ sub debfiles {
#
# sub index Needs-Info index
sub index {
- my ($self) = @_;
- return $self->_fetch_index_data('index', 'index', undef);
+ my ($self, $file) = @_;
+ return $self->_fetch_index_data('index', 'index', undef, $file);
}
=head1 NAME
--
Debian package checker
Reply to: