From 01c360c8831df87a69fe1f49a08dda22ded51950 Mon Sep 17 00:00:00 2001 From: Don Armstrong Date: Thu, 7 Jun 2018 15:28:25 -0700 Subject: [PATCH] add VersionTree and Collection::Version --- Debbugs/Collection/Version.pm | 116 ++++++++++++++++++++++++++++++ Debbugs/Version.pm | 129 ++++++++++++++-------------------- Debbugs/Version/Binary.pm | 92 ++++++++++++++++++++++++ Debbugs/Version/Source.pm | 71 +++++++++++++++++++ Debbugs/VersionTree.pm | 125 ++++++++++++++++++++++++++++++++ 5 files changed, 455 insertions(+), 78 deletions(-) create mode 100644 Debbugs/Collection/Version.pm create mode 100644 Debbugs/Version/Binary.pm create mode 100644 Debbugs/Version/Source.pm create mode 100644 Debbugs/VersionTree.pm diff --git a/Debbugs/Collection/Version.pm b/Debbugs/Collection/Version.pm new file mode 100644 index 0000000..b721cd9 --- /dev/null +++ b/Debbugs/Collection/Version.pm @@ -0,0 +1,116 @@ +# 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 . + +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: diff --git a/Debbugs/Version.pm b/Debbugs/Version.pm index 58a643c..12792b6 100644 --- a/Debbugs/Version.pm +++ b/Debbugs/Version.pm @@ -22,11 +22,14 @@ Debbugs::Version -- OO interface to Version =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'; @@ -39,97 +42,67 @@ has version => (is => 'ro', isa => 'Str', 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; diff --git a/Debbugs/Version/Binary.pm b/Debbugs/Version/Binary.pm new file mode 100644 index 0000000..d787fc7 --- /dev/null +++ b/Debbugs/Version/Binary.pm @@ -0,0 +1,92 @@ +# 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 . + +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: diff --git a/Debbugs/Version/Source.pm b/Debbugs/Version/Source.pm new file mode 100644 index 0000000..98b8849 --- /dev/null +++ b/Debbugs/Version/Source.pm @@ -0,0 +1,71 @@ +# 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 . + +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: diff --git a/Debbugs/VersionTree.pm b/Debbugs/VersionTree.pm new file mode 100644 index 0000000..1231bd8 --- /dev/null +++ b/Debbugs/VersionTree.pm @@ -0,0 +1,125 @@ +# 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 . + +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: -- 2.39.2