1 # This module is part of debbugs, and
2 # is released under the terms of the GPL version 2, or any later
3 # version (at your option). See the file README and COPYING for more
5 # Copyright 2018 by Don Armstrong <don@donarmstrong.com>.
7 package Debbugs::Collection::Package;
11 Debbugs::Collection::Package -- Package generation factory
15 This collection extends L<Debbugs::Collection> and contains members of
16 L<Debbugs::Package>. Useful for any field which contains one or more package or
17 tracking lists of packages
28 use v5.10; # for state
29 use namespace::autoclean;
32 use Debbugs::Common qw(make_list hash_slice);
33 use Debbugs::Config qw(:config);
37 use List::AllUtils qw(part);
39 use Debbugs::Version::Binary;
40 use Debbugs::Collection::Version;
41 use Debbugs::Collection::Correspondent;
42 use Debbugs::VersionTree;
44 extends 'Debbugs::Collection';
46 =head1 Object Creation
48 =head2 my $packages = Debbugs::Collection::Package->new(%params|$param)
50 Parameters in addition to those defined by L<Debbugs::Collection>
54 =item correspondent_collection
56 Optional L<Debbugs::Collection::Correspondent> which is used to look up correspondents
61 Optional L<Debbugs::VersionTree> which contains known package source versions
67 =head2 correspondent_collection
69 $packages->correspondent_collection
71 Returns the L<Debbugs::Collection::Correspondent> for this package collection
75 Returns the L<Debbugs::VersionTree> for this package collection
79 has '+members' => (isa => 'ArrayRef[Debbugs::Package]');
84 if (exists $args->{packages}) {
86 add($self->_member_constructor(packages =>
91 around add_by_key => sub {
95 $self->_member_constructor(packages => [@_]);
96 return $self->$orig(@members);
99 sub _member_constructor {
100 # handle being called $self->_member_constructor;
104 if ($self->has_schema) {
105 $schema = $self->schema;
108 if (defined $schema) {
109 if (not ref($args{packages}) or @{$args{packages}} == 1 and
110 $self->universe->count() > 0
112 carp("Likely inefficiency; member_constructor called with one argument");
115 Debbugs::Package::_get_valid_version_info_from_db(packages => $args{packages},
118 for my $package (keys %{$packages}) {
120 Debbugs::Package->new(%{$packages->{$package}},
122 package_collection => $self->universe,
123 correspondent_collection =>
124 $self->correspondent_collection->universe,
128 for my $package (make_list($args{packages})) {
130 Debbugs::Package->new(name => $package,
131 package_collection => $self->universe,
132 correspondent_collection =>
133 $self->correspondent_collection->universe,
140 sub add_packages_and_versions {
142 $self->add($self->_member_constructor(packages => \@_));
147 return $_[1]->qualified_name;
150 has 'correspondent_collection' =>
152 isa => 'Debbugs::Collection::Correspondent',
153 default => sub {Debbugs::Collection::Correspondent->new()},
158 isa => 'Debbugs::VersionTree',
160 builder => '_build_versiontree',
163 sub _build_versiontree {
165 return Debbugs::VersionTree->new($self->has_schema?(schema => $self->schema):());
168 =head2 get_source_versions_distributions
170 $packages->get_source_versions_distributions('unstable')
172 Given a list of distributions or suites, returns a
173 L<Debbugs::Collection::Version> of all of the versions in this package
174 collection which are known to match.
176 Effectively, this calls L<Debbugs::Package/get_source_version_distribution> for
177 each package in the collection and merges the results and returns them
181 sub get_source_versions_distributions {
185 $self->map(sub {$_->get_source_version_distribution(@_)});
187 return $return[0]->combine($return[1..$#return]);
193 =head2 get_source_versions
195 $packages->get_source_versions('1.2.3-1','foo/1.2.3-5')
197 Given a list of binary versions or src/versions, returns a
198 L<Debbugs::Collection::Version> of all of the versions in this package
199 collection which are known to match.
201 If you give a binary version ('1.2.3-1'), you must have already loaded source
202 packages into this package collection for it to find an appropriate match.
204 If no package is known to match, an version which is invalid will be returned
206 For fully qualified versions this loads the appropriate source package into the
207 universe of this collection and calls L<Debbugs::Package/get_source_version>.
208 For unqualified versions, calls L<Debbugs::Package/get_source_version>; if no
209 valid versions are returned, creates an invalid version.
213 sub get_source_versions {
218 if ($ver =~ m{(?<src>.+?)/(?<ver>.+)$}) {
219 my $sp = $self->universe->
220 get_or_add_by_key('src:'.$+{src});
222 $sp->get_source_version($+{ver});
226 for my $p ($self->members) {
230 $p->get_source_version($ver);
237 if (not $found_valid) {
239 Debbugs::Version::Binary->new(version => $ver,
240 package_collection => $self->universe,
242 $self->schema_argument,
248 Debbugs::Collection::Version->new(members => \@return,
249 $self->schema_argument,
250 package_collection => $self->universe,
256 $packages->source_names()
258 Returns a unique list of source names from all members of this collection by
259 calling L<Debbugs::Package/source_names> on each member.
266 return uniq map {$_->source_names} $self->members;
273 Returns a L<Debbugs::Collection::Package> limited to source packages
274 corresponding to all packages in this collection
280 return $self->universe->limit($self->source_names);
284 __PACKAGE__->meta->make_immutable;
291 # indent-tabs-mode: nil
292 # cperl-indent-level: 4