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 This package provides a convenient interface to refer to package versions and
  16 potentially make calculations based upon them
  17
  18    use Debbugs::Version;
  19    my $v = Debbugs::Version->new(schema => $s,binaries => [qw(foo)],sources => [qw(bar)]);
  20
  21 =head1 DESCRIPTION
  22
  23
  24
  25 =cut
  26
  27 use Mouse;
  28 use v5.10;
  29 use strictures 2;
  30 use namespace::autoclean;
  31
  32 use Debbugs::Config qw(:config);
  33 use Debbugs::Collection::Package;
  34 use Debbugs::OOTypes;
  35 use Carp;
  36
  37 extends 'Debbugs::OOBase';
  38
  39 =head1 Object Creation
  40
  41 =head2 my $version = Debbugs::Version::Source->new(%params|$param)
  42
  43 or C<Debbugs::Version::Binary->new(%params|$param)> for a binary version
  44
  45 =over
  46
  47 =item schema
  48
  49 L<Debbugs::DB> schema which can be used to look up versions
  50
  51 =item package
  52
  53 String representation of the package
  54
  55 =item pkg
  56
  57 L<Debbugs::Package> which refers to the package given.
  58
  59 Only one of C<package> or C<pkg> should be given
  60
  61 =item package_collection
  62
  63 L<Debbugs::Collection::Package> which is used to generate a L<Debbugs::Package>
  64 object from the package name
  65
  66 =back
  67
  68 =cut
  69
  70 around BUILDARGS => sub {
  71     my $orig = shift;
  72     my $class = shift;
  73     if ($class eq __PACKAGE__) {
  74         confess("You should not be instantiating Debbugs::Version. ".
  75                 "Use Debbugs::Version::Source or ::Binary");
  76     }
  77     my %args;
  78     if (@_==1 and ref($_[0]) eq 'HASH') {
  79         %args = %{$_[0]};
  80     } else {
  81         %args = @_;
  82     }
  83     return $class->$orig(%args);
  84 };
  85
  86
  87
  88 state $strong_severities =
  89    {map {($_,1)} @{$config{strong_severities}}};
  90
  91 =head1 Methods
  92
  93 =head2 version
  94
  95      $version->version
  96
  97 Returns the source or binary package version
  98
  99 =cut
 100
 101 has version => (is => 'ro', isa => 'Str',
 102                 required => 1,
 103                 builder => '_build_version',
 104                 predicate => '_has_version',
 105                );
 106
 107 =head2 type
 108
 109 Returns 'source' if this is a source version, or 'binary' if this is a binary
 110 version.
 111
 112 =cut
 113
 114 =head2 source_version
 115
 116 Returns the source version for this version; if this is a source version,
 117 returns itself.
 118
 119 =cut
 120
 121 =head2 src_pkg_ver
 122
 123 Returns the fully qualified source_package/version string for this version.
 124
 125 =cut
 126
 127 =head2 package
 128
 129 Returns the name of the package that this version is in
 130
 131 =cut
 132
 133 has package => (is => 'ro',
 134                 isa => 'Str',
 135                 builder => '_build_package',
 136                 predicate => '_has_package',
 137                 lazy => 1,
 138                );
 139
 140 sub _build_package {
 141     my $self = shift;
 142     if ($self->_has_pkg) {
 143         return $self->pkg->name;
 144     }
 145     return '(unknown)';
 146 }
 147
 148 =head2 pkg
 149
 150 Returns a L<Debbugs::Package> object corresponding to C<package>.
 151
 152 =cut
 153
 154
 155 has pkg => (is => 'ro',
 156             isa => 'Debbugs::Package',
 157             lazy => 1,
 158             builder => '_build_pkg',
 159             reader => 'pkg',
 160             predicate => '_has_pkg',
 161            );
 162
 163 sub _build_pkg {
 164     my $self = shift;
 165     return Debbugs::Package->new(package => $self->package,
 166                                  type => $self->type,
 167                                  valid => 0,
 168                                  package_collection => $self->package_collection,
 169                                  $self->schema_argument,
 170                                 );
 171 }
 172
 173
 174 =head2 valid
 175
 176 Returns 1 if this package is valid, 0 otherwise.
 177
 178 =cut
 179
 180 has valid => (is => 'ro',
 181               isa => 'Bool',
 182               reader => 'is_valid',
 183               lazy => 1,
 184               builder => '_build_valid',
 185              );
 186
 187 sub _build_valid {
 188     my $self = shift;
 189     return 0;
 190 }
 191
 192
 193 =head2 package_collection
 194
 195 Returns the L<Debugs::Collection::Package> which is in use by this version
 196 object.
 197
 198 =cut
 199
 200 has 'package_collection' => (is => 'ro',
 201                              isa => 'Debbugs::Collection::Package',
 202                              builder => '_build_package_collection',
 203                              lazy => 1,
 204                             );
 205 sub _build_package_collection {
 206     my $self = shift;
 207     return Debbugs::Collection::Package->new($self->schema_arg)
 208 }
 209
 210
 211 __PACKAGE__->meta->make_immutable;
 212 no Mouse;
 213 1;
 214
 215
 216 __END__
 217 # Local Variables:
 218 # indent-tabs-mode: nil
 219 # cperl-indent-level: 4
 220 # End: