X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FVersion.pm;h=71dc0085894d7f79bf382c42631c0271c7d7bf4b;hb=288859ac0b478e3083882638f985c3b006035b1d;hp=34fdd0e2e9f6e28a7447909b7cdebcdbc948b67f;hpb=68d10ba58a8277b0dde313de86507798defa9b55;p=debbugs.git diff --git a/Debbugs/Version.pm b/Debbugs/Version.pm index 34fdd0e..71dc008 100644 --- a/Debbugs/Version.pm +++ b/Debbugs/Version.pm @@ -12,8 +12,11 @@ Debbugs::Version -- OO interface to Version =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 @@ -33,65 +36,167 @@ use Carp; extends 'Debbugs::OOBase'; -state $strong_severities = - {map {($_,1)} @{$config{strong_severities}}}; +=head1 Object Creation -has version => (is => 'ro', isa => 'Str', - required => 1, - builder => '_build_version', - predicate => '_has_version', - ); +=head2 my $version = Debbugs::Version::Source->new(%params|$param) -sub type { - confess("Subclass must define type"); -} +or Cnew(%params|$param)> for a binary version -has package => (is => 'bare', - isa => 'Debbugs::Package', - lazy => 1, - builder => '_build_package', - ); +=over + +=item schema + +L schema which can be used to look up versions + +=item package + +String representation of the package + +=item pkg + +L which refers to the package given. + +Only one of C or C should be given + +=item package_collection + +L which is used to generate a L +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 = @_; } - carp("No schema") unless exists $args{schema}; - if (exists $args{package} and - not blessed($args{package})) { - # OK, need a package Collection - my $pkgc = $args{package_collection} // - Debbugs::Collection::Package-> - new(exists $args{schema}?(schema => $args{schema}):()); - $args{package} = - $pkgc->universe->get_or_add_by_key($args{package}); - } 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', + ); + +=head2 type + +Returns 'source' if this is a source version, or 'binary' if this is a binary +version. + +=cut + +=head2 source_version + +Returns the source version for this version; if this is a source version, +returns itself. + +=cut + +=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; - return Debbugs::Package->new(package => '(unknown)', + if ($self->_has_pkg) { + return $self->pkg->name; + } + return '(unknown)'; +} + +=head2 pkg + +Returns a L object corresponding to C. + +=cut + + +has pkg => (is => 'ro', + isa => 'Debbugs::Package', + lazy => 1, + builder => '_build_pkg', + reader => 'pkg', + predicate => '_has_pkg', + ); + +sub _build_pkg { + my $self = shift; + return Debbugs::Package->new(package => $self->package, type => $self->type, valid => 0, package_collection => $self->package_collection, - $self->has_schema?(schema => $self->schema):(), + $self->schema_argument, ); } +=head2 valid + +Returns 1 if this package is valid, 0 otherwise. + +=cut + has valid => (is => 'ro', isa => 'Bool', - default => 0, reader => 'is_valid', + lazy => 1, + builder => '_build_valid', ); +sub _build_valid { + my $self = shift; + return 0; +} + + +=head2 package_collection + +Returns the L which is in use by this version +object. + +=cut + has 'package_collection' => (is => 'ro', isa => 'Debbugs::Collection::Package', builder => '_build_package_collection',