lib/Debbugs/Collection/Version.pm

   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
   4 # information.
   5 # Copyright 2018 by Don Armstrong <don@donarmstrong.com>.
   6
   7 package Debbugs::Collection::Version;
   8
   9 =head1 NAME
  10
  11 Debbugs::Collection::Version -- Version generation factory
  12
  13 =head1 SYNOPSIS
  14
  15 This collection extends L<Debbugs::Collection> and contains members of
  16 L<Debbugs::Version>. Useful for any field which contains package versions.
  17
  18
  19 =head1 DESCRIPTION
  20
  21
  22
  23 =cut
  24
  25 use Mouse;
  26 use strictures 2;
  27 use v5.10; # for state
  28 use namespace::autoclean;
  29 use Debbugs::Common qw(make_list hash_slice);
  30 use Debbugs::Config qw(:config);
  31 use Debbugs::OOTypes;
  32 use Debbugs::Version;
  33
  34 use List::AllUtils qw(part);
  35
  36 extends 'Debbugs::Collection';
  37
  38 =head2 my $bugs = Debbugs::Collection::version->new(%params|$param)
  39
  40 Parameters in addition to those defined by L<Debbugs::Collection>
  41
  42 =over
  43
  44 =item package_collection
  45
  46 Optional L<Debbugs::Collection::Package> which is used to look up packages
  47
  48 =item versions
  49
  50 Optional arrayref of C<package/version/arch> string triples
  51
  52 =back
  53
  54 =cut
  55
  56 has '+members' => (isa => 'ArrayRef[Debbugs::Version]');
  57
  58 has 'package_collection' =>
  59     (is => 'ro',
  60      isa => 'Debbugs::Collection::Package',
  61      builder => '_build_package_collection',
  62      lazy => 1,
  63     );
  64
  65 sub _build_package_collection {
  66     my $self = shift;
  67     return Debbugs::Collection::Package->new($self->schema_argument);
  68 }
  69
  70 sub member_key {
  71     my ($self,$v) = @_;
  72     confess("v not defined") unless defined $v;
  73     return $v->package.'/'.$v->version.'/'.$v->arch;
  74 }
  75
  76
  77 around add_by_key => sub {
  78     my $orig = shift;
  79     my $self = shift;
  80     my @members =
  81         $self->_member_constructor(versions => [@_]);
  82     return $self->$orig(@members);
  83 };
  84
  85 sub _member_constructor {
  86     my $self = shift;
  87     my %args = @_;
  88     my @return;
  89     for my $pkg_ver_arch (make_list($args{versions})) {
  90         my ($pkg,$ver,$arch) = $pkg_ver_arch =~ m{^([^/]+)/([^/]+)/?([^/]*)$} or
  91             confess("Invalid version key: $pkg_ver_arch");
  92         if ($pkg =~ s/^src://) {
  93             $arch = 'source';
  94         }
  95         if (not length $arch) {
  96             $arch = 'any';
  97         }
  98         if ($arch eq 'source') {
  99             push @return,
 100                 Debbugs::Version::Source->
 101                     new($self->schema_argument,
 102                         package => $pkg,
 103                         version => $ver,
 104                        );
 105         } else {
 106             push @return,
 107                 Debbugs::Version::Binary->
 108                     new($self->schema_argument,
 109                         package => $pkg,
 110                         version => $ver,
 111                         arch => [$arch],
 112                        );
 113         }
 114     }
 115     return @return;
 116 }
 117
 118 =head2 $versions->universe
 119
 120 Unlike most collections, Debbugs::Collection::Version do not have a universe.
 121
 122 =cut
 123
 124 sub universe {
 125     return $_[0];
 126 }
 127
 128 =head2 $versions->source
 129
 130 Returns a (potentially duplicated) list of source packages which are part of
 131 this version collection
 132
 133 =cut
 134
 135 sub source {
 136     my $self = shift;
 137     return $self->map(sub{$_->source});
 138 }
 139
 140 __PACKAGE__->meta->make_immutable;
 141
 142 1;
 143
 144 __END__
 145 # Local Variables:
 146 # indent-tabs-mode: nil
 147 # cperl-indent-level: 4
 148 # End: