# -*- perl -*- # Lintian::Collect::Group -- interface to group data collections # Copyright (C) 2011 Niels Thykier # # 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, see . # This is a "Lintian::Collect"-like interace (as in "not quite a # Lintian::Collect"). package Lintian::Collect::Group; use strict; use warnings; use Carp qw(croak); =head1 NAME Lintian::Collect::Group - Lintain interface to group data collection =head1 SYNOPSIS my $group = Lintian::ProcessableGroup->new ('lintian_2.5.0_i386.changes'); my $ginfo = Lintian::Collect::Group->new ($group); foreach my $bin ($group->get_binary_processables) { my $pkg_name = $bin->pkg_name; foreach my $dirdep ($ginfo->direct_dependencies ($pkg_name)) { print "$pkg_name (pre-)depends on $dirdep (which is also in this group)\n"; } } =head1 DESCRIPTION Lintian::Collect::Group is a "group" variant of the Lintian::Collect modules. It attempts to expose a similar interface as these and provide useful information about the processable group (or members of it). =head1 CLASS METHODS =over 4 =item Lintian::Collect::Group->new ($group) Creates a new object to provide information about L<$group|Lintian::ProcessableGroup>. =cut sub new { my ($class, $group) = @_; my $self = { 'group' => $group, }; return bless $self, $class; } =item $ginfo->direct_dependencies ($pkg_name) If $pkg_name is a part of the underlying processable group, this method returns a listref containing all the direct dependencies of $pkg_name. If $pkg_name is not a part of the group, this returns undef. Note: Only strong dependencies (Pre-Depends and Depends) are considered. Note: Self-dependencies (if any) are I included in the result. =cut # sub direct_dependencies Needs-Info <> sub direct_dependencies { my ($self, $p) = @_; my $deps = $self->{'direct-dependencies'}; unless ($deps) { my $group = $self->{'group'}; my @procs = $group->get_processables ('binary'); push @procs, $group->get_processables ('udeb'); $deps = {}; foreach my $proc (@procs) { my $pname = $proc->pkg_name; my $relation = $proc->info->relation('strong'); my $d = []; foreach my $oproc (@procs) { my $opname = $oproc->pkg_name; # Ignore self deps - we have checks for that and it # will just end up complicating "correctness" of # otherwise simple checks. next if $opname eq $pname; push @$d, $oproc if $relation->implies($opname); } $deps->{$pname} = $d; } $self->{'direct-dependencies'} = $deps; } return $deps->{$p->pkg_name} if $p; return $deps; } =item $ginfo->type Return the type of this collect object (which is the string 'group'). =cut # Return the package type. # sub type Needs-Info <> sub type { my ($self) = @_; return 'group'; } =back =head1 AUTHOR Originally written by Niels Thykier for Lintian. =head1 SEE ALSO lintian(1), Lintian::Collect::Binary(3), Lintian::Collect::Changes(3), Lintian::Collect::Source(3) =cut 1; __END__;