[SCM] Debian package checker branch, master, updated. 2.5.10-15-g987fb11
The following commit has been merged in the master branch:
commit 987fb1118d8e772b231aa79789ab5aa598b0cc42
Author: Niels Thykier <niels@thykier.net>
Date: Wed Jul 11 16:01:34 2012 +0200
L::Collect: Add lab_data_path to access files in the lab
Add lab_data_path method to L::Collect as a convenience method around
base_dir to access a file in the entry. This replaces a bit of boiler
plate code inside L::Collect{,::*} to access various files and dirs.
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/lib/Lintian/Collect.pm b/lib/Lintian/Collect.pm
index f106776..79d4a0f 100644
--- a/lib/Lintian/Collect.pm
+++ b/lib/Lintian/Collect.pm
@@ -68,6 +68,16 @@ sub base_dir {
return $self->{base_dir};
}
+# Return the path to a file (or dir) in the lab
+# - convenience around base_dir
+# sub lab_data_path Needs-Info <>
+sub lab_data_path {
+ my ($self, $entry) = @_;
+ my $base = $self->base_dir;
+ return "$base/$entry" if $entry;
+ return $base;
+}
+
# 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
@@ -204,6 +214,12 @@ Returns the type of the package.
Returns the base_dir where all the package information is stored.
+=item lab_data_path ([ENTRY])
+
+Return the path to the ENTRY in the lab. This is a convenience method
+around base_dir. If ENTRY is not given, this method behaves like
+base_dir.
+
=back
=head1 AUTHOR
diff --git a/lib/Lintian/Collect/Binary.pm b/lib/Lintian/Collect/Binary.pm
index 64af868..865e25c 100644
--- a/lib/Lintian/Collect/Binary.pm
+++ b/lib/Lintian/Collect/Binary.pm
@@ -61,12 +61,12 @@ sub native {
sub changelog {
my ($self) = @_;
return $self->{changelog} if exists $self->{changelog};
- my $base_dir = $self->base_dir();
+ my $dch = $self->lab_data_path ('changelog');
# sub changelog Needs-Info changelog-file
- if (-l "$base_dir/changelog" || ! -f "$base_dir/changelog") {
+ if (-l $dch || ! -f $dch) {
$self->{changelog} = undef;
} else {
- my %opts = (infile => "$base_dir/changelog", quiet => 1);
+ my %opts = (infile => $dch, quiet => 1);
$self->{changelog} = Parse::DebianChangelog->init(\%opts);
}
return $self->{changelog};
@@ -110,17 +110,17 @@ sub strings {
sub md5sums {
my ($self) = @_;
return $self->{md5sums} if exists $self->{md5sums};
- my $base_dir = $self->base_dir();
+ my $md5f = $self->lab_data_path ('md5sums');
my $result = {};
# read in md5sums info file
- open(my $fd, '<', "$base_dir/md5sums")
- or fail("cannot open $base_dir/md5sums info file: $!");
+ open my $fd, '<', $md5f
+ or fail "cannot open $md5f info file: $!";
while (my $line = <$fd>) {
chop($line);
next if $line =~ m/^\s*$/o;
$line =~ m/^(\S+)\s*(\S.*)$/o
- or fail("syntax error in $base_dir/md5sums info file: $line");
+ or fail "syntax error in $md5f info file: $line";
my $zzsum = $1;
my $zzfile = $2;
$zzfile =~ s,^(?:\./)?,,o;
@@ -134,12 +134,12 @@ sub md5sums {
sub scripts {
my ($self) = @_;
return $self->{scripts} if exists $self->{scripts};
- my $base_dir = $self->base_dir();
+ my $scrf = $self->lab_data_path ('scripts');
my %scripts;
local $_;
# sub scripts Needs-Info scripts
- open(SCRIPTS, '<', "$base_dir/scripts")
- or fail("cannot open scripts $base_dir/file: $!");
+ open SCRIPTS, '<', $scrf
+ or fail "cannot open scripts $scrf: $!";
while (<SCRIPTS>) {
chomp;
my (%file, $name);
@@ -164,13 +164,13 @@ sub scripts {
sub objdump_info {
my ($self) = @_;
return $self->{objdump_info} if exists $self->{objdump_info};
- my $base_dir = $self->base_dir();
+ my $objf = $self->lab_data_path ('objdump-info.gz');
my %objdump_info;
my ($dynsyms, $file);
local $_;
# sub objdump_info Needs-Info objdump-info
- open my $fd, '-|', 'gzip', '-dc', "$base_dir/objdump-info.gz"
- or fail "cannot open $base_dir/objdump-info.gz: $!";
+ my $fd = open_gz ($objf)
+ or fail "cannot open $objf: $!";
foreach my $pg (parse_dpkg_control ($fd)) {
my %info = (
'PH' => {},
@@ -235,12 +235,12 @@ sub objdump_info {
sub hardening_info {
my ($self) = @_;
return $self->{hardening_info} if exists $self->{hardening_info};
- my $base_dir = $self->base_dir();
+ my $hardf = $self->lab_data_path ('hardening-info');
my %hardening_info;
my ($file);
local $_;
- open(my $idx, '<', "$base_dir/hardening-info")
- or fail("cannot open $base_dir/hardening-info: $!");
+ open my $idx, '<', $hardf
+ or fail "cannot open $hardf: $!";
while (<$idx>) {
chomp;
@@ -261,18 +261,16 @@ sub hardening_info {
sub java_info {
my ($self) = @_;
return $self->{java_info} if exists $self->{java_info};
-
- my $base_dir = $self->base_dir;
+ my $javaf = $self->lab_data_path ('java-info.gz');
my %java_info;
- if ( ! -f "$base_dir/java-info.gz" ) {
+ if ( ! -f $javaf ) {
# no java-info.gz => no jar files to collect data. Just
# return an empty hash ref.
$self->{java_info} = \%java_info;
return $self->{java_info};
}
-
- open my $idx, '-|', 'gzip', '-dc', "$base_dir/java-info.gz"
- or fail "cannot open $base_dir/java-info.gz: $!";
+ my $idx = open_gz ($javaf)
+ or fail "cannot open $javaf: $!";
my $file;
my $file_list;
my $manifest = 0;
diff --git a/lib/Lintian/Collect/Package.pm b/lib/Lintian/Collect/Package.pm
index e9ee707..febd977 100644
--- a/lib/Lintian/Collect/Package.pm
+++ b/lib/Lintian/Collect/Package.pm
@@ -40,12 +40,12 @@ sub unpacked {
sub file_info {
my ($self) = @_;
return $self->{file_info} if exists $self->{file_info};
- my $base_dir = $self->base_dir();
my %file_info;
+ my $path = $self->lab_data_path ('file-info.gz');
local $_;
# sub file_info Needs-Info file-info
- my $idx = open_gz ("$base_dir/file-info.gz")
- or croak "cannot open $base_dir/file-info.gz: $!";
+ my $idx = open_gz ($path)
+ or croak "cannot open $path: $!";
while (<$idx>) {
chomp;
@@ -87,8 +87,7 @@ 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";
+ $dir = $self->lab_data_path ($dirname);
croak "$field ($dirname) is not available" unless -d "$dir/";
$self->{$field} = $dir;
}
diff --git a/lib/Lintian/Collect/Source.pm b/lib/Lintian/Collect/Source.pm
index 136d161..4277e93 100644
--- a/lib/Lintian/Collect/Source.pm
+++ b/lib/Lintian/Collect/Source.pm
@@ -46,12 +46,11 @@ sub new {
sub changelog {
my ($self) = @_;
return $self->{changelog} if exists $self->{changelog};
- my $base_dir = $self->base_dir();
- if (-l "$base_dir/debfiles/changelog" ||
- ! -f "$base_dir/debfiles/changelog") {
+ my $dch = $self->lab_data_path ('debfiles/changelog');
+ if (-l $dch || ! -f $dch) {
$self->{changelog} = undef;
} else {
- my %opts = (infile => "$base_dir/debfiles/changelog", quiet => 1);
+ my %opts = (infile => $dch, quiet => 1);
$self->{changelog} = Parse::DebianChangelog->init(\%opts);
}
return $self->{changelog};
@@ -63,7 +62,7 @@ sub changelog {
sub diffstat {
my ($self) = @_;
return $self->{diffstat} if exists $self->{diffstat};
- my $dstat = $self->base_dir() . '/diffstat';
+ my $dstat = $self->lab_data_path ('diffstat');
$dstat = '/dev/null' unless -e $dstat;
$self->{diffstat} = $dstat;
return $dstat;
--
Debian package checker
Reply to: