[SCM] Debian package checker branch, master, updated. 2.5.10-159-g7b8db3d
The following commit has been merged in the master branch:
commit a14bc2e6c712034df3d8f89aec22ca1817e630e8
Author: Niels Thykier <niels@thykier.net>
Date: Fri Sep 21 10:57:05 2012 +0200
L::Processable: Add "new_from_metadata" contructor
This constructor can create a L::Processable from the Packages/Sources
files. By using this constructor in reporting/harness, it is possible
avoid a "ar + gunzip" of *every* binary file on the mirror.
Signed-off-by: Niels Thykier <niels@thykier.net>
diff --git a/lib/Lintian/Lab/Manifest.pm b/lib/Lintian/Lab/Manifest.pm
index 3dba2e7..0572d5a 100644
--- a/lib/Lintian/Lab/Manifest.pm
+++ b/lib/Lintian/Lab/Manifest.pm
@@ -335,10 +335,7 @@ sub set {
$val =~ tr/;\n/_ /;
$pdata{$field} = $val;
}
- # define source-version as alias of version for
- # source packages.
- $pdata{'source-version'} = $pdata{'version'}
- unless defined $pdata{'source-version'};
+ $self->_make_alias_fields (\%pdata);
$self->_do_set ($self->{'state'}, $qf, \%pdata);
$self->_mark_dirty(1);
@@ -482,16 +479,25 @@ sub _do_read_file {
for ( my $i = 0 ; $i < $count ; $i++) {
$entry->{$fields->[$i]} = $values[$i]//'';
}
- # define source-version as alias of version for
- # source packages.
- $entry->{'source-version'} = $entry->{'version'}
- unless defined $entry->{'source-version'};
+ $self->_make_alias_fields ($entry);
$self->_do_set ($root, $qf, $entry);
}
close $fd;
return $root;
}
+sub _make_alias_fields {
+ my ($self, $entry) = @_;
+ # define source-version as alias of version for
+ # source packages.
+ $entry->{'source-version'} = $entry->{'version'}
+ unless defined $entry->{'source-version'};
+ # For compat with Lintian::Processable->new_from_metadata
+ $entry->{'pkg_path'} = $entry->{'file'};
+ $entry->{'package'} = $entry->{'source'}
+ unless defined $entry->{'package'};
+}
+
sub _do_get {
my ($self, $root, @keys) = @_;
my $cur = $root;
diff --git a/lib/Lintian/Processable.pm b/lib/Lintian/Processable.pm
index f2ec90d..7bb5625 100644
--- a/lib/Lintian/Processable.pm
+++ b/lib/Lintian/Processable.pm
@@ -47,6 +47,110 @@ deb files). Multiple objects can then be combined into
L<groups|Lintain::ProcessableGroup>, which Lintian will process
together.
+=head1 CLASS METHODS
+
+=over 4
+
+=item new_from_metadata (TYPE, PARAGRAPH[, BASEPATH])
+
+Returns a Lintian::Processable from a PARAGRAPH in a Sources or a
+Packages file with the following exception.
+
+If the PARAGRAPH has a field named "pkg_path", then that is used
+instead of creating the path from BASEPATH path concatenated with the
+TYPE specific field(s). Hench BASEPATH is optional if and only if,
+the paragraph has a field called "pkg_path".
+
+The TYPE parameter determines the type of the processable and is
+required.
+
+NB: Optional fields (e.g. "Source" for binaries) may be omitted in
+PARAGRAPH as usual. In this case, the respective values are computed
+from the required fields according to the Policy Manual.
+
+=cut
+
+my %KEEP = map { $_ => 1 } qw(
+ pkg_name pkg_version pkg_src pkg_src_version pkg_type pkg_path pkg_arch
+);
+
+sub new_from_metadata {
+ my ($clazz, $pkg_type, $paragraph, $basepath) = @_;
+ my $self = {
+ %$paragraph # Copy the input data for starters
+ };
+ my $rename_field = sub {
+ my ($oldn, $newn, $default) = @_;
+ $self->{$newn} = delete $self->{$oldn};
+ if (not defined $self->{$newn} and defined $default) {
+ $self->{$newn} = $default;
+ }
+ croak "Required field $oldn is missing or empty"
+ unless defined $self->{$newn} and $self->{$newn} ne '';
+ };
+ $self->{'pkg_type'} = $pkg_type;
+ $rename_field->('package', 'pkg_name');
+ $rename_field->('version', 'pkg_version');
+ bless $self, $clazz;
+ if ($pkg_type eq 'binary' or $pkg_type eq 'udeb') {
+ $rename_field->('source', 'pkg_src', $self->pkg_name);
+ $rename_field->('architecture', 'pkg_arch');
+ if ($self->{'pkg_src'} =~ /^([-+\.\w]+)\s+\((.+)\)$/) {
+ $self->{'pkg_src'} = $1;
+ $self->{'pkg_src_version'} = $2;
+ } else {
+ $self->{'pkg_src_version'} = $self->pkg_version
+ }
+ if (not exists $self->{'pkg_path'}) {
+ my $fn = delete $self->{'filename'};
+ croak "Missing required \"filename\" field"
+ unless defined $fn;
+ $self->{'pkg_path'} = "$basepath/$fn";
+ }
+ } elsif ($pkg_type eq 'source') {
+ $self->{'pkg_src'} = $self->pkg_name;
+ $self->{'pkg_src_version'} = $self->pkg_version;
+ $self->{'pkg_arch'} = 'source';
+ if (not exists $self->{'pkg_path'}) {
+ my $fn = delete $self->{'files'};
+ my $dsc;
+ my $dir = delete $self->{'directory'};
+ $dir .= '/' if defined $dir;
+ $dir //= '';
+ foreach my $f (split m/\n/, $fn) {
+ $f =~ s/^\s++//o;
+ next unless $f && $f =~ m/\.dsc$/;
+ my (undef, undef, $file) = split m/\s++/, $f;
+ # $dir should end with a slash if it is non-empty.
+ $self->{'pkg_path'} = "$basepath/${dir}$file";
+ last;
+ }
+ croak "dsc file not listed in \"Files\""
+ unless defined $self->{'pkg_path'};
+ }
+ } elsif ($pkg_type eq 'changes') {
+ # This case is basically for L::Lab::Manifest entries...
+ $self->{'pkg_src'} = $self->pkg_name;
+ $self->{'pkg_src_version'} = $self->pkg_version;
+ $rename_field->('architecture', 'pkg_arch');
+ croak ".changes file must have pkg_path set"
+ unless defined $self->{'pkg_path'};
+ } else {
+ croak "Unsupported type $pkg_type";
+ }
+ # Prune the field list...
+ foreach my $k (keys %$self) {
+ delete $self->{$k} unless exists $KEEP{$k};
+ }
+ return $self;
+}
+
+# Shadow Class::Accessor - otherwise you get some very "funny" errors
+# from Class::Accessor if you get the constructor wrong.
+sub new { croak "Not implemented"; }
+
+=back
+
=head1 INSTANCE METHODS
=over 4
@@ -89,7 +193,7 @@ Returns the type of package (e.g. binary, source, udeb ...)
=item $proc->pkg_arch()
Returns the architecture(s) of the package. May return multiple values
-from source and changes processables.
+from changes processables. For source processables it is "source".
=item $proc->pkg_src()
diff --git a/reporting/harness b/reporting/harness
index 10bd29c..8716fe8 100755
--- a/reporting/harness
+++ b/reporting/harness
@@ -100,7 +100,7 @@ $ENV{'LINTIAN_ARCH'} = $LINTIAN_ARCH;
unshift @INC, "$LINTIAN_ROOT/lib";
require Lintian::Lab;
require Lintian::Lab::Manifest;
-require Lintian::Processable::Package;
+require Lintian::Processable;
require Lintian::Util;
import Lintian::Util qw(visit_dpkg_paragraph);
@@ -221,7 +221,7 @@ unless ($opt{'reports-only'}) {
my $entry;
unless ($opt{'dry-run'}) {
eval {
- $proc = Lintian::Processable::Package->new ($file, $type);
+ $proc = Lintian::Processable->new_from_metadata ($type, $me);
};
unless ($proc) {
my $name = "$type:$pkg_name/$pkg_version";
diff --git a/t/scripts/pod-coverage.t b/t/scripts/pod-coverage.t
index 8e662b7..1144cd0 100755
--- a/t/scripts/pod-coverage.t
+++ b/t/scripts/pod-coverage.t
@@ -26,7 +26,7 @@ our %MODULES =
'Lintian::Lab::Manifest' => [],
'Lintian::Lab::ManifestDiff' => [],
'Lintian::Profile' => [],
- 'Lintian::Processable' => [],
+ 'Lintian::Processable' => [qr/^new$/],
'Lintian::ProcessableGroup' => [],
'Lintian::ProcessablePool' => [],
'Lintian::Relation' => [ qr/^parse_element$/,
--
Debian package checker
Reply to: