=head1 SYNOPSIS
+This package provides a convenient interface to refer to package versions and
+potentially make calculations based upon them
+
use Debbugs::Version;
- Debbugs::Version->new(schema => $s,binaries => [qw(foo)],sources => [qw(bar)]);
+ my $v = Debbugs::Version->new(schema => $s,binaries => [qw(foo)],sources => [qw(bar)]);
=head1 DESCRIPTION
=cut
use Mouse;
+use v5.10;
use strictures 2;
use namespace::autoclean;
+use Debbugs::Config qw(:config);
use Debbugs::Collection::Package;
use Debbugs::OOTypes;
+use Carp;
extends 'Debbugs::OOBase';
+=head1 Object Creation
+
+=head2 my $version = Debbugs::Version::Source->new(%params|$param)
+
+or C<Debbugs::Version::Binary->new(%params|$param)> for a binary version
+
+=over
+
+=item schema
+
+L<Debbugs::DB> schema which can be used to look up versions
+
+=item package
+
+String representation of the package
+
+=item pkg
+
+L<Debbugs::Package> which refers to the package given.
+
+Only one of C<package> or C<pkg> should be given
+
+=item package_collection
+
+L<Debbugs::Collection::Package> which is used to generate a L<Debbugs::Package>
+object from the package name
+
+=back
+
+=cut
+
+around BUILDARGS => sub {
+ my $orig = shift;
+ my $class = shift;
+ if ($class eq __PACKAGE__) {
+ confess("You should not be instantiating Debbugs::Version. ".
+ "Use Debbugs::Version::Source or ::Binary");
+ }
+ my %args;
+ if (@_==1 and ref($_[0]) eq 'HASH') {
+ %args = %{$_[0]};
+ } else {
+ %args = @_;
+ }
+ return $class->$orig(%args);
+};
+
+
+
state $strong_severities =
{map {($_,1)} @{$config{strong_severities}}};
+=head1 Methods
+
+=head2 version
+
+ $version->version
+
+Returns the source or binary package version
+
+=cut
+
has version => (is => 'ro', isa => 'Str',
required => 1,
builder => '_build_version',
predicate => '_has_version',
);
-has source_version => (is => 'ro',
- isa => 'Str',
- builder => '_build_source_version',
- predicate => '_has_source_version',
- clearer => '_clear_source_version',
- );
-
-has source => (is => 'ro',
- isa => 'Debbugs::Package',
- lazy => 1,
- writer => 'set_source',
- builder => '_build_source',
- predicate => '_has_source',
- clearer => '_clear_source',
- );
-
-has packages => (is => 'rw',
- isa => 'Debbugs::Collection::Package',
- writer => 'set_package',
- builder => '_build_package',
- predicate => '_has_package',
- clearer => '_clear_package',
- );
+=head2 type
-has 'package_collection' => (is => 'ro',
- isa => 'Debbugs::Collection::Package',
- builder => '_build_package_collection',
- lazy => 1,
- );
+Returns 'source' if this is a source version, or 'binary' if this is a binary
+version.
-sub _build_package_collection {
- return Debbugs::Collection::Package->new();
-}
+=cut
+
+=head2 source_version
-# one of source_version or version must be provided
+Returns the source version for this version; if this is a source version,
+returns itself.
+
+=cut
-sub BUILD {
+=head2 src_pkg_ver
+
+Returns the fully qualified source_package/version string for this version.
+
+=cut
+
+=head2 package
+
+Returns the name of the package that this version is in
+
+=cut
+
+has package => (is => 'ro',
+ isa => 'Str',
+ builder => '_build_package',
+ predicate => '_has_package',
+ lazy => 1,
+ );
+
+sub _build_package {
my $self = shift;
- my $args = shift;
- if (not $self->_has_version and
- not $self->_has_source_version) {
- confess("Version objects must have at least a source version or a version");
- }
- if ($self->_has_source and
- $self->source->is_source
- ) {
- confess("You have provided a source package which is not a source package");
+ if ($self->_has_pkg) {
+ return $self->pkg->name;
}
+ return '(unknown)';
}
-sub _build_version {
- my $self = shift;
- my $srcver = $self->source_version;
- $srcver =~ s{.+/}{};
- return $srcver;
-}
+=head2 pkg
+
+Returns a L<Debbugs::Package> object corresponding to C<package>.
+
+=cut
-sub _build_source_version {
+
+has pkg => (is => 'ro',
+ isa => 'Debbugs::Package',
+ lazy => 1,
+ builder => '_build_pkg',
+ reader => 'pkg',
+ predicate => '_has_pkg',
+ );
+
+sub _build_pkg {
my $self = shift;
- # should we verify that $self->source is a valid package?
- my $src = $self->source;
- if ($src->is_valid) {
- return $self->source->name.'/'.$self->version;
- }
- # do we want invalid sources to be in parenthesis?
- return $self->version;
+ return Debbugs::Package->new(package => $self->package,
+ type => $self->type,
+ valid => 0,
+ package_collection => $self->package_collection,
+ $self->schema_argument,
+ );
}
-sub _build_source {
+
+=head2 valid
+
+Returns 1 if this package is valid, 0 otherwise.
+
+=cut
+
+has valid => (is => 'ro',
+ isa => 'Bool',
+ reader => 'is_valid',
+ lazy => 1,
+ builder => '_build_valid',
+ );
+
+sub _build_valid {
my $self = shift;
- if ($self->_has_binaries) {
- # this should be the standard case
- if ($self->binaries->sources->count == 1) {
- return $self->binaries->sources->first(sub {1});
- }
- # might need to figure out how to speed up limit_by_version
- return $self->binaries->limit_by_version($self->version)->
- sources;
- }
- confess("No binary package, cannot know what source package this version is for");
+ return 0;
}
-sub _build_packages {
+
+=head2 package_collection
+
+Returns the L<Debugs::Collection::Package> which is in use by this version
+object.
+
+=cut
+
+has 'package_collection' => (is => 'ro',
+ isa => 'Debbugs::Collection::Package',
+ builder => '_build_package_collection',
+ lazy => 1,
+ );
+sub _build_package_collection {
my $self = shift;
- if ($self->_has_source) {
- return $self->package_collection->
- get_or_create($self->source->binaries,$self->source);
- }
- confess("No source package, cannot know what binary packages this version is for");
+ return Debbugs::Collection::Package->new($self->schema_arg)
}
+
__PACKAGE__->meta->make_immutable;
no Mouse;
1;
projects / debbugs.git / blobdiff