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
24 use v5.10; # for state
25 use namespace::autoclean;
28 use Debbugs::Common qw(make_list hash_slice);
29 use Debbugs::Config qw(:config);
33 use List::AllUtils qw(part);
35 use Debbugs::Version::Binary;
36 use Debbugs::Collection::Version;
37 use Debbugs::Collection::Correspondent;
38 use Debbugs::VersionTree;
40 extends 'Debbugs::Collection';
42 has '+members' => (isa => 'ArrayRef[Debbugs::Package]');
47 if (exists $args->{packages}) {
49 add($self->_member_constructor(packages =>
54 around add_by_key => sub {
58 $self->_member_constructor(packages => [@_]);
59 return $self->$orig(@members);
62 sub _member_constructor {
63 # handle being called $self->_member_constructor;
67 if ($self->has_schema) {
68 $schema = $self->schema;
71 if (defined $schema) {
72 if (not ref($args{packages}) or @{$args{packages}} == 1) {
73 carp("Likely inefficiency; member_constructor called with one argument");
76 Debbugs::Package::_get_valid_version_info_from_db(packages => $args{packages},
79 for my $package (keys %{$packages}) {
81 Debbugs::Package->new(%{$packages->{$package}},
83 package_collection => $self->universe,
84 correspondent_collection =>
85 $self->correspondent_collection->universe,
90 for my $package (make_list($args{packages})) {
92 Debbugs::Package->new(name => $package,
93 package_collection => $self->universe,
94 correspondent_collection =>
95 $self->correspondent_collection->universe,
102 sub add_packages_and_versions {
104 $self->add($self->_member_constructor(packages => \@_));
107 # state $common_dists = [@{$config{distributions}}];
108 # sub _get_packages {
110 # my $s = $args{schema};
112 # my %src_ver_packages;
114 # my %bin_ver_packages;
115 # # split packages into src/ver, bin/ver, src, and bin so we can select them
116 # # from the database
118 # for my $pkg (@{$args{packages}}) {
120 # if ($pkg->[0] =~ /^src:(.+)$/) {
121 # for my $ver (@{$pkg}[1..$#{$pkg}]) {
122 # $src_ver_packages{$1}{$ver} = 1;
125 # for my $ver (@{$pkg}[1..$#{$pkg}]) {
126 # $bin_ver_packages{$pkg->[0]}{$ver} = 1;
129 # } elsif ($pkg =~ /^src:(.+)$/) {
130 # $src_packages{$1} = 1;
132 # $bin_packages{$pkg} = 1;
135 # my @src_ver_search;
136 # for my $sp (keys %src_ver_packages) {
137 # push @src_ver_search,
138 # (-and => {'src_pkg.pkg' => $sp,
139 # 'me.ver' => [keys %{$src_ver_packages{$sp}}],
144 # my $src_rs = $s->resultset('SrcVer')->
145 # search({-or => [-and => {'src_pkg.pkg' => [keys %src_packages],
146 # -or => {'suite.codename' => $common_dists,
147 # 'suite.suite_name' => $common_dists,
153 # {join => ['src_pkg',
154 # {'src_associations' => 'suite'},
156 # '+select' => [qw(src_pkg.pkg),
157 # qw(suite.codename),
158 # qw(src_associations.modified),
159 # q(CONCAT(src_pkg.pkg,'/',me.ver))],
160 # '+as' => [qw(src_pkg_name codename modified_time src_pkg_ver)],
161 # result_class => 'DBIx::Class::ResultClass::HashRefInflator',
162 # order_by => {-desc => 'me.ver'}
165 # while (my $pkg = $src_rs->next) {
166 # my $n = 'src:'.$pkg->{src_pkg_name};
167 # if (exists $packages{$n}) {
168 # push @{$packages{$n}{versions}},
169 # $pkg->{src_pkg_ver};
170 # if (defined $pkg->{codename}) {
171 # push @{$packages{$n}{dists}{$pkg->{codename}}},
172 # $#{$packages{$n}{versions}};
176 # {name => $pkg->{src_pkg_name},
179 # versions => [$pkg->{src_pkg_ver}],
180 # dists => {defined $pkg->{codename}?($pkg->{codename} => [1]):()},
188 return $_[1]->qualified_name;
191 has 'correspondent_collection' =>
193 isa => 'Debbugs::Collection::Correspondent',
194 default => sub {Debbugs::Collection::Correspondent->new()},
199 isa => 'Debbugs::VersionTree',
201 builder => '_build_versiontree',
204 sub _build_versiontree {
206 return Debbugs::VersionTree->new($self->has_schema?(schema => $self->schema):());
210 sub get_source_versions_distributions {
214 $self->apply(sub {$_->get_source_version_distribution(@_)});
216 Debbugs::Collection::Version->new(versions => \@return,
217 $self->has_schema?(schema => $self->schema):(),
218 package_collection => $self->universe,
222 # given a list of binary versions or src/versions, returns all of the versions
223 # in this package collection which are known to match. You'll have to be sure to
224 # load appropriate versions beforehand for this to actually work.
225 sub get_source_versions {
230 if ($ver =~ m{(<src>.+?)/(?<ver>.+)$/}) {
231 my $sp = $self->get_or_create('src:'.$+{src});
233 $sp->get_source_version($ver);
237 for my $p ($self->members) {
241 $p->get_source_version($ver);
248 if (not $found_valid) {
250 Debbugs::Version::Binary->new(version => $ver,
251 package_collection => $self->universe,
253 $self->has_schema?(schema => $self->schema):(),
259 Debbugs::Collection::Version->new(versions => \@return,
260 $self->has_schema?(schema => $self->schema):(),
261 package_collection => $self->universe,
266 __PACKAGE__->meta->make_immutable;
272 # indent-tabs-mode: nil
273 # cperl-indent-level: 4