1 # This module is part of debbugs, and
2 # is released under the terms of the GPL version 2, or any later
3 # version (at your option). See the file README and COPYING for more
5 # Copyright 2018 by Don Armstrong <don@donarmstrong.com>.
11 Debbugs::Bug -- OO interface to bugs
16 Debbugs::Bug->new(schema => $s,binaries => [qw(foo)],sources => [qw(bar)]);
27 use v5.10; # for state
30 use List::AllUtils qw(max first min);
32 use Params::Validate qw(validate_with :types);
33 use Debbugs::Config qw(:config);
34 use Debbugs::Status qw(read_bug);
35 use Debbugs::Bug::Tag;
36 use Debbugs::Collection::Package;
37 use Debbugs::Collection::Bug;
38 use Debbugs::Collection::Correspondent;
44 extends 'Debbugs::OOBase';
46 state $strong_severities =
47 {map {($_,1)} @{$config{strong_severities}}};
49 has bug => (is => 'ro', isa => 'Int',
57 has saved => (is => 'ro', isa => 'Bool',
59 writer => '_set_saved',
62 has status => (is => 'ro', isa => 'HashRef',
64 builder => '_build_status',
70 my $status = read_bug(bug=>$self->bug) or
71 confess("Unable to read bug ".$self->bug);
75 has 'package_collection' => (is => 'ro',
76 isa => 'Debbugs::Collection::Package',
77 builder => '_build_package_collection',
81 sub _build_package_collection {
83 if ($self->has_schema) {
84 return Debbugs::Collection::Package->new(schema => $self->schema);
86 carp "No schema when building package collection";
87 return Debbugs::Collection::Package->new();
90 has bug_collection => (is => 'ro',
91 isa => 'Debbugs::Collection::Bug',
92 builder => '_build_bug_collection',
94 sub _build_bug_collection {
96 if ($self->has_schema) {
97 return Debbugs::Collection::Bug->new(schema => $self->schema);
99 return Debbugs::Collection::Bug->new();
102 has correspondent_collection =>
104 isa => 'Debbugs::Collection::Correspondent',
105 builder => '_build_package_collection',
108 sub _build_correspondent_collection {
110 if ($self->has_schema) {
111 return Debbugs::Collection::Correspondent->new(schema => $self->schema);
113 return Debbugs::Collection::Correspondent->new();
118 $self->_clear_done();
119 $self->_clear_severity();
120 $self->_clear_packages();
121 $self->_clear_sources();
122 $self->_clear_affects();
123 $self->_clear_blocks();
124 $self->_clear_blockedby();
125 $self->_clear_found();
126 $self->_clear_fixed();
127 $self->_clear_mergedwith();
128 $self->_clear_pending();
129 $self->_clear_location();
130 $self->_clear_archived();
131 $self->_clear_archiveable();
132 $self->_clear_when_archiveable();
133 $self->_clear_submitter();
134 $self->_clear_created();
135 $self->_clear_modified();
136 $self->_set_saved(1);
139 sub _clear_saved_if_changed {
140 my ($self,$new,$old) = @_;
143 $self->_set_saved(0);
149 for my $attr (qw(packages affects sources)) {
152 isa => 'Debbugs::Collection::Package',
153 clearer => '_clear_'.$attr,
154 builder => '_build_'.$attr,
155 trigger => \&_clear_saved_if_changed,
161 for my $attr (qw(blocks blockedby mergedwith)) {
164 isa => 'Debbugs::Collection::Bug',
165 clearer => '_clear_'.$attr,
166 builder => '_build_'.$attr,
173 for my $attr (qw(owner submitter)) {
176 isa => 'Debbugs::Correspondent',
178 builder => '_build_'.$attr.'_corr',
179 clearer => '_clear_'.$attr.'_corr',
180 handles => {$attr.'_url' => $attr.'_url',
181 $attr.'_email' => 'email',
182 $attr.'_phrase' => 'phrase',
187 sub _build_owner_corr {
189 return $self->correspondent_collection->get_or_create($self->owner);
192 sub _build_submitter_corr {
194 return $self->correspondent_collection->get_or_create($self->submitter);
197 for my $attr (qw(done severity),
199 qw(pending location submitter),
205 clearer => '_clear_'.$attr,
206 builder => '_build_'.$attr,
207 trigger => \&_clear_saved_if_changed,
213 return length $_[0]->done?1:0;
216 return $_[0]->status->{done} // '';
219 sub _build_severity {
220 return $_[0]->status->{severity} // $config{default_severity};
224 return $_[0]->status->{subject} // '(No subject)';
227 sub strong_severity {
229 return exists $strong_severities->{$self->severity};
233 $_[0]->severity =~ m/^(.)/;
239 return join(', ',$self->packages->apply(sub{$_->name}));
242 sub _build_packages {
245 if (length($self->status->{package}//'')) {
246 @packages = split /,/,$self->status->{package}//'';
248 return $self->package_collection->
254 return $self->affects->count > 0;
259 return join(', ',map {$_->name} $_[0]->affects->members);
264 if (length($_[0]->status->{affects}//'')) {
265 @packages = split /,/,$_[0]->status->{affects}//'';
267 return $_[0]->package_collection->
272 return join(', ',map {$_->name} $_[0]->sources->members);
276 my @sources = map {$_->sources} $_[0]->packages->members;
282 return length($self->owner) > 0;
286 return $self->status->{owner} // '';
290 sub _split_if_defined {
291 my ($self,$field,$split) = @_;
293 my $e = $self->status->{$field};
297 return split /$split/,$e;
304 return $self->blocks->count > 0;
309 return $self->bug_collection->
310 limit(sort {$a <=> $b}
311 $self->_split_if_defined('blocks'));
316 return $self->blockedby->count > 0;
319 sub _build_blockedby {
321 return $self->bug_collection->
322 limit(sort {$a <=> $b}
323 $self->_split_if_defined('blockedby'));
327 length($_[0]->forwarded) > 0;
330 sub _build_forwarded {
332 return $self->status->{forwarded} // '';
337 for my $attr (qw(fixed found)) {
340 isa => 'Debbugs::Collection::Version',
341 clearer => '_clear_'.$attr,
342 builder => '_build_'.$attr,
350 return $self->found->count > 0;
355 return $self->packages->
356 get_source_versions(@{$self->status->{found_versions} // []});
361 return $self->fixed->count > 0;
366 return $self->packages->
367 get_source_versions(@{$self->status->{fixed_versions} // []});
372 return $self->mergedwith->count > 0;
375 sub _build_mergedwith {
377 return $self->bug_collection->
378 limit(sort {$a <=> $b}
379 $self->_split_if_defined('mergedwith'));
382 return $_[0]->status->{pending} // '';
384 sub _build_submitter {
385 return $_[0]->status->{originator} // '';
388 for my $attr (qw(created modified)) {
389 has $attr => (is => 'rw', isa => 'Object',
390 clearer => '_clear_'.$attr,
391 builder => '_build_'.$attr,
396 from_epoch(epoch => $_[0]->status->{date} // time);
398 sub _build_modified {
400 from_epoch(epoch => max($_[0]->status->{log_modified},
401 $_[0]->status->{last_modified}
404 sub _build_location {
405 return $_[0]->status->{location};
407 has archived => (is => 'ro', isa => 'Bool',
408 clearer => '_clear_archived',
409 builder => '_build_archived',
411 sub _build_archived {
412 return $_[0]->location eq 'archived'?1:0;
415 has tags => (is => 'ro', isa => 'Object',
416 clearer => '_clear_tags',
417 builder => '_build_tags',
421 return Debbugs::Bug::Tag->new($_[0]->status->{keywords});
426 $bug->buggy('debbugs/2.6.0-1','debbugs/2.6.0-2');
427 $bug->buggy(Debbugs::Version->new('debbugs/2.6.0-1'),
428 Debbugs::Version->new('debbugs/2.6.0-2'),
431 Returns the output of Debbugs::Versions::buggy for a particular
432 package, version and found/fixed set. Automatically turns found, fixed
433 and version into source/version strings.
440 $self->package_collection->
441 universe->versiontree;
442 my $max_buggy = 'absent';
445 $ver = Debbugs::Version->
448 package_collection => $self->package_collection,
451 $vertree->load($ver->source);
453 $vertree->buggy($ver,
456 if ($buggy eq 'found') {
459 if ($buggy eq 'fixed') {
460 $max_buggy = 'fixed';
467 (is => 'ro', isa => 'Bool',
468 writer => '_set_archiveable',
469 builder => '_build_archiveable',
470 clearer => '_clear_archiveable',
473 has when_archiveable =>
474 (is => 'ro', isa => 'Num',
475 writer => '_set_when_archiveable',
476 builder => '_build_when_archiveable',
477 clearer => '_clear_when_archiveable',
481 sub _build_archiveable {
483 $self->_populate_archiveable(0);
484 return $self->archiveable;
486 sub _build_when_archiveable {
488 $self->_populate_archiveable(1);
489 return $self->when_archiveable;
492 sub _populate_archiveable {
494 my ($need_time) = @_;
496 # Bugs can be archived if they are
498 if (not $self->done) {
499 $self->_set_archiveable(0);
500 $self->_set_when_archiveable(-1);
503 # 2. Have no unremovable tags set
504 if (@{$config{removal_unremovable_tags}}) {
506 {map {($_=>1)} @{$config{removal_unremovable_tags}}};
507 for my $tag ($self->tags) {
508 if ($unrem_tags->{$tag}) {
509 $self->_set_archiveable(0);
510 $self->_set_when_archiveable(-1);
516 state $remove_time = 24 * 60 * 60 * ($config{removal_age} // 30);
517 # 4. Have been modified more than removal_age ago
519 $time - $self->modified->epoch;
520 # if we don't need to know when we can archive, we can stop here if it's
521 # been modified too recently
522 if ($moded_ago < $remove_time) {
523 $self->_set_archiveable(0);
524 return unless $need_time;
527 @{$config{removal_default_distribution_tags}};
528 if ($self->strong_severity) {
530 @{$config{removal_strong_severity_default_distribution_tags}};
532 # 3. Have a maximum buggy of fixed
533 my $buggy = $self->buggy($self->packages->
534 get_source_versions_distributions(@distributions));
535 if ('found' eq $buggy) {
536 $self->_set_archiveable(0);
537 $self->_set_when_archiveable(-1);
540 my $fixed_ago = $moded_ago;
541 # $fixed_ago = $time - $self->when_fixed(@distributions);
542 # if ($fixed_ago < $remove_time) {
543 # $self->_set_archiveable(0);
545 $self->_set_when_archiveable(($remove_time - min($fixed_ago,$moded_ago)) / (24 * 60 * 60));
546 if ($fixed_ago > $remove_time and
547 $moded_ago > $remove_time) {
548 $self->_set_archiveable(1);
549 $self->_set_when_archiveable(0);
556 my %param = validate_with(params => \@_,
557 spec => {seen_merged => {type => HASHREF,
558 default => sub {return {}},
560 repeat_merged => {type => BOOLEAN,
563 include => {type => HASHREF,
566 exclude => {type => HASHREF,
569 min_days => {type => SCALAR,
572 max_days => {type => SCALAR,
577 if (exists $param{include}) {
578 return 1 if not $self->matches($param{include});
580 if (exists $param{exclude}) {
581 return 1 if $self->matches($param{exclude});
583 if (exists $param{repeat_merged} and not $param{repeat_merged}) {
584 my @merged = sort {$a<=>$b} $self->bug, map {$_->bug} $self->mergedwith->members;
585 return 1 if first {sub {defined $_}}
586 @{$param{seen_merged}}{@merged};
587 @{$param{seen_merged}}{@merged} = (1) x @merged;
589 if (exists $param{min_days}) {
590 return 1 unless $param{min_days} <=
591 (DateTime->now() - $self->created)->days();
593 if (exists $param{max_days}) {
594 return 1 unless $param{max_days} >=
595 (DateTime->now() - $self->created)->days();
602 my ($field, $values) = @_;
603 my @ret = first {sub {$_ eq $field}} @{$values};
607 sub __contains_match {
608 my ($field, $values) = @_;
609 foreach my $value (@{$values}) {
610 return 1 if (index($field, $value) > -1);
616 {subject => sub {__contains_match($_[0]->subject,@_)},
618 for my $value (@{$_[1]}) {
619 if ($_[0]->tags->is_set($value)) {
625 severity => sub {__exact_match($_[0]->severity,@_)},
626 pending => sub {__exact_match($_[0]->pending,@_)},
627 originator => sub {__exact_match($_[0]->submitter,@_)},
628 submitter => sub {__exact_match($_[0]->submitter,@_)},
629 forwarded => sub {__exact_match($_[0]->forwarded,@_)},
630 owner => sub {__exact_match($_[0]->owner,@_)},
634 my ($self,$hash) = @_;
635 for my $key (keys %{$hash}) {
636 my $sub = $field_match->{$key};
637 if (not defined $sub) {
638 carp "No subroutine for key: $key";
641 return 1 if $sub->($self,$hash->{$key});
648 return $config{web_domain}.'/'.$self->id;
651 sub related_packages_and_versions {
654 if (length($self->status->{package}//'')) {
655 @packages = split /,/,$self->status->{package}//'';
658 (@{$self->status->{found_versions}//[]},
659 @{$self->status->{fixed_versions}//[]});
660 my @unqualified_versions;
662 for my $ver (@versions) {
663 if ($ver =~ m{(<src>.+)/(<ver>.+)}) { # It's a src_pkg_ver
664 push @return, ['src:'.$+{src}, $+{ver}];
666 push @unqualified_versions,$ver;
669 for my $pkg (@packages) {
671 [$pkg,@unqualified_versions];
683 # indent-tabs-mode: nil
684 # cperl-indent-level: 4