1 # This module is part of debbugs, and
2 # is released under the terms of the GPL version 3, 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::Package;
11 Debbugs::Package -- OO interface to packages
16 Debbugs::Package->new(schema => $s,binaries => [qw(foo)],sources => [qw(bar)]);
26 use v5.10; # for state
27 use namespace::autoclean;
29 use List::AllUtils qw(uniq pairmap);
30 use Debbugs::Config qw(:config);
31 use Debbugs::Version::Source;
32 use Debbugs::Version::Binary;
34 extends 'Debbugs::OOBase';
36 has name => (is => 'ro', isa => 'Str',
40 has type => (is => 'bare', isa => 'Str',
42 builder => '_build_type',
43 clearer => '_clear_type',
45 writer => '_set_type',
50 if ($self->name !~ /^src:/) {
58 # src: if source, nothing if binary
59 ($self->_type eq 'source' ? 'src:':'') .
65 return $config{web_domain}.'/'.$self->qualified_name;
68 around BUILDARGS => sub {
72 if (@_==1 and ref($_[0]) eq 'HASH') {
77 $args{name} //= '(unknown)';
78 if ($args{name} =~ /src:(.+)/) {
80 $args{type} = 'source';
82 $args{type} = 'binary' unless
85 return $class->$orig(%args);
89 return $_[0]->_type eq 'source'
93 return $_[0]->_type eq 'binary'
96 has valid => (is => 'ro', isa => 'Bool',
98 builder => '_build_valid',
99 writer => '_set_valid',
104 if ($self->_valid_versioninfo > 0) {
110 # this contains source name, source version, binary name, binary version, arch,
111 # and dist which have been selected from the database. It is used to build
112 # versions and anything else which are known as required.
113 has 'valid_version_info' =>
114 (is => 'bare', isa => 'ArrayRef',
117 builder => '_build_valid_versioninfo',
118 predicate => '_has_valid_versioninfo',
119 clearer => '_clear_valid_versioninfo',
120 handles => {'_get_valid_versioninfo' => 'get',
121 '_grep_valid_versioninfo' => 'grep',
122 '_valid_versioninfo' => 'elements',
126 sub _build_valid_versioninfo {
128 my $pkgs = $self->_get_valid_version_info_from_db;
129 for my $invalid_version (@{$pkgs->{$self->qualified_name}->{invalid_versions}}) {
130 $self->_mark_invalid_version($invalid_version,1);
132 return $pkgs->{$self->qualified_name}->{valid_version_info} // [];
135 state $common_dists = [@{$config{distributions}}];
136 sub _get_valid_version_info_from_db {
138 if ((@_ % 2) == 1 and
146 if ($self->has_schema) {
151 @packages = $self->qualified_name;
154 @packages = @{$args{packages}};
156 if (not defined $s) {
157 confess("get_info_from_db not implemented without schema");
160 my %src_ver_packages;
162 my %bin_ver_packages;
163 # split packages into src/ver, bin/ver, src, and bin so we can select them
166 for my $pkg (@packages) {
168 if ($pkg->[0] =~ /^src:(.+)$/) {
169 for my $ver (@{$pkg}[1..$#{$pkg}]) {
170 $src_ver_packages{$1}{$ver} = 0;
173 for my $ver (@{$pkg}[1..$#{$pkg}]) {
174 $bin_ver_packages{$pkg->[0]}{$ver} = 0;
177 } elsif ($pkg =~ /^src:(.+)$/) {
178 $src_packages{$1} = 0;
180 $bin_packages{$pkg} = 0;
183 # calculate searches for packages where we want specific versions. We
184 # calculate this here so add_result_to_package can stomp over
185 # %src_ver_packages and %bin_ver_packages
187 for my $sp (keys %src_ver_packages) {
188 push @src_ver_search,
189 (-and => {'src_pkg.pkg' => $sp,
190 'me.ver' => [keys %{$src_ver_packages{$sp}}],
196 for my $sp (keys %bin_ver_packages) {
197 push @bin_ver_search,
198 (-and => {'bin_pkg.pkg' => $sp,
199 'me.ver' => [keys %{$bin_ver_packages{$sp}}],
204 sub _default_pkg_info {
205 return {name => $_[0],
206 type => $_[1]//'source',
208 valid_version_info => [],
209 invalid_versions => {},
212 sub add_result_to_package {
213 my ($pkgs,$rs,$svp,$bvp,$sp,$bp) = @_;
214 while (my $pkg = $rs->next) {
215 my $n = 'src:'.$pkg->{src_pkg};
216 if (not exists $pkgs->{$n}) {
218 _default_pkg_info($pkg->{src_pkg});
220 push @{$pkgs->{$n}{valid_version_info}},
222 $n = $pkg->{bin_pkg};
223 if (not exists $pkgs->{$n}) {
225 _default_pkg_info($pkg->{bin_pkg},'binary');
227 push @{$pkgs->{$n}{valid_version_info}},
229 # this is a package with a valid src_ver
230 $svp->{$pkg->{src_pkg}}{$pkg->{src_ver}}++;
231 $sp->{$pkg->{src_pkg}}++;
232 # this is a package with a valid bin_ver
233 $bvp->{$pkg->{bin_pkg}}{$pkg->{bin_ver}}++;
234 $bp->{$pkg->{bin_pkg}}++;
237 if (keys %src_packages) {
238 my $src_rs = $s->resultset('SrcVer')->
239 search({-or => [-and => {'src_pkg.pkg' => [keys %src_packages],
240 -or => {'suite.codename' => $common_dists,
241 'suite.suite_name' => $common_dists,
249 'src_associations' => 'suite'},
251 'bin_vers' => ['bin_pkg','arch']},
254 'select' => [qw(src_pkg.pkg),
256 qw(suite.suite_name),
257 qw(src_associations.modified),
259 q(CONCAT(src_pkg.pkg,'/',me.ver)),
260 qw(bin_vers.ver bin_pkg.pkg arch.arch),
263 'as' => [qw(src_pkg codename suite_name),
264 qw(modified_time src_ver src_pkg_ver),
265 qw(bin_ver bin_pkg arch maintainer),
267 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
270 add_result_to_package($packages,$src_rs,
277 if (keys %bin_packages) {
279 $s->resultset('BinAssociation')->
280 search({-and => {'bin_pkg.pkg' => [keys %bin_packages],
281 -or => {'suite.codename' => $common_dists,
282 'suite.suite_name' => $common_dists,
286 [{'src_ver' => ['src_pkg',
293 'select' => [qw(src_pkg.pkg),
295 qw(suite.suite_name),
298 q(CONCAT(src_pkg.pkg,'/',src_ver.ver)),
299 qw(bin.ver bin_pkg.pkg arch.arch),
302 'as' => [qw(src_pkg codename suite_name),
303 qw(modified_time src_ver src_pkg_ver),
304 qw(bin_ver bin_pkg arch maintainer),
306 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
309 add_result_to_package($packages,$bin_assoc_rs,
316 if (@bin_ver_search) {
317 my $bin_rs = $s->resultset('BinVer')->
318 search({-or => [@bin_ver_search,
323 'bin_associations' => 'suite'},
324 {'src_ver' => ['src_pkg',
329 'select' => [qw(src_pkg.pkg),
331 qw(suite.suite_name),
332 qw(bin_associations.modified),
334 q(CONCAT(src_pkg.pkg,'/',src_ver.ver)),
335 qw(me.ver bin_pkg.pkg arch.arch),
338 'as' => [qw(src_pkg codename suite_name),
339 qw(modified_time src_ver src_pkg_ver),
340 qw(bin_ver bin_pkg arch maintainer),
342 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
345 add_result_to_package($packages,$bin_rs,
352 for my $sp (keys %src_ver_packages) {
353 if (not exists $packages->{'src:'.$sp}) {
354 $packages->{'src:'.$sp} =
355 _default_pkg_info($sp,'source',0);
357 for my $sv (keys %{$src_ver_packages{$sp}}) {
358 next if $src_ver_packages{$sp}{$sv} > 0;
359 $packages->{'src:'.$sp}{invalid_versions}{$sv} = 1;
362 for my $bp (keys %bin_ver_packages) {
363 if (not exists $packages->{$bp}) {
365 _default_pkg_info($bp,'binary',0);
367 for my $bv (keys %{$bin_ver_packages{$bp}}) {
368 next if $bin_ver_packages{$bp}{$bv} > 0;
369 $packages->{$bp}{invalid_versions}{$bv} = 1;
372 for my $sp (keys %src_packages) {
373 next if $src_packages{$sp} > 0;
374 $packages->{'src:'.$sp} =
375 _default_pkg_info($sp,'source',0);
377 for my $bp (keys %bin_packages) {
378 next if $bin_packages{$bp} > 0;
380 _default_pkg_info($bp,'binary',0);
385 has 'source_version_to_info' =>
386 (is => 'bare', isa => 'HashRef',
389 builder => '_build_source_version_to_info',
390 handles => {_get_source_version_to_info => 'get',
394 sub _build_source_version_to_info {
398 for my $v ($self->_valid_versioninfo) {
399 push @{$info->{$v->{src_ver}}}, $i;
405 has 'binary_version_to_info' =>
406 (is => 'bare', isa => 'HashRef',
409 builder => '_build_binary_version_to_info',
410 handles => {_get_binary_version_to_info => 'get',
414 sub _build_binary_version_to_info {
418 for my $v ($self->_valid_versioninfo) {
419 push @{$info->{$v->{bin_ver}}}, $i;
425 has 'dist_to_info' =>
426 (is => 'bare', isa => 'HashRef',
429 builder => '_build_dist_to_info',
430 handles => {_get_dist_to_info => 'get',
433 sub _build_dist_to_info {
437 for my $v ($self->_valid_versioninfo) {
438 push @{$info->{$v->{dist}}}, $i;
444 # this is a hashref of versions that we know are invalid
445 has 'invalid_versions' =>
446 (is => 'bare',isa => 'HashRef[Bool]',
449 clearer => '_clear_invalid_versions',
451 handles => {_invalid_version => 'exists',
452 _mark_invalid_version => 'set',
456 has 'binaries' => (is => 'ro',
457 isa => 'Debbugs::Collection::Package',
459 builder => '_build_binaries',
460 predicate => '_has_binaries',
463 sub _build_binaries {
465 if ($self->is_binary) {
466 return $self->package_collection->limit($self);
468 # OK, walk through the valid_versions for this package
470 uniq map {$_->{bin_pkg}} $self->_valid_versioninfo;
471 return $self->package_collection->limit(@binaries);
474 has 'sources' => (is => 'ro',
475 isa => 'Debbugs::Collection::Package',
477 builder => '_build_sources',
478 predicate => '_has_sources',
483 if ($self->is_source) {
484 return $self->package_collection->limit($self);
486 # OK, walk through the valid_versions for this package
488 uniq map {'src:'.$_->{src_pkg_name}} $self->_valid_versioninfo;
489 return $self->package_collection->limit(@sources);
492 has 'versions' => (is => 'bare',
493 isa => 'HashRef[Debbugs::Version]',
495 handles => {_exists_version => 'exists',
496 _get_version => 'get',
497 _set_version => 'set',
500 builder => '_build_versions',
503 sub _build_versions {
515 $self->_set_version(@set);
518 sub get_source_version_distribution {
521 my %src_pkg_vers = @_;
525 $self->_get_dist_to_info($dist);
527 _get_valid_versioninfo(@ver_loc)) {
528 $src_pkg_vers{$v->{src_pkg_ver}} = 1;
531 return $self->package_collection->
532 get_source_versions(keys %src_pkg_vers)->members;
535 # returns the source version(s) corresponding to the version of *this* package; the
536 # version passed may be binary or source, depending.
537 sub get_source_version {
539 if ($self->is_source) {
540 return $self->get_version(@_);
547 ($ver,@archs) = @{$ver};
548 @archs{@archs} = (1) x @archs;
551 @{$self->_get_binary_version_to_info($ver)//[]};
552 next unless @ver_loc;
553 my @vers = map {$self->
554 _get_valid_versioninfo($_)}
558 next unless exists $archs{$v->{arch}};
560 $src_pkg_vers{$v->{src_pkg_ver}} = 1;
563 return $self->package_collection->
564 get_source_versions(keys %src_pkg_vers)->members;
571 if ($self->_exists_version($v)) {
572 push @ret,$self->_get_version($v);
575 $self->_create_version($v);
581 sub _create_version {
584 if ($self->is_source) {
588 Debbugs::Version::Source->
589 new(package => $self,
591 package_collection => $self->package_collection,
592 $self->schema_argument,
599 Debbugs::Version::Binary->
600 new(package => $self,
602 package_collection => $self->package_collection,
603 $self->schema_argument,
607 $self->_set_version(@versions);
610 # gets used to retrieve packages
611 has 'package_collection' => (is => 'ro',
612 isa => 'Debbugs::Collection::Package',
613 builder => '_build_package_collection',
617 sub _build_package_collection {
619 return Debbugs::Collection::Package->new($self->schema_argument)
624 return 'Debbugs::Package={package='.$self->qualified_name.'}';
627 __PACKAGE__->meta->make_immutable;
635 # indent-tabs-mode: nil
636 # cperl-indent-level: 4