Debbugs/Collection/Package.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::Package;
   8
   9 =head1 NAME
  10
  11 Debbugs::Collection::Package -- Package generation factory
  12
  13 =head1 SYNOPSIS
  14
  15
  16 =head1 DESCRIPTION
  17
  18
  19
  20 =cut
  21
  22 use Mouse;
  23 use strictures 2;
  24 use v5.10; # for state
  25 use namespace::autoclean;
  26
  27 use Carp;
  28 use Debbugs::Common qw(make_list hash_slice);
  29 use Debbugs::Config qw(:config);
  30 use Debbugs::OOTypes;
  31 use Debbugs::Package;
  32
  33 use List::AllUtils qw(part);
  34
  35 use Debbugs::Version::Binary;
  36 use Debbugs::Collection::Version;
  37 use Debbugs::Collection::Correspondent;
  38 use Debbugs::VersionTree;
  39
  40 extends 'Debbugs::Collection';
  41
  42 has '+members' => (isa => 'ArrayRef[Debbugs::Package]');
  43
  44 sub BUILD {
  45     my $self = shift;
  46     my $args = shift;
  47     if (exists $args->{packages}) {
  48         $self->
  49             add($self->_member_constructor(packages =>
  50                                            $args->{packages}));
  51     }
  52 }
  53
  54 around add_by_key => sub {
  55     my $orig = shift;
  56     my $self = shift;
  57     my @members =
  58         $self->_member_constructor(packages => [@_]);
  59     return $self->$orig(@members);
  60 };
  61
  62 sub _member_constructor {
  63     # handle being called $self->_member_constructor;
  64     my $self = shift;
  65     my %args = @_;
  66     my $schema;
  67     if ($self->has_schema) {
  68         $schema = $self->schema;
  69     }
  70     my @return;
  71     if (defined $schema) {
  72         my $packages =
  73             Debbugs::Package::_get_valid_version_info_from_db(packages => $args{packages},
  74                                                               schema => $schema,
  75                                                              );
  76         for my $package (keys %{$packages}) {
  77             push @return,
  78                 Debbugs::Package->new(%{$packages->{$package}},
  79                                       schema => $schema,
  80                                       package_collection => $self->universe,
  81                                       correspondent_collection =>
  82                                       $self->correspondent_collection->universe,
  83                                      );
  84         }
  85     } else {
  86         carp "No schema\n";
  87         for my $package (make_list($args{packages})) {
  88             push @return,
  89                 Debbugs::Package->new(name => $package,
  90                                       package_collection => $self->universe,
  91                                       correspondent_collection =>
  92                                       $self->correspondent_collection->universe,
  93                                      );
  94         }
  95     }
  96     return @return;
  97 }
  98
  99 sub add_packages_and_versions {
 100     my $self = shift;
 101     $self->add($self->_member_constructor(packages => \@_));
 102 }
 103
 104 # state $common_dists = [@{$config{distributions}}];
 105 # sub _get_packages {
 106 #     my %args = @_;
 107 #     my $s = $args{schema};
 108 #     my %src_packages;
 109 #     my %src_ver_packages;
 110 #     my %bin_packages;
 111 #     my %bin_ver_packages;
 112 #     # split packages into src/ver, bin/ver, src, and bin so we can select them
 113 #     # from the database
 114 #     local $_;
 115 #     for my $pkg (@{$args{packages}}) {
 116 #         if (ref($pkg)) {
 117 #             if ($pkg->[0] =~ /^src:(.+)$/) {
 118 #                 for my $ver (@{$pkg}[1..$#{$pkg}]) {
 119 #                     $src_ver_packages{$1}{$ver} = 1;
 120 #                 }
 121 #             } else {
 122 #                 for my $ver (@{$pkg}[1..$#{$pkg}]) {
 123 #                     $bin_ver_packages{$pkg->[0]}{$ver} = 1;
 124 #                 }
 125 #             }
 126 #         } elsif ($pkg =~ /^src:(.+)$/) {
 127 #             $src_packages{$1} = 1;
 128 #         } else {
 129 #             $bin_packages{$pkg} = 1;
 130 #         }
 131 #     }
 132 #     my @src_ver_search;
 133 #     for my $sp (keys %src_ver_packages) {
 134 #         push @src_ver_search,
 135 #             (-and => {'src_pkg.pkg' => $sp,
 136 #                       'me.ver' => [keys %{$src_ver_packages{$sp}}],
 137 #                      },
 138 #              );
 139 #     }
 140 #     my %packages;
 141 #     my $src_rs = $s->resultset('SrcVer')->
 142 #         search({-or => [-and => {'src_pkg.pkg' => [keys %src_packages],
 143 #                                  -or => {'suite.codename' => $common_dists,
 144 #                                          'suite.suite_name' => $common_dists,
 145 #                                         },
 146 #                                 },
 147 #                         @src_ver_search,
 148 #                        ],
 149 #                },
 150 #               {join => ['src_pkg',
 151 #                         {'src_associations' => 'suite'},
 152 #                        ],
 153 #                '+select' => [qw(src_pkg.pkg),
 154 #                              qw(suite.codename),
 155 #                              qw(src_associations.modified),
 156 #                              q(CONCAT(src_pkg.pkg,'/',me.ver))],
 157 #                '+as' => [qw(src_pkg_name codename modified_time src_pkg_ver)],
 158 #                result_class => 'DBIx::Class::ResultClass::HashRefInflator',
 159 #                order_by => {-desc => 'me.ver'}
 160 #               },
 161 #               );
 162 #     while (my $pkg = $src_rs->next) {
 163 #         my $n = 'src:'.$pkg->{src_pkg_name};
 164 #         if (exists $packages{$n}) {
 165 #             push @{$packages{$n}{versions}},
 166 #                 $pkg->{src_pkg_ver};
 167 #             if (defined $pkg->{codename}) {
 168 #                 push @{$packages{$n}{dists}{$pkg->{codename}}},
 169 #                     $#{$packages{$n}{versions}};
 170 #             }
 171 #         } else {
 172 #             $packages{$n} =
 173 #            {name => $pkg->{src_pkg_name},
 174 #             type => 'source',
 175 #             valid => 1,
 176 #             versions => [$pkg->{src_pkg_ver}],
 177 #             dists => {defined $pkg->{codename}?($pkg->{codename} => [1]):()},
 178 #            };
 179 #         }
 180 #     }
 181 #     return \%packages;
 182 # }
 183
 184 sub member_key {
 185     return $_[1]->name;
 186 }
 187
 188 has 'correspondent_collection' =>
 189     (is => 'ro',
 190      isa => 'Debbugs::Collection::Correspondent',
 191      default => sub {Debbugs::Collection::Correspondent->new()},
 192     );
 193
 194 has 'versiontree' =>
 195     (is => 'ro',
 196      isa => 'Debbugs::VersionTree',
 197      lazy => 1,
 198      builder => '_build_versiontree',
 199     );
 200
 201 sub _build_versiontree {
 202     my $self = shift;
 203     return Debbugs::VersionTree->new($self->has_schema?(schema => $self->schema):());
 204 }
 205
 206
 207 sub get_source_versions_distributions {
 208     my $self = shift;
 209     my @return;
 210     push @return,
 211             $self->apply(sub {$_->get_source_version_distribution(@_)});
 212     return
 213         Debbugs::Collection::Version->new(versions => \@return,
 214                                           $self->has_schema?(schema => $self->schema):(),
 215                                           package_collection => $self->universe,
 216                                          );
 217 }
 218
 219 # given a list of binary versions or src/versions, returns all of the versions
 220 # in this package collection which are known to match. You'll have to be sure to
 221 # load appropriate versions beforehand for this to actually work.
 222 sub get_source_versions {
 223     my $self = shift;
 224     my @return;
 225     for my $ver (@_) {
 226         my $sv;
 227         if ($ver =~ m{(<src>.+?)/(?<ver>.+)$/}) {
 228             my $sp = $self->get_or_create('src:'.$+{src});
 229             push @return,
 230                 $sp->get_source_version($ver);
 231            next;
 232         } else {
 233             my $found_valid = 0;
 234             for my $p ($self->members) {
 235                 local $_;
 236                 my @vs =
 237                     grep {$_->is_valid}
 238                     $p->get_source_version($ver);
 239                 if (@vs) {
 240                     $found_valid = 1;
 241                     push @return,@vs;
 242                     next;
 243                 }
 244             }
 245             if (not $found_valid) {
 246                 push @return,
 247                     Debbugs::Version::Binary->new(version => $ver,
 248                                                   package_collection => $self->universe,
 249                                                   valid => 0,
 250                                                   $self->has_schema?(schema => $self->schema):(),
 251                                                  );
 252             }
 253         }
 254     }
 255     return
 256         Debbugs::Collection::Version->new(versions => \@return,
 257                                           $self->has_schema?(schema => $self->schema):(),
 258                                           package_collection => $self->universe,
 259                                          );
 260 }
 261
 262
 263 __PACKAGE__->meta->make_immutable;
 264
 265 1;
 266
 267 __END__
 268 # Local Variables:
 269 # indent-tabs-mode: nil
 270 # cperl-indent-level: 4
 271 # End: