From 7908c761e8b425f92178aa73f3aba1edce3ab438 Mon Sep 17 00:00:00 2001 From: Don Armstrong Date: Thu, 7 Jun 2018 15:32:40 -0700 Subject: [PATCH] update OO interface to near-completion --- Debbugs/Bug.pm | 332 ++++++++++++++++++++++++++++++---- Debbugs/Bug/Tag.pm | 88 ++++++++- Debbugs/Collection.pm | 59 ++++-- Debbugs/Collection/Bug.pm | 95 ++++++---- Debbugs/Collection/Package.pm | 255 ++++++++++++++++++++++---- cgi/pkgreport.cgi | 11 +- 6 files changed, 712 insertions(+), 128 deletions(-) diff --git a/Debbugs/Bug.pm b/Debbugs/Bug.pm index 05d03ac..539e758 100644 --- a/Debbugs/Bug.pm +++ b/Debbugs/Bug.pm @@ -27,16 +27,20 @@ use namespace::clean; use v5.10; # for state use DateTime; -use List::AllUtils qw(max); +use List::AllUtils qw(max first min); +use Params::Validate qw(validate_with :types); use Debbugs::Config qw(:config); use Debbugs::Status qw(read_bug); use Debbugs::Bug::Tag; use Debbugs::Collection::Package; use Debbugs::Collection::Bug; +use Debbugs::Collection::Correspondent; use Debbugs::OOTypes; +use Carp; + extends 'Debbugs::OOBase'; state $strong_severities = @@ -46,6 +50,10 @@ has bug => (is => 'ro', isa => 'Int', required => 1, ); +sub id { + return $_[0]->bug; +} + has saved => (is => 'ro', isa => 'Bool', default => 0, writer => '_set_saved', @@ -71,16 +79,39 @@ has 'package_collection' => (is => 'ro', ); sub _build_package_collection { + my $self = shift; + if ($self->has_schema) { + return Debbugs::Collection::Package->new(schema => $self->schema); + } + carp "No schema when building package collection"; return Debbugs::Collection::Package->new(); } + has bug_collection => (is => 'ro', isa => 'Debbugs::Collection::Bug', builder => '_build_bug_collection', ); sub _build_bug_collection { + my $self = shift; + if ($self->has_schema) { + return Debbugs::Collection::Bug->new(schema => $self->schema); + } return Debbugs::Collection::Bug->new(); } +has correspondent_collection => + (is => 'ro', + isa => 'Debbugs::Collection::Correspondent', + builder => '_build_package_collection', + lazy => 1, + ); +sub _build_correspondent_collection { + my $self = shift; + if ($self->has_schema) { + return Debbugs::Collection::Correspondent->new(schema => $self->schema); + } + return Debbugs::Collection::Correspondent->new(); +} sub reset { my $self = shift; @@ -129,7 +160,7 @@ for my $attr (qw(packages affects sources)) { # bugs for my $attr (qw(blocks blockedby mergedwith)) { has $attr => - (is => 'bare', + (is => 'ro', isa => 'Debbugs::Collection::Bug', clearer => '_clear_'.$attr, builder => '_build_'.$attr, @@ -139,10 +170,34 @@ for my $attr (qw(blocks blockedby mergedwith)) { } +for my $attr (qw(owner submitter)) { + has $attr.'_corr' => + (is => 'ro', + isa => 'Debbugs::Correspondent', + lazy => 1, + builder => '_build_'.$attr.'_corr', + clearer => '_clear_'.$attr.'_corr', + handles => {$attr.'_url' => $attr.'_url', + $attr.'_email' => 'email', + $attr.'_phrase' => 'phrase', + }, + ); +} + +sub _build_owner_corr { + my $self = shift; + return $self->correspondent_collection->get_or_create($self->owner); +} + +sub _build_submitter_corr { + my $self = shift; + return $self->correspondent_collection->get_or_create($self->submitter); +} for my $attr (qw(done severity), - qw(found fixed), + qw(forwarded), qw(pending location submitter), + qw(owner subject), ) { has $attr => (is => 'rw', @@ -165,21 +220,38 @@ sub _build_severity { return $_[0]->status->{severity} // $config{default_severity}; } +sub _build_subject { + return $_[0]->status->{subject} // '(No subject)'; +} + sub strong_severity { my $self = shift; return exists $strong_severities->{$self->severity}; } +sub short_severity { + $_[0]->severity =~ m/^(.)/; + return $1; +} + sub package { - local $_; - return join(', ',map {$_->name} $_[0]->packages); + my $self = shift; + return join(', ',$self->packages->apply(sub{$_->name})); } sub _build_packages { - return [$_[0]->package_collection-> - get_package($_[0]->status->{package} // - '') - ]; + my $self = shift; + my @packages; + if (length($self->status->{package}//'')) { + @packages = split /,/,$self->status->{package}//''; + } + return $self->package_collection-> + limit(@packages); +} + +sub is_affecting { + my $self = shift; + return $self->affects->count > 0; } sub affect { @@ -188,10 +260,12 @@ sub affect { } sub _build_affects { - return [$_[0]->package_collection-> - get_package($_[0]->status->{affects} // - '') - ]; + my @packages; + if (length($_[0]->status->{affects}//'')) { + @packages = split /,/,$_[0]->status->{affects}//''; + } + return $_[0]->package_collection-> + limit(@packages); } sub source { local $_; @@ -199,7 +273,17 @@ sub source { } sub _build_sources { local $_; - my @sources = map {$_->sources} $_[0]->packages; + my @sources = map {$_->sources} $_[0]->packages->members; + return @sources; +} + +sub is_owned { + my $self = shift; + return length($self->owner) > 0; +} +sub _build_owner { + my $self = shift; + return $self->status->{owner} // ''; } @@ -215,37 +299,84 @@ sub _split_if_defined { return (); } +sub is_blocking { + my $self = shift; + return $self->blocks->count > 0; +} + sub _build_blocks { my $self = shift; return $self->bug_collection-> - limit_or_create(sort {$a <=> $b} - $self->_split_if_defined('blocks')); + limit(sort {$a <=> $b} + $self->_split_if_defined('blocks')); +} + +sub is_blocked { + my $self = shift; + return $self->blockedby->count > 0; } sub _build_blockedby { my $self = shift; return $self->bug_collection-> - limit_or_create(sort {$a <=> $b} - $self->_split_if_defined('blockedby')); + limit(sort {$a <=> $b} + $self->_split_if_defined('blockedby')); +} + +sub is_forwarded { + length($_[0]->forwarded) > 0; +} + +sub _build_forwarded { + my $self = shift; + return $self->status->{forwarded} // ''; +} + + + +for my $attr (qw(fixed found)) { + has $attr => + (is => 'ro', + isa => 'Debbugs::Collection::Version', + clearer => '_clear_'.$attr, + builder => '_build_'.$attr, + handles => {}, + lazy => 1, + ); +} + +sub has_found { + my $self = shift; + return $self->found->count > 0; } sub _build_found { my $self = shift; - return $self->sources-> - versions($self->_split_if_defined('found',',\s*')); + return $self->packages-> + get_source_versions(@{$self->status->{found_versions} // []}); } +sub has_fixed { + my $self = shift; + return $self->fixed->count > 0; +} sub _build_fixed { - my $self; - return $self->sources-> - versions($self->_split_if_defined('fixed',',\s*')); + my $self = shift; + return $self->packages-> + get_source_versions(@{$self->status->{fixed_versions} // []}); +} + +sub is_merged { + my $self = shift; + return $self->mergedwith->count > 0; } + sub _build_mergedwith { my $self = shift; return $self->bug_collection-> - limit_or_create(sort {$a <=> $b} - $self->_split_if_defined('mergedwith')); + limit(sort {$a <=> $b} + $self->_split_if_defined('mergedwith')); } sub _build_pending { return $_[0]->status->{pending} // ''; @@ -307,21 +438,21 @@ sub buggy { my $self = shift; my $vertree = $self->package_collection-> - versions; + universe->versiontree; my $max_buggy = 'absent'; for my $ver (@_) { if (not ref($ver)) { $ver = Debbugs::Version-> - new(string => $ver, + new(version => $ver, + package => $self, package_collection => $self->package_collection, ); } $vertree->load($ver->source); my $buggy = - $vertree->tree-> - buggy($ver->srcver, - [map {$_->srcver} $self->found], - [map {$_->srcver} $self->fixed]); + $vertree->buggy($ver, + [$self->found], + [$self->fixed]); if ($buggy eq 'found') { return 'found' } @@ -382,10 +513,10 @@ sub _populate_archiveable { } } my $time = time; - state $remove_time = 24 * 60 * 60 * $config{removal_age}; + state $remove_time = 24 * 60 * 60 * ($config{removal_age} // 30); # 4. Have been modified more than removal_age ago my $moded_ago = - $time - $self->last_modified; + $time - $self->modified->epoch; # if we don't need to know when we can archive, we can stop here if it's # been modified too recently if ($moded_ago < $remove_time) { @@ -399,17 +530,18 @@ sub _populate_archiveable { @{$config{removal_strong_severity_default_distribution_tags}}; } # 3. Have a maximum buggy of fixed - my $buggy = $self->buggy($self->package-> - dist_source_versions(@distributions)); + my $buggy = $self->buggy($self->packages-> + get_source_versions_distributions(@distributions)); if ('found' eq $buggy) { $self->_set_archiveable(0); $self->_set_when_archiveable(-1); return; } - my $fixed_ago = $time - $self->when_fixed(@distributions); - if ($fixed_ago < $remove_time) { - $self->_set_archiveable(0); - } + my $fixed_ago = $moded_ago; + # $fixed_ago = $time - $self->when_fixed(@distributions); + # if ($fixed_ago < $remove_time) { + # $self->_set_archiveable(0); + # } $self->_set_when_archiveable(($remove_time - min($fixed_ago,$moded_ago)) / (24 * 60 * 60)); if ($fixed_ago > $remove_time and $moded_ago > $remove_time) { @@ -419,6 +551,128 @@ sub _populate_archiveable { return; } +sub filter { + my $self = shift; + my %param = validate_with(params => \@_, + spec => {seen_merged => {type => HASHREF, + default => sub {return {}}, + }, + repeat_merged => {type => BOOLEAN, + default => 1, + }, + include => {type => HASHREF, + optional => 1, + }, + exclude => {type => HASHREF, + optional => 1, + }, + min_days => {type => SCALAR, + optional => 1, + }, + max_days => {type => SCALAR, + optional => 1, + }, + }, + ); + if (exists $param{include}) { + return 1 if not $self->matches($param{include}); + } + if (exists $param{exclude}) { + return 1 if $self->matches($param{exclude}); + } + if (exists $param{repeat_merged} and not $param{repeat_merged}) { + my @merged = sort {$a<=>$b} $self->bug, map {$_->bug} $self->mergedwith->members; + return 1 if first {sub {defined $_}} + @{$param{seen_merged}}{@merged}; + @{$param{seen_merged}}{@merged} = (1) x @merged; + } + if (exists $param{min_days}) { + return 1 unless $param{min_days} <= + (DateTime->now() - $self->created)->days(); + } + if (exists $param{max_days}) { + return 1 unless $param{max_days} >= + (DateTime->now() - $self->created)->days(); + } + return 0; + +} + +sub __exact_match { + my ($field, $values) = @_; + my @ret = first {sub {$_ eq $field}} @{$values}; + return @ret != 0; +} + +sub __contains_match { + my ($field, $values) = @_; + foreach my $value (@{$values}) { + return 1 if (index($field, $value) > -1); + } + return 0; +} + +state $field_match = + {subject => sub {__contains_match($_[0]->subject,@_)}, + tags => sub { + for my $value (@{$_[1]}) { + if ($_[0]->tags->is_set($value)) { + return 1; + } + } + return 0; + }, + severity => sub {__exact_match($_[0]->severity,@_)}, + pending => sub {__exact_match($_[0]->pending,@_)}, + originator => sub {__exact_match($_[0]->submitter,@_)}, + submitter => sub {__exact_match($_[0]->submitter,@_)}, + forwarded => sub {__exact_match($_[0]->forwarded,@_)}, + owner => sub {__exact_match($_[0]->owner,@_)}, + }; + +sub matches { + my ($self,$hash) = @_; + for my $key (keys %{$hash}) { + my $sub = $field_match->{$key}; + if (not defined $sub) { + carp "No subroutine for key: $key"; + next; + } + return 1 if $sub->($self,$hash->{$key}); + } + return 0; +} + +sub url { + my $self = shift; + return $config{web_domain}.'/'.$self->id; +} + +sub related_packages_and_versions { + my $self = shift; + my @packages; + if (length($self->status->{package}//'')) { + @packages = split /,/,$self->status->{package}//''; + } + my @versions = + (@{$self->status->{found_versions}//[]}, + @{$self->status->{fixed_versions}//[]}); + my @unqualified_versions; + my @return; + for my $ver (@versions) { + if ($ver =~ m{(.+)/(.+)}) { # It's a src_pkg_ver + push @return, ['src:'.$+{src}, $+{ver}]; + } else { + push @unqualified_versions,$ver; + } + } + for my $pkg (@packages) { + push @return, + [$pkg,@unqualified_versions]; + } + return @return; +} + no Mouse; 1; diff --git a/Debbugs/Bug/Tag.pm b/Debbugs/Bug/Tag.pm index 8ed9246..7b3df32 100644 --- a/Debbugs/Bug/Tag.pm +++ b/Debbugs/Bug/Tag.pm @@ -25,11 +25,16 @@ use strictures 2; use namespace::clean; use v5.10; # for state +use Debbugs::User; +use List::AllUtils qw(uniq); use Debbugs::Config qw(:config); state $valid_tags = {map {($_,1)} @{$config{tags}}}; +state $short_tags = + {%{$config{tags_single_letter}}}; + extends 'Debbugs::OOBase'; around BUILDARGS => sub { @@ -45,20 +50,50 @@ around BUILDARGS => sub { } }; -has tags => (is => 'ro', isa => 'HashRef[Str]', - default => sub {{}}, +has tags => (is => 'ro', + isa => 'HashRef[Str]', + traits => ['Hash'], + lazy => 1, + reader => '_tags', + builder => '_build_tags', + handles => {has_tags => 'count'} ); -has usertags => (is => 'ro',isa => 'HashRef[Str]', - default => sub {{}}, +has usertags => (is => 'ro', + isa => 'HashRef[Str]', + lazy => 1, + reader => '_usertags', + builder => '_build_usertags', ); +sub _build_tags { + return {}; +} + +sub _build_usertags { + return {}; +} + +sub is_set { + return ($_[0]->tag_is_set($_[1]) or + $_[0]->usertag_is_set($_[1])); +} + sub tag_is_set { - return exists $_[0]->tags->{$_[1]} ? 1 : 0; + return exists $_[0]->_tags->{$_[1]} ? 1 : 0; +} + +sub usertag_is_set { + return exists $_[0]->_usertags->{$_[1]} ? 1 : 0; } sub unset_tag { my $self = shift; - delete $self->tags->{$_} foreach @_; + delete $self->_tags->{$_} foreach @_; +} + +sub unset_usertag { + my $self = shift; + delete $self->_usertags->{$_} foreach @_; } sub set_tag { @@ -67,7 +102,7 @@ sub set_tag { if (not $self->valid_tag($tag)) { confess("Invalid tag $tag"); } - $self->tags->{$tag} = 1; + $self->_tags->{$tag} = 1; } return $self; } @@ -77,7 +112,44 @@ sub valid_tag { } sub as_string { - return join(' ',sort keys %{$_[0]->tags}) + my $self = shift; + return $self->join_all(' '); +} + +sub join_all { + my $self = shift; + my $joiner = shift; + $joiner //= ', '; + return join($joiner,$self->all_tags); +} + +sub all_tags { + return uniq sort $_[0]->tags,$_[0]->usertags; +} + +sub tags { + return sort keys %{$_[0]->_tags} +} + +sub short_tags { + my $self = shift; + my @r; + for my $tag ($self->tags) { + next unless exists $short_tags->{$tag}; + push @r, + {long => $tag, + short => $short_tags->{$tag}, + }; + } + if (wantarray) { + return @r; + } else { + return [@r]; + } +} + +sub usertags { + return sort keys %{$_[0]->_usertags} } no Mouse; diff --git a/Debbugs/Collection.pm b/Debbugs/Collection.pm index ee478c6..5290563 100644 --- a/Debbugs/Collection.pm +++ b/Debbugs/Collection.pm @@ -30,24 +30,32 @@ has 'members' => (is => 'bare', traits => ['Array'], default => sub {[]}, writer => '_set_members', + predicate => '_has_members', handles => {_add => 'push', members => 'elements', count => 'count', _get_member => 'get', grep => 'grep', apply => 'apply', + map => 'map', sort => 'sort', }, ); +sub members_ref { + my $self = shift; + return [$self->members]; +} + has 'member_hash' => (traits => ['Hash'], - is => 'ro', + is => 'bare', isa => 'HashRef[Int]', lazy => 1, reader => '_member_hash', builder => '_build_member_hash', clearer => '_clear_member_hash', - predicate => '_has_member_hash', + predicate => '_has_member_hash', + writer => '_set_member_hash', handles => {_add_member_hash => 'set', _member_key_exists => 'exists', _get_member_hash => 'get', @@ -67,19 +75,32 @@ sub _build_universe { return $_[0]; } +sub clone { + my $self = shift; + my $new = bless { %{$self} }, ref $self; + if ($self->_has_members) { + $new->_set_members([$self->members]); + } + if ($self->_has_member_hash) { + $new->_set_member_hash({%{$self->_member_hash}}) + } + return $new; +} + sub limit { my $self = shift; my $limit = $self->clone(); # Set the universe to whatever my universe is (potentially myself) - $limit->_set_universe($self->universe); - $limit->_set_members(); + # $limit->_set_universe($self->universe); + $limit->_set_members([]); $limit->_clear_member_hash(); - $limit->add($self->universe->get_or_create(@_)); + $limit->add($self->universe->get_or_create(@_)) if @_; return $limit; } sub get_or_create { my $self = shift; + return () unless @_; my @return; my @exists; my @need_to_add; @@ -96,10 +117,19 @@ sub get_or_create { } } # create and add by key - @return[@need_to_add] = - $self->add_by_key(@_[@need_to_add]); - @return[@exists] = - $self->get(@_[@exists]); + if (@need_to_add) { + @return[@need_to_add] = + $self->add_by_key(@_[@need_to_add]); + } + if (@exists) { + @return[@exists] = + $self->get(@_[@exists]); + } + # if we've only been asked to get or create one thing, then it's expected + # that we are returning only one thing + if (@_ == 1) { + return $return[0]; + } return @return; } @@ -116,18 +146,21 @@ sub add_by_key { sub add { my $self = shift; - my @members_to_add; + my @members_added; for my $member (@_) { + if (not defined $member) { + confess("Undefined member to add"); + } + push @members_added,$member; if ($self->exists($member)) { next; } $self->_add($member); $self->_add_member_hash($self->member_key($member), - $self->count(), + $self->count()-1, ); } - $self->_add(@members_to_add); - return @members_to_add; + return @members_added; } sub get { diff --git a/Debbugs/Collection/Bug.pm b/Debbugs/Collection/Bug.pm index 08f7a66..4982047 100644 --- a/Debbugs/Collection/Bug.pm +++ b/Debbugs/Collection/Bug.pm @@ -25,52 +25,69 @@ use namespace::autoclean; use Debbugs::Common qw(make_list hash_slice); use Debbugs::OOTypes; use Debbugs::Status qw(get_bug_statuses); +use Debbugs::Collection::Package; +use Debbugs::Collection::Correspondent; + +use Debbugs::Bug; extends 'Debbugs::Collection'; has '+members' => (isa => 'ArrayRef[Bug]'); -has 'package_collection' => (is => 'rw', - isa => 'Debbugs::Collection::Package', - default => sub {Debbugs::Collection::Package->new()} - ); +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->has_schema?(schema => $self->schema):()); +} -around BUILDARGS => sub { - my $orig = shift; - my $class = shift; +has 'correspondent_collection' => + (is => 'ro', + isa => 'Debbugs::Collection::Correspondent', + builder => '_build_correspondent_collection', + lazy => 1, + ); - my %args; - if (@_==1 and ref($_[0]) eq 'HASH') { - %args = %{$_[0]}; - } else { - %args = @_; - } - $args{members} //= []; - if (exists $args{bugs}) { - push @{$args{members}}, - _member_constructor(bugs => $args{bugs}, - hash_slice(%args,qw(schema constructor_args)), - ); - delete $args{bugs}; +sub _build_correspondent_collection { + my $self = shift; + return Debbugs::Collection::Correspondent->new($self->has_schema?(schema => $self->schema):()); +} + +sub BUILD { + my $self = shift; + my $args = shift; + if (exists $args->{bugs}) { + $self->add( + $self->_member_constructor(bugs => $args->{bugs} + )); } - return $class->$orig(%args); -}; +} sub _member_constructor { # handle being called $self->_member_constructor; - if ((@_ % 2) == 1) { - shift; - } + my $self = shift; my %args = @_; my @return; - if (exists $args{schema}) { + my $schema; + $schema = $self->schema if $self->has_schema; + + if (defined $schema) { my $statuses = get_bug_statuses(bug => [make_list($args{bugs})], - schema => $args{schema}, + schema => $schema, ); while (my ($bug, $status) = each %{$statuses}) { push @return, - Debbugs::Bug->new(bug=>$bug, - status=>$status, - schema=>$args{schema}, + Debbugs::Bug->new(bug => $bug, + status => $status, + schema => $schema, + package_collection => + $self->package_collection->universe, + correspondent_collection => + $self->correspondent_collection->universe, @{$args{constructor_args}//[]}, ); } @@ -78,6 +95,10 @@ sub _member_constructor { for my $bug (make_list($args{bugs})) { push @return, Debbugs::Bug->new(bug => $bug, + package_collection => + $self->package_collection->universe, + correspondent_collection => + $self->correspondent_collection->universe, @{$args{constructor_args}//[]}, ); } @@ -89,10 +110,8 @@ around add_by_key => sub { my $orig = shift; my $self = shift; my @members = - _member_constructor(bugs => [@_], - $self->has_schema?(schema => $self->schema):(), - constructor_args => $self->constructor_args, - ); + $self->_member_constructor(bugs => [@_], + ); return $self->$orig(@members); }; @@ -100,6 +119,14 @@ sub member_key { return $_[1]->bug; } +sub load_related_packages_and_versions { + my $self = shift; + my @related_packages_and_versions = + $self->map(sub {$_->related_packages_and_versions}); + $self->package_collection-> + add_packages_and_versions(@related_packages_and_versions); +} + __PACKAGE__->meta->make_immutable; 1; diff --git a/Debbugs/Collection/Package.pm b/Debbugs/Collection/Package.pm index 0459b1e..a78d7b7 100644 --- a/Debbugs/Collection/Package.pm +++ b/Debbugs/Collection/Package.pm @@ -21,56 +21,245 @@ Debbugs::Collection::Package -- Package generation factory use Mouse; use strictures 2; +use v5.10; # for state use namespace::autoclean; -use Debbugs::Common qw(make_list); + +use Carp; +use Debbugs::Common qw(make_list hash_slice); +use Debbugs::Config qw(:config); use Debbugs::OOTypes; -use Debbugs::Status qw(get_bug_statuses); +use Debbugs::Package; + +use List::AllUtils qw(part); + +use Debbugs::Version::Binary; +use Debbugs::Collection::Version; +use Debbugs::Collection::Correspondent; +use Debbugs::VersionTree; extends 'Debbugs::Collection'; -has '+members' => (isa => 'ArrayRef[Package]'); +has '+members' => (isa => 'ArrayRef[Debbugs::Package]'); -around BUILDARGS => sub { +sub BUILD { + my $self = shift; + my $args = shift; + if (exists $args->{packages}) { + $self-> + add($self->_member_constructor(packages => + $args->{packages})); + } +} + +around add_by_key => sub { my $orig = shift; - my $class = shift; + my $self = shift; + my @members = + $self->_member_constructor(packages => [@_]); + return $self->$orig(@members); +}; - my %args; - if (@_==1 and ref($_[0]) eq 'HASH') { - %args = %{$_[0]}; - } else { - %args = @_; +sub _member_constructor { + # handle being called $self->_member_constructor; + my $self = shift; + my %args = @_; + my $schema; + if ($self->has_schema) { + $schema = $self->schema; } - $args{members} //= []; - if (exists $args{packages}) { - if (exists $args{schema}) { - my $statuses = get_bug_statuses(bug => [make_list($args{bugs})], - schema => $args{schema}, - ); - while (my ($bug, $status) = each %{$statuses}) { - push @{$args{members}}, - Debbugs::Bug->new(bug=>$bug, - status=>$status, - schema=>$args{schema}, - @{$args{constructor_args}//[]}, + my @return; + if (defined $schema) { + my $packages = + Debbugs::Package::_get_valid_version_info_from_db(packages => $args{packages}, + schema => $schema, + ); + for my $package (keys %{$packages}) { + push @return, + Debbugs::Package->new(%{$packages->{$package}}, + schema => $schema, + package_collection => $self->universe, + correspondent_collection => + $self->correspondent_collection->universe, ); - } - } else { - for my $bug (make_list($args{bugs})) { - push @{$args{members}}, - Debbugs::Bug->new(bug => $bug, - @{$args{constructor_args}//[]}, + } + } else { + carp "No schema\n"; + for my $package (make_list($args{packages})) { + push @return, + Debbugs::Package->new(name => $package, + package_collection => $self->universe, + correspondent_collection => + $self->correspondent_collection->universe, ); - } } - delete $args{bugs}; } - return $class->$orig(%args); -}; + return @return; +} + +sub add_packages_and_versions { + my $self = shift; + $self->add($self->_member_constructor(packages => \@_)); +} + +# state $common_dists = [@{$config{distributions}}]; +# sub _get_packages { +# my %args = @_; +# my $s = $args{schema}; +# my %src_packages; +# my %src_ver_packages; +# my %bin_packages; +# my %bin_ver_packages; +# # split packages into src/ver, bin/ver, src, and bin so we can select them +# # from the database +# local $_; +# for my $pkg (@{$args{packages}}) { +# if (ref($pkg)) { +# if ($pkg->[0] =~ /^src:(.+)$/) { +# for my $ver (@{$pkg}[1..$#{$pkg}]) { +# $src_ver_packages{$1}{$ver} = 1; +# } +# } else { +# for my $ver (@{$pkg}[1..$#{$pkg}]) { +# $bin_ver_packages{$pkg->[0]}{$ver} = 1; +# } +# } +# } elsif ($pkg =~ /^src:(.+)$/) { +# $src_packages{$1} = 1; +# } else { +# $bin_packages{$pkg} = 1; +# } +# } +# my @src_ver_search; +# for my $sp (keys %src_ver_packages) { +# push @src_ver_search, +# (-and => {'src_pkg.pkg' => $sp, +# 'me.ver' => [keys %{$src_ver_packages{$sp}}], +# }, +# ); +# } +# my %packages; +# my $src_rs = $s->resultset('SrcVer')-> +# search({-or => [-and => {'src_pkg.pkg' => [keys %src_packages], +# -or => {'suite.codename' => $common_dists, +# 'suite.suite_name' => $common_dists, +# }, +# }, +# @src_ver_search, +# ], +# }, +# {join => ['src_pkg', +# {'src_associations' => 'suite'}, +# ], +# '+select' => [qw(src_pkg.pkg), +# qw(suite.codename), +# qw(src_associations.modified), +# q(CONCAT(src_pkg.pkg,'/',me.ver))], +# '+as' => [qw(src_pkg_name codename modified_time src_pkg_ver)], +# result_class => 'DBIx::Class::ResultClass::HashRefInflator', +# order_by => {-desc => 'me.ver'} +# }, +# ); +# while (my $pkg = $src_rs->next) { +# my $n = 'src:'.$pkg->{src_pkg_name}; +# if (exists $packages{$n}) { +# push @{$packages{$n}{versions}}, +# $pkg->{src_pkg_ver}; +# if (defined $pkg->{codename}) { +# push @{$packages{$n}{dists}{$pkg->{codename}}}, +# $#{$packages{$n}{versions}}; +# } +# } else { +# $packages{$n} = +# {name => $pkg->{src_pkg_name}, +# type => 'source', +# valid => 1, +# versions => [$pkg->{src_pkg_ver}], +# dists => {defined $pkg->{codename}?($pkg->{codename} => [1]):()}, +# }; +# } +# } +# return \%packages; +# } sub member_key { - return $_[1]->bug; + return $_[1]->name; +} + +has 'correspondent_collection' => + (is => 'ro', + isa => 'Debbugs::Collection::Correspondent', + default => sub {Debbugs::Collection::Correspondent->new()}, + ); + +has 'versiontree' => + (is => 'ro', + isa => 'Debbugs::VersionTree', + lazy => 1, + builder => '_build_versiontree', + ); + +sub _build_versiontree { + my $self = shift; + return Debbugs::VersionTree->new($self->has_schema?(schema => $self->schema):()); +} + + +sub get_source_versions_distributions { + my $self = shift; + my @return; + push @return, + $self->apply(sub {$_->get_source_version_distribution(@_)}); + return + Debbugs::Collection::Version->new(versions => \@return, + $self->has_schema?(schema => $self->schema):(), + package_collection => $self->universe, + ); } +# given a list of binary versions or src/versions, returns all of the versions +# in this package collection which are known to match. You'll have to be sure to +# load appropriate versions beforehand for this to actually work. +sub get_source_versions { + my $self = shift; + my @return; + for my $ver (@_) { + my $sv; + if ($ver =~ m{(.+?)/(?.+)$/}) { + my $sp = $self->get_or_create('src:'.$+{src}); + push @return, + $sp->get_source_version($ver); + next; + } else { + my $found_valid = 0; + for my $p ($self->members) { + local $_; + my @vs = + grep {$_->is_valid} + $p->get_source_version($ver); + if (@vs) { + $found_valid = 1; + push @return,@vs; + next; + } + } + if (not $found_valid) { + push @return, + Debbugs::Version::Binary->new(version => $ver, + package_collection => $self->universe, + valid => 0, + $self->has_schema?(schema => $self->schema):(), + ); + } + } + } + return + Debbugs::Collection::Version->new(versions => \@return, + $self->has_schema?(schema => $self->schema):(), + package_collection => $self->universe, + ); +} + + __PACKAGE__->meta->make_immutable; 1; diff --git a/cgi/pkgreport.cgi b/cgi/pkgreport.cgi index bbed24d..3e61609 100755 --- a/cgi/pkgreport.cgi +++ b/cgi/pkgreport.cgi @@ -37,6 +37,7 @@ BEGIN { # if the first directory in @INC is not an absolute directory, assume that # someone has overridden us via -I. if ($INC[0] !~ /^\//) { + undef $debbugs_dir; } } use if defined $debbugs_dir, lib => $debbugs_dir; @@ -53,6 +54,7 @@ use Debbugs::Common qw(getparsedaddrs make_list getmaintainers getpseudodesc); use Debbugs::Bugs qw(get_bugs bug_filter newest_bug); use Debbugs::Packages qw(source_to_binary binary_to_source get_versions); +use Debbugs::Collection::Bug; use Debbugs::Status qw(splitpackages); @@ -464,7 +466,14 @@ my %bugs; @bugs{@bugs} = @bugs; @bugs = keys %bugs; -my $result = pkg_htmlizebugs(bugs => \@bugs, +my $bugs = Debbugs::Collection::Bug-> + new(bugs => \@bugs, + @schema_arg, + ); + +$bugs->load_related_packages_and_versions(); + +my $result = pkg_htmlizebugs(bugs => $bugs, names => \@names, title => \@title, order => \@order, -- 2.39.2