[SCM] Debian package checker branch, master, updated. 2.5.0-rc2-122-g12888e8

["Niels Thykier" <niels@thykier.net>]

The following commit has been merged in the master branch:
commit 008dc1958d337934fb40a32bbba8877ac6ba340c
Author: Niels Thykier <niels@thykier.net>
Date:   Sat Apr 2 13:50:00 2011 +0200

    Made Collect->new require a $base_dir argument
    
    This is needed for making the Lintian::Collect objects able to
    look up their data regardless of which package is being checked.
    Currently only Lintian::Collect::Binary and Lintian::Collect is
    updated.

diff --git a/lib/Lintian/Collect.pm b/lib/Lintian/Collect.pm
index 0638ff0..94e4992 100644
--- a/lib/Lintian/Collect.pm
+++ b/lib/Lintian/Collect.pm
@@ -26,7 +26,7 @@ use Util qw(fail);
 # based on the package type, and return it.  fail with unknown types,
 # since we do not check in other packes if this returns a value.
 sub new {
-    my ($class, $pkg, $type) = @_;
+    my ($class, $pkg, $type, $base_dir) = @_;
     my $object;
     if ($type eq 'source') {
         require Lintian::Collect::Source;
@@ -42,6 +42,7 @@ sub new {
     }
     $object->{name} = $pkg;
     $object->{type} = $type;
+    $object->{base_dir} = $base_dir;
     return $object;
 }
 
@@ -59,6 +60,13 @@ sub type {
     return $self->{type};
 }
 
+# Return the base dir of the package's lab.
+# sub base_dir Needs-Info <>
+sub base_dir {
+    my ($self) = @_;
+    return $self->{base_dir};
+}
+
 # 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
@@ -68,7 +76,8 @@ sub type {
 sub field {
     my ($self, $field) = @_;
     return $self->{field}{$field} if exists $self->{field}{$field};
-    if (open(FIELD, '<', "fields/$field")) {
+    my $base_dir = $self->base_dir();
+    if (open(FIELD, '<', "$base_dir/fields/$field")) {
         local $/;
         my $value = <FIELD>;
         close FIELD;
@@ -146,6 +155,10 @@ Returns the name of the package.
 
 Returns the type of the package.
 
+=item base_dir()
+
+Returns the base_dir where all the package information is stored.
+
 =back
 
 =head1 AUTHOR
diff --git a/lib/Lintian/Collect/Binary.pm b/lib/Lintian/Collect/Binary.pm
index 2dd6b58..a8f4d50 100644
--- a/lib/Lintian/Collect/Binary.pm
+++ b/lib/Lintian/Collect/Binary.pm
@@ -54,11 +54,12 @@ sub native {
 sub changelog {
     my ($self) = @_;
     return $self->{changelog} if exists $self->{changelog};
+    my $base_dir = $self->base_dir();
     # sub changelog Needs-Info changelog-file
-    if (-l 'changelog' || ! -f 'changelog') {
+    if (-l "$base_dir/changelog" || ! -f "$base_dir/changelog") {
         $self->{changelog} = undef;
     } else {
-        my %opts = (infile => 'changelog', quiet => 1);
+        my %opts = (infile => "$base_dir/changelog", quiet => 1);
         $self->{changelog} = Parse::DebianChangelog->init(\%opts);
     }
     return $self->{changelog};
@@ -70,12 +71,12 @@ sub changelog {
 sub index {
     my ($self) = @_;
     return $self->{index} if exists $self->{index};
-
+    my $base_dir = $self->base_dir();
     my (%idx, %dir_counts);
-    open my $idx, '<', 'index'
-        or fail("cannot open index file index: $!");
-    open my $num_idx, '<', 'index-owner-id'
-        or fail("cannot open index file index-owner-id: $!");
+    open my $idx, '<', "$base_dir/index"
+        or fail("cannot open index file $base_dir/index: $!");
+    open my $num_idx, '<', "$base_dir/index-owner-id"
+        or fail("cannot open index file $base_dir/index-owner-id: $!");
     while (<$idx>) {
         chomp;
 
@@ -139,11 +140,11 @@ sub sorted_index {
 sub file_info {
     my ($self) = @_;
     return $self->{file_info} if exists $self->{file_info};
-
+    my $base_dir = $self->base_dir();
     my %file_info;
     # sub file_info Needs-Info file-info
-    open(my $idx, '<', 'file-info')
-        or fail("cannot open file-info: $!");
+    open(my $idx, '<', "$base_dir/file-info")
+        or fail("cannot open $base_dir/file-info: $!");
     while (<$idx>) {
         chomp;
 
@@ -180,11 +181,11 @@ sub sorted_file_info{
 sub scripts {
     my ($self) = @_;
     return $self->{scripts} if exists $self->{scripts};
-
+    my $base_dir = $self->base_dir();
     my %scripts;
     # sub scripts Needs-Info scripts
-    open(SCRIPTS, '<', 'scripts')
-	or fail("cannot open scripts file: $!");
+    open(SCRIPTS, '<', "$base_dir/scripts")
+	or fail("cannot open scripts $base_dir/file: $!");
     while (<SCRIPTS>) {
 	chomp;
 	my (%file, $name);
@@ -209,12 +210,12 @@ sub scripts {
 sub objdump_info {
     my ($self) = @_;
     return $self->{objdump_info} if exists $self->{objdump_info};
-
+    my $base_dir = $self->base_dir();
     my %objdump_info;
     my ($dynsyms, $file);
     # sub objdump_info Needs-Info objdump-info
-    open(my $idx, '<', 'objdump-info')
-        or fail("cannot open objdump-info: $!");
+    open(my $idx, '<', "$base_dir/objdump-info")
+        or fail("cannot open $base_dir/objdump-info: $!");
     while (<$idx>) {
         chomp;
 
diff --git a/lib/Lintian/Processable.pm b/lib/Lintian/Processable.pm
index 1ba65a2..5fd4948 100644
--- a/lib/Lintian/Processable.pm
+++ b/lib/Lintian/Processable.pm
@@ -132,9 +132,13 @@ sub info{
     my ($self) = @_;
     my $info = $self->{info};
     if (! defined $info) {
+        my $lpkg = $self->lab_pkg();
+        fail "Need a Lab package before creating a Lintian::Collect\n"
+            unless defined $lpkg;
         # load only if we need it
         require Lintian::Collect;
-        $info = Lintian::Collect->new($self->pkg_name(), $self->pkg_type());
+        $info = Lintian::Collect->new($self->pkg_name(), $self->pkg_type(),
+            $lpkg->base_dir());
         $self->{info} = $info;
     }
     return $info;

-- 
Debian package checker