Debbugs/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::Version;
   8
   9 =head1 NAME
  10
  11 Debbugs::Version -- OO interface to Version
  12
  13 =head1 SYNOPSIS
  14
  15    use Debbugs::Version;
  16    Debbugs::Version->new(schema => $s,binaries => [qw(foo)],sources => [qw(bar)]);
  17
  18 =head1 DESCRIPTION
  19
  20
  21
  22 =cut
  23
  24 use Mouse;
  25 use v5.10;
  26 use strictures 2;
  27 use namespace::autoclean;
  28
  29 use Debbugs::Config qw(:config);
  30 use Debbugs::Collection::Package;
  31 use Debbugs::OOTypes;
  32 use Carp;
  33
  34 extends 'Debbugs::OOBase';
  35
  36 state $strong_severities =
  37    {map {($_,1)} @{$config{strong_severities}}};
  38
  39 has version => (is => 'ro', isa => 'Str',
  40                 required => 1,
  41                 builder => '_build_version',
  42                 predicate => '_has_version',
  43                );
  44
  45 sub type {
  46     confess("Subclass must define type");
  47 }
  48
  49 has package => (is => 'bare',
  50                 isa => 'Debbugs::Package',
  51                 lazy => 1,
  52                 builder => '_build_package',
  53                );
  54
  55 around BUILDARGS => sub {
  56     my $orig = shift;
  57     my $class = shift;
  58     my %args;
  59     if (@_==1 and ref($_[0]) eq 'HASH') {
  60         %args = %{$_[0]};
  61     } else {
  62         %args = @_;
  63     }
  64     carp("No schema") unless exists $args{schema};
  65     if (exists $args{package} and
  66         not blessed($args{package})) {
  67         # OK, need a package Collection
  68         my $pkgc = $args{package_collection} //
  69             Debbugs::Collection::Package->
  70                 new(exists $args{schema}?(schema => $args{schema}):());
  71         $args{package} =
  72             $pkgc->universe->get_or_create($args{package});
  73     }
  74     return $class->$orig(%args);
  75 };
  76
  77
  78 sub _build_package {
  79     my $self = shift;
  80     return Debbugs::Package->new(package => '(unknown)',
  81                                  type => $self->type,
  82                                  valid => 0,
  83                                  package_collection => $self->package_collection,
  84                                  $self->has_schema?(schema => $self->schema):(),
  85                                 );
  86 }
  87
  88
  89 has valid => (is => 'ro',
  90               isa => 'Bool',
  91               default => 0,
  92               reader => 'is_valid',
  93              );
  94
  95 has 'package_collection' => (is => 'ro',
  96                              isa => 'Debbugs::Collection::Package',
  97                              builder => '_build_package_collection',
  98                              lazy => 1,
  99                             );
 100 sub _build_package_collection {
 101     my $self = shift;
 102     return Debbugs::Collection::Package->new($self->schema_arg)
 103 }
 104
 105
 106 __PACKAGE__->meta->make_immutable;
 107 no Mouse;
 108 1;
 109
 110
 111 __END__
 112 # Local Variables:
 113 # indent-tabs-mode: nil
 114 # cperl-indent-level: 4
 115 # End: