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);
32 use Debbugs::Config qw(:config);
33 use Debbugs::Status qw(read_bug);
34 use Debbugs::Bug::Tag;
35 use Debbugs::Collection::Package;
36 use Debbugs::Collection::Bug;
40 extends 'Debbugs::OOBase';
42 state $strong_severities =
43 {map {($_,1)} @{$config{strong_severities}}};
45 has bug => (is => 'ro', isa => 'Int',
49 has saved => (is => 'ro', isa => 'Bool',
51 writer => '_set_saved',
54 has status => (is => 'ro', isa => 'HashRef',
56 builder => '_build_status',
62 my $status = read_bug(bug=>$self->bug) or
63 confess("Unable to read bug ".$self->bug);
67 has 'package_collection' => (is => 'ro',
68 isa => 'Debbugs::Collection::Package',
69 builder => '_build_package_collection',
73 sub _build_package_collection {
74 return Debbugs::Collection::Package->new();
76 has bug_collection => (is => 'ro',
77 isa => 'Debbugs::Collection::Bug',
78 builder => '_build_bug_collection',
80 sub _build_bug_collection {
81 return Debbugs::Collection::Bug->new();
88 $self->_clear_severity();
89 $self->_clear_packages();
90 $self->_clear_sources();
91 $self->_clear_affects();
92 $self->_clear_blocks();
93 $self->_clear_blockedby();
94 $self->_clear_found();
95 $self->_clear_fixed();
96 $self->_clear_mergedwith();
97 $self->_clear_pending();
98 $self->_clear_location();
99 $self->_clear_archived();
100 $self->_clear_archiveable();
101 $self->_clear_when_archiveable();
102 $self->_clear_submitter();
103 $self->_clear_created();
104 $self->_clear_modified();
105 $self->_set_saved(1);
108 sub _clear_saved_if_changed {
109 my ($self,$new,$old) = @_;
112 $self->_set_saved(0);
118 for my $attr (qw(packages affects sources)) {
121 isa => 'Debbugs::Collection::Package',
122 clearer => '_clear_'.$attr,
123 builder => '_build_'.$attr,
124 trigger => \&_clear_saved_if_changed,
130 for my $attr (qw(blocks blockedby mergedwith)) {
133 isa => 'Debbugs::Collection::Bug',
134 clearer => '_clear_'.$attr,
135 builder => '_build_'.$attr,
143 for my $attr (qw(done severity),
145 qw(pending location submitter),
150 clearer => '_clear_'.$attr,
151 builder => '_build_'.$attr,
152 trigger => \&_clear_saved_if_changed,
158 return length $_[0]->done?1:0;
161 return $_[0]->status->{done} // '';
164 sub _build_severity {
165 return $_[0]->status->{severity} // $config{default_severity};
168 sub strong_severity {
170 return exists $strong_severities->{$self->severity};
175 return join(', ',map {$_->name} $_[0]->packages);
178 sub _build_packages {
179 return [$_[0]->package_collection->
180 get_package($_[0]->status->{package} //
187 return join(', ',map {$_->name} $_[0]->affects->members);
191 return [$_[0]->package_collection->
192 get_package($_[0]->status->{affects} //
198 return join(', ',map {$_->name} $_[0]->sources->members);
202 my @sources = map {$_->sources} $_[0]->packages;
206 sub _split_if_defined {
207 my ($self,$field,$split) = @_;
209 my $e = $self->status->{$field};
213 return split /$split/,$e;
220 return $self->bug_collection->
221 limit_or_create(sort {$a <=> $b}
222 $self->_split_if_defined('blocks'));
225 sub _build_blockedby {
227 return $self->bug_collection->
228 limit_or_create(sort {$a <=> $b}
229 $self->_split_if_defined('blockedby'));
234 return $self->sources->
235 versions($self->_split_if_defined('found',',\s*'));
241 return $self->sources->
242 versions($self->_split_if_defined('fixed',',\s*'));
244 sub _build_mergedwith {
246 return $self->bug_collection->
247 limit_or_create(sort {$a <=> $b}
248 $self->_split_if_defined('mergedwith'));
251 return $_[0]->status->{pending} // '';
253 sub _build_submitter {
254 return $_[0]->status->{originator} // '';
257 for my $attr (qw(created modified)) {
258 has $attr => (is => 'rw', isa => 'Object',
259 clearer => '_clear_'.$attr,
260 builder => '_build_'.$attr,
265 from_epoch(epoch => $_[0]->status->{date} // time);
267 sub _build_modified {
269 from_epoch(epoch => max($_[0]->status->{log_modified},
270 $_[0]->status->{last_modified}
273 sub _build_location {
274 return $_[0]->status->{location};
276 has archived => (is => 'ro', isa => 'Bool',
277 clearer => '_clear_archived',
278 builder => '_build_archived',
280 sub _build_archived {
281 return $_[0]->location eq 'archived'?1:0;
284 has tags => (is => 'ro', isa => 'Object',
285 clearer => '_clear_tags',
286 builder => '_build_tags',
290 return Debbugs::Bug::Tag->new($_[0]->status->{keywords});
295 $bug->buggy('debbugs/2.6.0-1','debbugs/2.6.0-2');
296 $bug->buggy(Debbugs::Version->new('debbugs/2.6.0-1'),
297 Debbugs::Version->new('debbugs/2.6.0-2'),
300 Returns the output of Debbugs::Versions::buggy for a particular
301 package, version and found/fixed set. Automatically turns found, fixed
302 and version into source/version strings.
309 $self->package_collection->
311 my $max_buggy = 'absent';
314 $ver = Debbugs::Version->
316 package_collection => $self->package_collection,
319 $vertree->load($ver->source);
323 [map {$_->srcver} $self->found],
324 [map {$_->srcver} $self->fixed]);
325 if ($buggy eq 'found') {
328 if ($buggy eq 'fixed') {
329 $max_buggy = 'fixed';
336 (is => 'ro', isa => 'Bool',
337 writer => '_set_archiveable',
338 builder => '_build_archiveable',
339 clearer => '_clear_archiveable',
342 has when_archiveable =>
343 (is => 'ro', isa => 'Num',
344 writer => '_set_when_archiveable',
345 builder => '_build_when_archiveable',
346 clearer => '_clear_when_archiveable',
350 sub _build_archiveable {
352 $self->_populate_archiveable(0);
353 return $self->archiveable;
355 sub _build_when_archiveable {
357 $self->_populate_archiveable(1);
358 return $self->when_archiveable;
361 sub _populate_archiveable {
363 my ($need_time) = @_;
365 # Bugs can be archived if they are
367 if (not $self->done) {
368 $self->_set_archiveable(0);
369 $self->_set_when_archiveable(-1);
372 # 2. Have no unremovable tags set
373 if (@{$config{removal_unremovable_tags}}) {
375 {map {($_=>1)} @{$config{removal_unremovable_tags}}};
376 for my $tag ($self->tags) {
377 if ($unrem_tags->{$tag}) {
378 $self->_set_archiveable(0);
379 $self->_set_when_archiveable(-1);
385 state $remove_time = 24 * 60 * 60 * $config{removal_age};
386 # 4. Have been modified more than removal_age ago
388 $time - $self->last_modified;
389 # if we don't need to know when we can archive, we can stop here if it's
390 # been modified too recently
391 if ($moded_ago < $remove_time) {
392 $self->_set_archiveable(0);
393 return unless $need_time;
396 @{$config{removal_default_distribution_tags}};
397 if ($self->strong_severity) {
399 @{$config{removal_strong_severity_default_distribution_tags}};
401 # 3. Have a maximum buggy of fixed
402 my $buggy = $self->buggy($self->package->
403 dist_source_versions(@distributions));
404 if ('found' eq $buggy) {
405 $self->_set_archiveable(0);
406 $self->_set_when_archiveable(-1);
409 my $fixed_ago = $time - $self->when_fixed(@distributions);
410 if ($fixed_ago < $remove_time) {
411 $self->_set_archiveable(0);
413 $self->_set_when_archiveable(($remove_time - min($fixed_ago,$moded_ago)) / (24 * 60 * 60));
414 if ($fixed_ago > $remove_time and
415 $moded_ago > $remove_time) {
416 $self->_set_archiveable(1);
417 $self->_set_when_archiveable(0);
429 # indent-tabs-mode: nil
430 # cperl-indent-level: 4