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 =
required => 1,
);
+sub id {
+ return $_[0]->bug;
+}
+
has saved => (is => 'ro', isa => 'Bool',
default => 0,
writer => '_set_saved',
);
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;
# bugs
for my $attr (qw(blocks blockedby mergedwith)) {
has $attr =>
- (is => 'bare',
+ (is => 'ro',
isa => 'Debbugs::Collection::Bug',
clearer => '_clear_'.$attr,
builder => '_build_'.$attr,
}
+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',
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 {
}
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 $_;
}
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} // '';
}
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} // '';
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'
}
}
}
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) {
@{$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) {
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{(<src>.+)/(<ver>.+)}) { # 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;
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 {
}
};
-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 {
if (not $self->valid_tag($tag)) {
confess("Invalid tag $tag");
}
- $self->tags->{$tag} = 1;
+ $self->_tags->{$tag} = 1;
}
return $self;
}
}
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;
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',
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;
}
}
# 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;
}
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 {
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}//[]},
);
}
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}//[]},
);
}
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);
};
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;
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{(<src>.+?)/(?<ver>.+)$/}) {
+ 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;
# 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;
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);
@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,