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 =head2 my $packages = Debbugs::Collection::Package->new(%params|$param)
48 Parameters in addition to those defined by L<Debbugs::Collection>
52 =item correspondent_collection
54 Optional L<Debbugs::Collection::Correspondent> which is used to look up correspondents
59 Optional L<Debbugs::VersionTree> which contains known package source versions
63 =head2 $packages->correspondent_collection
65 Returns the L<Debbugs::Collection::Correspondent> for this package collection
69 Returns the L<Debbugs::VersionTree> for this package collection
71 =head2 $packages->get_source_versions_distributions(@distributions)
73 Returns a L<Debbugs::Collection::Version> of all versions in this package
74 collection which belong to the distributions given.
76 =head2 $packages->get_source_versions('1.2.3-1','foo/1.2.3-5')
78 Given a list of binary versions or src/versions, returns a
79 L<Debbugs::Collection::Version> of all of the versions in this package
80 collection which are known to match. You'll have to be sure to load appropriate
81 versions beforehand for this to actually work.
85 has '+members' => (isa => 'ArrayRef[Debbugs::Package]');
90 if (exists $args->{packages}) {
92 add($self->_member_constructor(packages =>
97 around add_by_key => sub {
101 $self->_member_constructor(packages => [@_]);
102 return $self->$orig(@members);
105 sub _member_constructor {
106 # handle being called $self->_member_constructor;
110 if ($self->has_schema) {
111 $schema = $self->schema;
114 if (defined $schema) {
115 if (not ref($args{packages}) or @{$args{packages}} == 1 and
116 $self->universe->count() > 0
118 carp("Likely inefficiency; member_constructor called with one argument");
121 Debbugs::Package::_get_valid_version_info_from_db(packages => $args{packages},
124 for my $package (keys %{$packages}) {
126 Debbugs::Package->new(%{$packages->{$package}},
128 package_collection => $self->universe,
129 correspondent_collection =>
130 $self->correspondent_collection->universe,
135 for my $package (make_list($args{packages})) {
137 Debbugs::Package->new(name => $package,
138 package_collection => $self->universe,
139 correspondent_collection =>
140 $self->correspondent_collection->universe,
147 sub add_packages_and_versions {
149 $self->add($self->_member_constructor(packages => \@_));
152 # state $common_dists = [@{$config{distributions}}];
153 # sub _get_packages {
155 # my $s = $args{schema};
157 # my %src_ver_packages;
159 # my %bin_ver_packages;
160 # # split packages into src/ver, bin/ver, src, and bin so we can select them
161 # # from the database
163 # for my $pkg (@{$args{packages}}) {
165 # if ($pkg->[0] =~ /^src:(.+)$/) {
166 # for my $ver (@{$pkg}[1..$#{$pkg}]) {
167 # $src_ver_packages{$1}{$ver} = 1;
170 # for my $ver (@{$pkg}[1..$#{$pkg}]) {
171 # $bin_ver_packages{$pkg->[0]}{$ver} = 1;
174 # } elsif ($pkg =~ /^src:(.+)$/) {
175 # $src_packages{$1} = 1;
177 # $bin_packages{$pkg} = 1;
180 # my @src_ver_search;
181 # for my $sp (keys %src_ver_packages) {
182 # push @src_ver_search,
183 # (-and => {'src_pkg.pkg' => $sp,
184 # 'me.ver' => [keys %{$src_ver_packages{$sp}}],
189 # my $src_rs = $s->resultset('SrcVer')->
190 # search({-or => [-and => {'src_pkg.pkg' => [keys %src_packages],
191 # -or => {'suite.codename' => $common_dists,
192 # 'suite.suite_name' => $common_dists,
198 # {join => ['src_pkg',
199 # {'src_associations' => 'suite'},
201 # '+select' => [qw(src_pkg.pkg),
202 # qw(suite.codename),
203 # qw(src_associations.modified),
204 # q(CONCAT(src_pkg.pkg,'/',me.ver))],
205 # '+as' => [qw(src_pkg_name codename modified_time src_pkg_ver)],
206 # result_class => 'DBIx::Class::ResultClass::HashRefInflator',
207 # order_by => {-desc => 'me.ver'}
210 # while (my $pkg = $src_rs->next) {
211 # my $n = 'src:'.$pkg->{src_pkg_name};
212 # if (exists $packages{$n}) {
213 # push @{$packages{$n}{versions}},
214 # $pkg->{src_pkg_ver};
215 # if (defined $pkg->{codename}) {
216 # push @{$packages{$n}{dists}{$pkg->{codename}}},
217 # $#{$packages{$n}{versions}};
221 # {name => $pkg->{src_pkg_name},
224 # versions => [$pkg->{src_pkg_ver}],
225 # dists => {defined $pkg->{codename}?($pkg->{codename} => [1]):()},
233 return $_[1]->qualified_name;
236 has 'correspondent_collection' =>
238 isa => 'Debbugs::Collection::Correspondent',
239 default => sub {Debbugs::Collection::Correspondent->new()},
244 isa => 'Debbugs::VersionTree',
246 builder => '_build_versiontree',
249 sub _build_versiontree {
251 return Debbugs::VersionTree->new($self->has_schema?(schema => $self->schema):());
255 sub get_source_versions_distributions {
259 $self->apply(sub {$_->get_source_version_distribution(@_)});
261 Debbugs::Collection::Version->new(versions => \@return,
262 $self->has_schema?(schema => $self->schema):(),
263 package_collection => $self->universe,
267 # given a list of binary versions or src/versions, returns all of the versions
268 # in this package collection which are known to match. You'll have to be sure to
269 # load appropriate versions beforehand for this to actually work.
270 sub get_source_versions {
275 if ($ver =~ m{(<src>.+?)/(?<ver>.+)$/}) {
276 my $sp = $self->get_or_add_by_key('src:'.$+{src});
278 $sp->get_source_version($ver);
282 for my $p ($self->members) {
286 $p->get_source_version($ver);
293 if (not $found_valid) {
295 Debbugs::Version::Binary->new(version => $ver,
296 package_collection => $self->universe,
298 $self->has_schema?(schema => $self->schema):(),
304 Debbugs::Collection::Version->new(versions => \@return,
305 $self->has_schema?(schema => $self->schema):(),
306 package_collection => $self->universe,
311 __PACKAGE__->meta->make_immutable;
317 # indent-tabs-mode: nil
318 # cperl-indent-level: 4