[SCM] Debian package checker branch, infra-513663, updated. 2.5.0-rc1-66-g664a537
The following commit has been merged in the infra-513663 branch:
commit 664a537f080501e9c8325a2bfbf3021e1531e544
Author: Niels Thykier <niels@thykier.net>
Date: Tue Mar 29 16:08:23 2011 +0200
Refactored large parts of the prototype into L::ProcessablePool
diff --git a/lib/Lintian/ProcessablePool.pm b/lib/Lintian/ProcessablePool.pm
new file mode 100644
index 0000000..cd833de
--- /dev/null
+++ b/lib/Lintian/ProcessablePool.pm
@@ -0,0 +1,240 @@
+# Copyright (C) 2011 Niels Thykier <niels@thykier.net>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, you can find it on the World Wide
+# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
+# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
+# MA 02110-1301, USA.
+
+## Represents a pool of processables (Lintian::Processable)
+package Lintian::ProcessablePool;
+
+use strict;
+use warnings;
+
+use Cwd();
+use Util;
+
+use Lintian::Processable;
+use Lintian::ProcessableGroup;
+
+=head1 NAME
+
+Lintian::ProcessablePool -- Pool of processables
+
+=head1 SYNOPSIS
+
+ use Lintian::ProcessablePool;
+
+ my $pool = Lintian::ProcessablePool->new();
+ $pool->add_file('foo.changes');
+ $pool->add_file('bar.dsc');
+ $pool->add_file('baz.deb');
+ foreach my $gname ($pool->get_group_names()){
+ my $group = $pool->get_group($gname);
+ process($gname, $group);
+ }
+
+=head1 METHODS
+
+=over 4
+
+=item Lintian::ProcessablePool->new()
+
+Creates a new empty pool.
+
+=cut
+
+sub new {
+ my ($class) = @_;
+ my $self = {};
+ bless $self, $class;
+ $self->_init();
+ return $self;
+}
+
+=item $pool->add_file($file)
+
+Adds a file to the pool. The $file will be turned into
+a L<Lintian::Processable> and grouped together with other
+processables from the same source package (if any).
+
+=cut
+
+sub add_file {
+ my ($self, $file) = @_;
+ my ($pkg_path, $pkg_type, $tmap, $proc, $procid);
+ my ($group, $groupid);
+ fail "$file does not exist" unless -e $file;
+ $pkg_path = Cwd::abs_path($file);
+ if ($pkg_path =~ m/\.changes$/o){
+ return $self->_add_changes_file($pkg_path);
+ }
+ if ($pkg_path =~ m/\.dsc$/o){
+ $pkg_type = 'source';
+ } elsif ($pkg_path =~ m/\.deb$/o){
+ $pkg_type = 'binary';
+ } elsif ($pkg_path =~ m/\.udeb$/o){
+ $pkg_type = 'udeb';
+ } else {
+ fail "$pkg_path is not a known type of package.";
+ }
+ # Just insert these for now.
+ $tmap = $self->{$pkg_type};
+ $proc = Lintian::Processable->new($pkg_type, $pkg_path);
+ $procid = _get_proc_id($proc);
+ return 0 if exists $tmap->{$procid};
+ $groupid = _get_group_id($proc);
+ $group = $self->{groups}->{$groupid};
+ if (defined $group){
+ if ($pkg_type eq 'source'){
+ # if this is a source pkg, then this is a duplicate
+ # assuming the group already has a source package.
+ return 0 if (defined($group->get_source_processable()));
+ }
+ # else add the binary/udeb proc to the group
+ return $group->add_processable($proc);
+ } else {
+ # Create a new group
+ $group = Lintian::ProcessableGroup->new();
+ $group->add_processable($proc);
+ $self->{groups}->{$groupid} = $group;
+ }
+ # add it to the "unprocessed"/"seen" map.
+ $tmap->{$procid} = $proc;
+ return 1;
+}
+
+=item $pool->get_group_names()
+
+Returns the name of all the groups in this pool.
+
+Do not modify the list nor its contents.
+
+=cut
+
+sub get_group_names{
+ my ($self) = @_;
+ return keys %{ $self->{groups} };
+}
+
+=item $pool->get_group($name)
+
+Returns the group called $name or C<undef>
+if there is no group called $name.
+
+=cut
+
+sub get_group{
+ my ($self, $group) = @_;
+ return $self->{groups}->{$group};
+}
+
+=item $pool->get_groups()
+
+Returns all the groups in the pool.
+
+Do not modify the list nor its contents.
+
+=cut
+
+sub get_groups{
+ my ($self) = @_;
+ my $result = [];
+ my $groups = $self->{groups};
+ if (scalar keys %$groups) {
+ return values %$groups;
+ }
+ return ();
+}
+
+#### Internal subs ####
+
+sub _init {
+ my ($self) = @_;
+ foreach my $field (qw(binary changes groups source udeb)){
+ $self->{$field} = {};
+ }
+ return 1;
+}
+
+sub _add_changes_file{
+ my ($self, $pkg_path) = @_;
+ my $group = Lintian::ProcessableGroup->new($pkg_path);
+ my $cproc = $group->get_changes_processable();
+ my $gid = _get_group_id($cproc);
+ my $ogroup = $self->{groups}->{$gid};
+ if (defined($ogroup)){
+ # Group already exists...
+ my $tmap = $self->{'changes'};
+ my $cid = _get_proc_id($cproc);
+ my $added = 0;
+ # duplicate changes file?
+ return 0 if (exists $tmap->{$cid});
+ # Merge architectures/packages ...
+ # Accept all new
+ if (! defined $ogroup->get_source_processable()
+ && defined $group->get_source_processable()){
+ $ogroup->add_processable($group->get_source_processable());
+ $added = 1;
+ }
+ foreach my $bin ($group->get_binary_processables()){
+ my $tbmap = $self->{$bin->pkg_type()};
+ my $procid = _get_proc_id($bin);
+ if (! exists $tbmap->{$procid}){
+ # New binary package
+ $tbmap->{$procid} = $bin;
+ $ogroup->add_processable($bin);
+ $added = 1;
+ }
+ }
+ return $added;
+ } else {
+ $self->{groups}->{$gid} = $group;
+ }
+ return 1;
+}
+
+# Fetches the group id for a package
+# - this id is based on the name and the version of the
+# src-pkg.
+sub _get_group_id{
+ my ($pkg) = @_;
+ return $pkg->pkg_src() . '_' . $pkg->pkg_src_version();
+}
+
+# Fetches the id of the processable; note this is different
+# than _get_group_id even for src processables.
+sub _get_proc_id {
+ my ($pkg) = @_;
+ return $pkg->pkg_name() . '_' . $pkg->pkg_version() .
+ '_' . $pkg->pkg_arch();
+}
+
+=back
+
+=head1 AUTHOR
+
+Originally written by Niels Thykier <niels@thykier.net> for Lintian.
+
+=head1 SEE ALSO
+
+lintian(1)
+
+L<Lintian::Processable>
+
+L<Lintian::ProcessableGroup>
+
+=cut
+
+1;
diff --git a/private/processable-prototype.pl b/private/processable-prototype.pl
index dc2a029..d58c578 100755
--- a/private/processable-prototype.pl
+++ b/private/processable-prototype.pl
@@ -13,129 +13,20 @@ BEGIN {
}
use lib "$ENV{'LINTIAN_ROOT'}/lib";
-use Lintian::Processable;
-use Lintian::ProcessableGroup;
+use Lintian::ProcessablePool;
use Util;
use Cwd();
my $debug = $ENV{DEBUG}//0;
my $cwd = Cwd::cwd();
-my %group_map = ();
-my %type_map = (
- 'changes' => {},
- 'binary' => {},
- 'source' => {},
- 'udeb' => {},
-);
-
-FILE:
-foreach my $file (@ARGV) {
- my $type;
- my $proc;
- my $tmap;
- my $prockey;
- $file = "$cwd/$file" unless ($file =~ m@^/@o);
-
- if ($file =~ m/\.changes$/o){
- my $group = Lintian::ProcessableGroup->new($file);
- my $src_proc;
- # Correctness depends on the documented order of
- # get_processables
- foreach my $gmember (@{$group->get_processables()}){
- my $mtype = $gmember->pkg_type();
- my $mname;
- my $tmap = $type_map{$mtype};
- if ($mtype eq 'binary' or $mtype eq 'udeb'){
- $mname = gen_proc_key($gmember);
- } else {
- $mname = gen_src_proc_key($gmember);
- }
- if (exists $tmap->{$mname}){
- if ($mtype eq 'changes'){
- # Skip this changes file - we have seen it before
- warning ("Skipping $mname ($mtype) - duplicate");
- next FILE;
- } else {
- # dump the old file - most likely the one from the
- # changes file will provide the best results if they
- # are not identical.
- warning ("Ignoring previously added $mname ($mtype) - " .
- "duplicate of file from $file");
- }
- }
- $tmap->{$mname} = $gmember;
- }
- $src_proc = $group->get_source_processable();
- $src_proc = $group->get_changes_processable() unless defined $src_proc;
- fail "$file has no src_proc ($group)" unless defined $src_proc;
- # There are no clashes in sane packages because $src->pkg_src
- # eq $chn->pkg_src except for crafted/incorrect files.
- #
- # ... and for crafted packages we have more to worry about
- # than suboptimal check accuracy.
- $group_map{gen_src_proc_key($src_proc)} = $group;
- next;
- }
-
- if ($file =~ m/\.deb$/o){
- $type = 'binary';
- } elsif ($file =~ m/\.udeb$/o){
- $type = 'udeb';
- } elsif ($file =~ m/\.dsc$/o){
- $type = 'source';
- } else {
- fail "cannot handle $file";
- }
- $proc = Lintian::Processable->new($type, $file);
- $prockey = gen_proc_key($proc);
- $tmap = $type_map{$type};
- if (exists $tmap->{$prockey}){
- warning ('Skipping ' . $prockey . " ($type) - duplicate package");
- } else {
- $tmap->{$prockey} = $proc;
- }
-}
+my $pool = Lintian::ProcessablePool->new();
-
-# create a proc-group for each of the remaining source packages.
-foreach my $source (values %{ $type_map{'source'} }) {
- my $group;
- my $srckey;
- next if defined $source->group();
- $srckey = gen_src_proc_key($source);
- $group = $group_map{$srckey};
- if (defined $group){
- if (!defined $group->get_source_processable()){
- # Happens e.g. with dpkg-buildpackage -b
- # Technically the source is most likely out of date
- # but just process it together with the rest anyway.
- $group->add_processable($source);
- } else {
- warning ("Skipping $srckey (source) - duplicate package");
- }
- next;
- }
- debug(1, 'Creating group for ' . $source->pkg_src() .
- '(' . $source->pkg_src_version . ')');
- $group = Lintian::ProcessableGroup->new();
- $group->add_processable($source);
- $group_map{gen_src_proc_key($source)} = $group;
-}
-
-foreach my $bin (values %{ $type_map{'binary'} }, values %{ $type_map{'udeb'} }){
- my $src_key = gen_src_proc_key($bin);
- my $group = $group_map{$src_key};
- if (! defined $group){
- # Create a new group based on the name of the source package
- # - perhaps we will get more binaries from the same source.
- $group = Lintian::ProcessableGroup->new();
- $group_map{$src_key} = $group;
- }
- $group->add_processable($bin);
+foreach my $file (@ARGV) {
+ $pool->add_file($file) or die "Adding $file failed\n";
}
-foreach my $gname (sort keys %group_map){
- my $group = $group_map{$gname};
+foreach my $gname ( sort $pool->get_group_names() ){
+ my $group = $pool->get_group($gname);
print "Group \"$gname\" consists of [",
join(', ', map { stringify_proc($_) } @{$group->get_processables()}),
"]\n";
--
Debian package checker
Reply to: