--- /dev/null
+# This module is part of debbugs, and
+# is released under the terms of the GPL version 2, or any later
+# version (at your option). See the file README and COPYING for more
+# information.
+# Copyright 2018 by Don Armstrong <don@donarmstrong.com>.
+
+package Debbugs::Collection::Version;
+
+=head1 NAME
+
+Debbugs::Collection::Version -- Version generation factory
+
+=head1 SYNOPSIS
+
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use Mouse;
+use strictures 2;
+use v5.10; # for state
+use namespace::autoclean;
+use Debbugs::Common qw(make_list hash_slice);
+use Debbugs::Config qw(:config);
+use Debbugs::OOTypes;
+use Debbugs::Version;
+
+use List::AllUtils qw(part);
+
+extends 'Debbugs::Collection';
+
+has '+members' => (isa => 'ArrayRef[Debbugs::Version]');
+
+has 'package_collection' =>
+ (is => 'ro',
+ isa => 'Debbugs::Collection::Package',
+ builder => '_build_package_collection',
+ lazy => 1,
+ );
+
+sub _build_package_collection {
+ my $self = shift;
+ return Debbugs::Collection::Package->new($self->schema_argument);
+}
+
+sub member_key {
+ use Data::Printer;
+ p @_;
+ return $_[1]->package.'/'.$_[1]->version.'/'.$_[1]->arch;
+}
+
+
+around add_by_key => sub {
+ my $orig = shift;
+ my $self = shift;
+ my @members =
+ $self->_member_constructor(versions => [@_]);
+ return $self->$orig(@members);
+};
+
+sub _member_constructor {
+ my $self = shift;
+ my %args = @_;
+ my @schema_arg;
+ my @return;
+ for my $pkg_ver_arch (make_list($args{versions})) {
+ my ($pkg,$ver,$arch) = $pkg_ver_arch =~ m{^([^/]+)/([^/]+)/?([^/]*)$} or
+ confess("Invalid version key: $pkg_ver_arch");
+ if (not length $arch) {
+ if ($pkg =~ /^src:/) {
+ $arch = 'source';
+ } else {
+ $arch = 'any';
+ }
+ }
+ if ($arch eq 'source') {
+ push @return,
+ Debbugs::Version::Source->
+ new($self->schema_argument,
+ package => $pkg,
+ version => $ver,
+ );
+ } else {
+ push @return,
+ Debbugs::Version::Binary->
+ new($self->schema_argument,
+ package => $pkg,
+ version => $ver,
+ arch => [$arch],
+ );
+ }
+ }
+}
+
+# Debbugs::Collection::Versions do not have a universe.
+sub universe {
+ return $_[0];
+}
+
+sub source {
+ my $self = shift;
+ return $self->map(sub{$_->source});
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
=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';
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',
- );
-
-has 'package_collection' => (is => 'ro',
- isa => 'Debbugs::Collection::Package',
- builder => '_build_package_collection',
- lazy => 1,
- );
-
-sub _build_package_collection {
- return Debbugs::Collection::Package->new();
+sub type {
+ confess("Subclass must define type");
}
-# one of source_version or version must be provided
-
-sub BUILD {
- 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");
+has package => (is => 'bare',
+ isa => 'Debbugs::Package',
+ lazy => 1,
+ builder => '_build_package',
+ );
+
+around BUILDARGS => sub {
+ my $orig = shift;
+ my $class = shift;
+ my %args;
+ if (@_==1 and ref($_[0]) eq 'HASH') {
+ %args = %{$_[0]};
+ } else {
+ %args = @_;
}
- if ($self->_has_source and
- $self->source->is_source
- ) {
- confess("You have provided a source package which is not a source package");
+ 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_create($args{package});
}
-}
+ return $class->$orig(%args);
+};
-sub _build_version {
- my $self = shift;
- my $srcver = $self->source_version;
- $srcver =~ s{.+/}{};
- return $srcver;
-}
-sub _build_source_version {
+sub _build_package {
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 => '(unknown)',
+ type => $self->type,
+ valid => 0,
+ package_collection => $self->package_collection,
+ $self->has_schema?(schema => $self->schema):(),
+ );
}
-sub _build_source {
- 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");
-}
-sub _build_packages {
+has valid => (is => 'ro',
+ isa => 'Bool',
+ default => 0,
+ reader => 'is_valid',
+ );
+
+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;
--- /dev/null
+# This module is part of debbugs, and
+# is released under the terms of the GPL version 2, or any later
+# version (at your option). See the file README and COPYING for more
+# information.
+# Copyright 2018 by Don Armstrong <don@donarmstrong.com>.
+
+package Debbugs::Version::Binary;
+
+=head1 NAME
+
+Debbugs::Version::Binary -- OO interface to Version
+
+=head1 SYNOPSIS
+
+ use Debbugs::Version::Binary;
+ Debbugs::Version::Binary->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;
+
+extends 'Debbugs::Version';
+
+sub type {
+ return 'binary';
+}
+
+has source_version => (is => 'ro',
+ isa => 'Debbugs::Version::Source',
+ lazy => 1,
+ builder => '_build_source_version',
+ );
+
+sub _build_source_version {
+ my $self = shift;
+ my $source_version =
+ $self->package->
+ get_source_version(version => $self->version,
+ $self->_count_archs?(archs => [$self->_archs]):(),
+ );
+ if (defined $source_version) {
+ return $source_version;
+ }
+ return Debbugs::Version::Source->new(version => $self->version,
+ package => '(unknown)',
+ valid => 0,
+ package_collection => $self->package_collection,
+ );
+}
+
+has archs => (is => 'bare',
+ isa => 'ArrayRef[Str]',
+ builder => '_build_archs',
+ traits => ['Array'],
+ handles => {'_archs' => 'elements',
+ '_count_archs' => 'count',
+ },
+ );
+
+sub _build_archs {
+ my $self = shift;
+ # this is wrong, but we'll start like this for now
+ return ['any'];
+}
+
+sub arch {
+ my $self = shift;
+ return $self->_count_archs > 0?join('',$self->_archs):'any';
+}
+
+
+__PACKAGE__->meta->make_immutable;
+no Mouse;
+1;
+
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
--- /dev/null
+# This module is part of debbugs, and
+# is released under the terms of the GPL version 2, or any later
+# version (at your option). See the file README and COPYING for more
+# information.
+# Copyright 2018 by Don Armstrong <don@donarmstrong.com>.
+
+package Debbugs::Version::Source;
+
+=head1 NAME
+
+Debbugs::Version::Source -- OO interface to Version
+
+=head1 SYNOPSIS
+
+ use Debbugs::Version::Source;
+ Debbugs::Version::Source->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;
+
+extends 'Debbugs::Version';
+
+sub type {
+ return 'source';
+}
+
+sub source_version {
+ return $_[0];
+}
+
+sub src_pkg_ver {
+ my $self = shift;
+ return $self->source->name.'/'.$self->version;
+}
+
+has maintainer => (is => 'ro',
+ isa => 'Str',
+ );
+
+sub source {
+ my $self = shift;
+ return $self->package;
+}
+
+sub arch {
+ return 'source';
+}
+
+
+__PACKAGE__->meta->make_immutable;
+no Mouse;
+1;
+
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
--- /dev/null
+# This module is part of debbugs, and
+# is released under the terms of the GPL version 2, or any later
+# version (at your option). See the file README and COPYING for more
+# information.
+# Copyright 2018 by Don Armstrong <don@donarmstrong.com>.
+
+package Debbugs::VersionTree;
+
+=head1 NAME
+
+Debbugs::VersionTree -- OO interface to Debbugs::Versions
+
+=head1 SYNOPSIS
+
+ use Debbugs::VersionTree;
+ my $vt = Debbugs::VersionTree->new();
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use Mouse;
+use v5.10;
+use strictures 2;
+use namespace::autoclean;
+
+use Debbugs::Config qw(:config);
+use Debbugs::Versions;
+use Carp;
+
+extends 'Debbugs::OOBase';
+
+has _versions => (is => 'bare',
+ isa => 'Debbugs::Versions',
+ default => sub {Debbugs::Versions->new(\&Debbugs::Versions::Dpkg::vercmp)},
+ handles => {_isancestor => 'isancestor',
+ _load => 'load',
+ _buggy => 'buggy',
+ _allstates => 'allstates',
+ },
+ );
+
+has loaded_src_pkg => (is => 'bare',
+ isa => 'HashRef[Bool]',
+ default => sub {{}},
+ traits => ['Hash'],
+ handles => {src_pkg_loaded => 'exists',
+ _set_src_pkg_loaded => 'set',
+ },
+ );
+
+sub _srcify_version {
+ my @return;
+ for my $v (@_) {
+ if (ref($_)) {
+ push @return,
+ $v->source_version->src_pkg_ver;
+ } else {
+ push @return,
+ $v;
+ }
+ }
+ return @_ > 1?@return:$return[0];
+}
+
+sub isancestor {
+ my ($self,$ancestor,$descendant) = @_;
+ return $self->_isancestor(_srcify_version($ancestor),
+ _srcify_version($descendant),
+ );
+}
+
+sub buggy {
+ my $self = shift;
+ my ($version,$found,$fixed) = @_;
+ ($version) = _srcify_version($version);
+ $found = [_srcify_version(@{$found})];
+ $fixed = [_srcify_version(@{$fixed})];
+ return $self->_buggy($version,$found,$fixed);
+}
+
+sub allstates {
+ my $self = shift;
+ my $found = shift;
+ my $fixed = shift;
+ my $interested = shift;
+ return $self->_allstates([_srcify_version(@{$found})],
+ [_srcify_version(@{$fixed})],
+ [_srcify_version(@{$interested})],
+ );
+}
+
+sub load {
+ my $self = shift;
+ for my $src_pkg (@_) {
+ my $is_valid = 0;
+ if (ref($src_pkg)) {
+ $is_valid = $src_pkg->valid;
+ $src_pkg = $src_pkg->name;
+ }
+ next if $self->src_pkg_loaded($src_pkg);
+ my $srchash = substr $src_pkg, 0, 1;
+ my $version_fh;
+ open($version_fh,'<',"$config{version_packages_dir}/$srchash/$src_pkg");
+ if (not defined $version_fh) {
+ carp "No version file for package $src_pkg" if $is_valid;
+ next;
+ }
+ $self->_load($version_fh);
+ $self->_set_src_pkg_loaded($src_pkg,1);
+ }
+}
+
+__PACKAGE__->meta->make_immutable;
+no Mouse;
+1;
+
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
projects / debbugs.git / commitdiff