X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lib%2FDebbugs%2FCollection%2FPackage.pm;fp=lib%2FDebbugs%2FCollection%2FPackage.pm;h=055cbaeb6e052b8047f5791596602a9b87ac6eda;hb=1e6633a3780f4fd53fc4303852e84d13cdad2dc6;hp=0000000000000000000000000000000000000000;hpb=466f7faff129a5699c7674f59900a92aa256175d;p=debbugs.git diff --git a/lib/Debbugs/Collection/Package.pm b/lib/Debbugs/Collection/Package.pm new file mode 100644 index 0000000..055cbae --- /dev/null +++ b/lib/Debbugs/Collection/Package.pm @@ -0,0 +1,293 @@ +# 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 . + +package Debbugs::Collection::Package; + +=head1 NAME + +Debbugs::Collection::Package -- Package generation factory + +=head1 SYNOPSIS + +This collection extends L and contains members of +L. 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 + +=over + +=item correspondent_collection + +Optional L which is used to look up correspondents + + +=item versiontree + +Optional L which contains known package source versions + +=back + +=head1 Methods + +=head2 correspondent_collection + + $packages->correspondent_collection + +Returns the L for this package collection + +=head2 versiontree + +Returns the L 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 of all of the versions in this package +collection which are known to match. + +Effectively, this calls L 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 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. +For unqualified versions, calls L; 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{(?.+?)/(?.+)$}) { + 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 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 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: