--- /dev/null
+# This module is part of debbugs, and
+# is released under the terms of the GPL version 2, or any later
+# version (at your option). See the file README and COPYING for more
+# information.
+# Copyright 2018 by Don Armstrong <don@donarmstrong.com>.
+
+package Debbugs::Collection::Package;
+
+=head1 NAME
+
+Debbugs::Collection::Package -- Package generation factory
+
+=head1 SYNOPSIS
+
+This collection extends L<Debbugs::Collection> and contains members of
+L<Debbugs::Package>. Useful for any field which contains one or more package or
+tracking lists of packages
+
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use Mouse;
+use strictures 2;
+use v5.10; # for state
+use namespace::autoclean;
+
+use Carp;
+use Debbugs::Common qw(make_list hash_slice);
+use Debbugs::Config qw(:config);
+use Debbugs::OOTypes;
+use Debbugs::Package;
+
+use List::AllUtils qw(part);
+
+use Debbugs::Version::Binary;
+use Debbugs::Collection::Version;
+use Debbugs::Collection::Correspondent;
+use Debbugs::VersionTree;
+
+extends 'Debbugs::Collection';
+
+=head1 Object Creation
+
+=head2 my $packages = Debbugs::Collection::Package->new(%params|$param)
+
+Parameters in addition to those defined by L<Debbugs::Collection>
+
+=over
+
+=item correspondent_collection
+
+Optional L<Debbugs::Collection::Correspondent> which is used to look up correspondents
+
+
+=item versiontree
+
+Optional L<Debbugs::VersionTree> which contains known package source versions
+
+=back
+
+=head1 Methods
+
+=head2 correspondent_collection
+
+ $packages->correspondent_collection
+
+Returns the L<Debbugs::Collection::Correspondent> for this package collection
+
+=head2 versiontree
+
+Returns the L<Debbugs::VersionTree> for this package collection
+
+=cut
+
+has '+members' => (isa => 'ArrayRef[Debbugs::Package]');
+
+sub BUILD {
+ my $self = shift;
+ my $args = shift;
+ if (exists $args->{packages}) {
+ $self->
+ add($self->_member_constructor(packages =>
+ $args->{packages}));
+ }
+}
+
+around add_by_key => sub {
+ my $orig = shift;
+ my $self = shift;
+ my @members =
+ $self->_member_constructor(packages => [@_]);
+ return $self->$orig(@members);
+};
+
+sub _member_constructor {
+ # handle being called $self->_member_constructor;
+ my $self = shift;
+ my %args = @_;
+ my $schema;
+ if ($self->has_schema) {
+ $schema = $self->schema;
+ }
+ my @return;
+ if (defined $schema) {
+ if (not ref($args{packages}) or @{$args{packages}} == 1 and
+ $self->universe->count() > 0
+ ) {
+ carp("Likely inefficiency; member_constructor called with one argument");
+ }
+ my $packages =
+ Debbugs::Package::_get_valid_version_info_from_db(packages => $args{packages},
+ schema => $schema,
+ );
+ for my $package (keys %{$packages}) {
+ push @return,
+ Debbugs::Package->new(%{$packages->{$package}},
+ schema => $schema,
+ package_collection => $self->universe,
+ correspondent_collection =>
+ $self->correspondent_collection->universe,
+ );
+ }
+ } else {
+ for my $package (make_list($args{packages})) {
+ push @return,
+ Debbugs::Package->new(name => $package,
+ package_collection => $self->universe,
+ correspondent_collection =>
+ $self->correspondent_collection->universe,
+ );
+ }
+ }
+ return @return;
+}
+
+sub add_packages_and_versions {
+ my $self = shift;
+ $self->add($self->_member_constructor(packages => \@_));
+}
+
+
+sub member_key {
+ return $_[1]->qualified_name;
+}
+
+has 'correspondent_collection' =>
+ (is => 'ro',
+ isa => 'Debbugs::Collection::Correspondent',
+ default => sub {Debbugs::Collection::Correspondent->new()},
+ );
+
+has 'versiontree' =>
+ (is => 'ro',
+ isa => 'Debbugs::VersionTree',
+ lazy => 1,
+ builder => '_build_versiontree',
+ );
+
+sub _build_versiontree {
+ my $self = shift;
+ return Debbugs::VersionTree->new($self->has_schema?(schema => $self->schema):());
+}
+
+=head2 get_source_versions_distributions
+
+ $packages->get_source_versions_distributions('unstable')
+
+Given a list of distributions or suites, returns a
+L<Debbugs::Collection::Version> of all of the versions in this package
+collection which are known to match.
+
+Effectively, this calls L<Debbugs::Package/get_source_version_distribution> for
+each package in the collection and merges the results and returns them
+
+=cut
+
+sub get_source_versions_distributions {
+ my $self = shift;
+ my @return;
+ push @return,
+ $self->map(sub {$_->get_source_version_distribution(@_)});
+ if (@return > 1) {
+ return $return[0]->combine($return[1..$#return]);
+ }
+ return @return;
+}
+
+
+=head2 get_source_versions
+
+ $packages->get_source_versions('1.2.3-1','foo/1.2.3-5')
+
+Given a list of binary versions or src/versions, returns a
+L<Debbugs::Collection::Version> of all of the versions in this package
+collection which are known to match.
+
+If you give a binary version ('1.2.3-1'), you must have already loaded source
+packages into this package collection for it to find an appropriate match.
+
+If no package is known to match, an version which is invalid will be returned
+
+For fully qualified versions this loads the appropriate source package into the
+universe of this collection and calls L<Debbugs::Package/get_source_version>.
+For unqualified versions, calls L<Debbugs::Package/get_source_version>; if no
+valid versions are returned, creates an invalid version.
+
+=cut
+
+sub get_source_versions {
+ my $self = shift;
+ my @return;
+ for my $ver (@_) {
+ my $sv;
+ if ($ver =~ m{(?<src>.+?)/(?<ver>.+)$}) {
+ my $sp = $self->universe->
+ get_or_add_by_key('src:'.$+{src});
+ push @return,
+ $sp->get_source_version($+{ver});
+ next;
+ } else {
+ my $found_valid = 0;
+ for my $p ($self->members) {
+ local $_;
+ my @vs =
+ grep {$_->is_valid}
+ $p->get_source_version($ver);
+ if (@vs) {
+ $found_valid = 1;
+ push @return,@vs;
+ next;
+ }
+ }
+ if (not $found_valid) {
+ push @return,
+ Debbugs::Version::Binary->new(version => $ver,
+ package_collection => $self->universe,
+ valid => 0,
+ $self->schema_argument,
+ );
+ }
+ }
+ }
+ return
+ Debbugs::Collection::Version->new(members => \@return,
+ $self->schema_argument,
+ package_collection => $self->universe,
+ );
+}
+
+=head2 source_names
+
+ $packages->source_names()
+
+Returns a unique list of source names from all members of this collection by
+calling L<Debbugs::Package/source_names> on each member.
+
+=cut
+
+sub source_names {
+ my $self = shift;
+ local $_;
+ return uniq map {$_->source_names} $self->members;
+}
+
+=head2 sources
+
+ $packages->sources()
+
+Returns a L<Debbugs::Collection::Package> limited to source packages
+corresponding to all packages in this collection
+
+=cut
+
+sub sources {
+ my $self = shift;
+ return $self->universe->limit($self->source_names);
+}
+
+
+__PACKAGE__->meta->make_immutable;
+no Mouse;
+
+1;
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
projects / debbugs.git / blobdiff