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,
129 for my $package (make_list($args{packages})) {
131 Debbugs::Package->new(name => $package,
132 package_collection => $self->universe,
133 correspondent_collection =>
134 $self->correspondent_collection->universe,
141 sub add_packages_and_versions {
143 $self->add($self->_member_constructor(packages => \@_));
148 return $_[1]->qualified_name;
151 has 'correspondent_collection' =>
153 isa => 'Debbugs::Collection::Correspondent',
154 default => sub {Debbugs::Collection::Correspondent->new()},
159 isa => 'Debbugs::VersionTree',
161 builder => '_build_versiontree',
164 sub _build_versiontree {
166 return Debbugs::VersionTree->new($self->has_schema?(schema => $self->schema):());
169 =head2 get_source_versions_distributions
171 $packages->get_source_versions_distributions('unstable')
173 Given a list of distributions or suites, returns a
174 L<Debbugs::Collection::Version> of all of the versions in this package
175 collection which are known to match.
177 Effectively, this calls L<Debbugs::Package/get_source_version_distribution> for
178 each package in the collection and merges the results and returns them
182 sub get_source_versions_distributions {
186 $self->map(sub {$_->get_source_version_distribution(@_)});
188 return $return[0]->combine($return[1..$#return]);
194 =head2 get_source_versions
196 $packages->get_source_versions('1.2.3-1','foo/1.2.3-5')
198 Given a list of binary versions or src/versions, returns a
199 L<Debbugs::Collection::Version> of all of the versions in this package
200 collection which are known to match.
202 If you give a binary version ('1.2.3-1'), you must have already loaded source
203 packages into this package collection for it to find an appropriate match.
205 If no package is known to match, an version which is invalid will be returned
207 For fully qualified versions this loads the appropriate source package into the
208 universe of this collection and calls L<Debbugs::Package/get_source_version>.
209 For unqualified versions, calls L<Debbugs::Package/get_source_version>; if no
210 valid versions are returned, creates an invalid version.
214 sub get_source_versions {
219 if ($ver =~ m{(?<src>.+?)/(?<ver>.+)$}) {
220 my $sp = $self->universe->
221 get_or_add_by_key('src:'.$+{src});
223 $sp->get_source_version($+{ver});
227 for my $p ($self->members) {
231 $p->get_source_version($ver);
238 if (not $found_valid) {
240 Debbugs::Version::Binary->new(version => $ver,
241 package_collection => $self->universe,
243 $self->schema_argument,
249 Debbugs::Collection::Version->new(members => \@return,
250 $self->schema_argument,
251 package_collection => $self->universe,
257 $packages->source_names()
259 Returns a unique list of source names from all members of this collection by
260 calling L<Debbugs::Package/source_names> on each member.
267 return uniq map {$_->source_names} $self->members;
274 Returns a L<Debbugs::Collection::Package> limited to source packages
275 corresponding to all packages in this collection
281 return $self->universe->limit($self->source_names);
285 __PACKAGE__->meta->make_immutable;
292 # indent-tabs-mode: nil
293 # cperl-indent-level: 4