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 (not length $arch) {
  93             if ($pkg =~ /^src:/) {
  94                 $arch = 'source';
  95             } else {
  96                $arch = 'any';
  97             }
  98         }
  99         if ($arch eq 'source') {
 100             push @return,
 101                 Debbugs::Version::Source->
 102                     new($self->schema_argument,
 103                         package => $pkg,
 104                         version => $ver,
 105                        );
 106         } else {
 107             push @return,
 108                 Debbugs::Version::Binary->
 109                     new($self->schema_argument,
 110                         package => $pkg,
 111                         version => $ver,
 112                         arch => [$arch],
 113                        );
 114         }
 115     }
 116     return @return;
 117 }
 118
 119 =head2 $versions->universe
 120
 121 Unlike most collections, Debbugs::Collection::Version do not have a universe.
 122
 123 =cut
 124
 125 sub universe {
 126     return $_[0];
 127 }
 128
 129 =head2 $versions->source
 130
 131 Returns a (potentially duplicated) list of source packages which are part of
 132 this version collection
 133
 134 =cut
 135
 136 sub source {
 137     my $self = shift;
 138     return $self->map(sub{$_->source});
 139 }
 140
 141 __PACKAGE__->meta->make_immutable;
 142
 143 1;
 144
 145 __END__
 146 # Local Variables:
 147 # indent-tabs-mode: nil
 148 # cperl-indent-level: 4
 149 # End: