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>.
7 package Debbugs::Bug::Status;
11 Debbugs::Bug::Status -- OO interface to status files
16 Debbugs::Bug->new(schema => $s,binaries => [qw(foo)],sources => [qw(bar)]);
27 use v5.10; # for state
28 use Mouse::Util::TypeConstraints qw(enum);
31 use List::AllUtils qw(max first min);
33 use Params::Validate qw(validate_with :types);
34 use Debbugs::Common qw(make_list);
35 use Debbugs::Config qw(:config);
36 use Debbugs::Status qw(get_bug_status);
42 extends 'Debbugs::OOBase';
44 my $meta = __PACKAGE__->meta;
46 has bug => (is => 'ro', isa => 'Int',
49 # status obtained from DB, filesystem, or hashref
50 has status_source => (is => 'ro',
51 isa => enum([qw(db filesystem hashref)]),
52 default => 'filesystem',
53 writer => '_set_status_source',
59 if (not exists $args->{status} and exists $args->{bug}) {
60 if ($self->has_schema) {
62 $self->schema->resultset('BugStatus')->
63 search_rs({id => [make_list($args->{bug})]},
64 {result_class => 'DBIx::Class::ResultClass::HashRefInflator'})->
66 state $field_mapping =
67 {originator => 'submitter',
68 blockedby => 'blocked_by',
69 found_versions => 'found',
70 fixed_versions => 'fixed',
72 for my $field (keys %{$field_mapping}) {
73 $args->{status}{$field_mapping->{$field}} =
74 $args->{status}{$field} if defined $args->{status}{$field};
75 delete $args->{status}{$field};
77 $self->_set_status_source('db');
79 $args->{status} = get_bug_status(bug=>$args->{bug});
80 state $field_mapping =
81 {originator => 'submitter',
83 msgid => 'message_id',
84 blockedby => 'blocked_by',
85 found_versions => 'found',
86 fixed_versions => 'fixed',
88 for my $field (keys %{$field_mapping}) {
89 $args->{status}{$field_mapping->{$field}} =
90 $args->{status}{$field};
92 $self->_set_status_source('filesystem');
94 } elsif (exists $args->{status}) {
95 $self->_set_status_source('hashref');
97 if (exists $args->{status}) {
98 if (ref($args->{status}) ne 'HASH') {
99 croak "status must be a HASHREF (argument to __PACKAGE__)";
101 # single value fields
102 for my $field (qw(submitter date subject message_id done severity unarchived),
103 qw(owner summary outlook bug log_modified),
104 qw(last_modified archived forwarded)) {
105 next unless defined $args->{status}{$field};
106 # we're going to let status override passed values in args for now;
107 # maybe this should change
108 my $field_method = $meta->find_method_by_name('_set_'.$field);
109 if (not defined $field_method) {
110 croak "Unable to find field method for _set_$field";
112 $field_method->($self,$args->{status}{$field});
115 for my $field (qw(affects package tags blocks blocked_by mergedwith),
117 next unless defined $args->{status}{$field};
118 my $field_method = $meta->find_method_by_name('_set_'.$field);
119 my $split_field = $args->{status}{$field};
120 if (!ref($split_field)) {
122 _build_split_field($args->{status}{$field},
125 $field_method->($self,
129 delete $args->{status};
133 has saved => (is => 'ro', isa => 'Bool',
135 writer => '_set_set_saved',
142 =head3 Single-value Fields
146 =item submitter (single)
153 default => $config{maintainer_email},
154 writer => '_set_submitter',
164 builder => sub {return time},
166 writer => '_set_date',
169 =item last_modified (single)
176 builder => sub {return time},
178 writer => '_set_last_modified',
181 =item log_modified (single)
188 builder => sub {return time},
190 writer => '_set_log_modified',
201 default => 'No subject',
202 writer => '_set_subject',
216 return 'nomessageid.'.$self->date.'_'.
217 md5_hex($self->subject.$self->submitter).'@'.$config{email_domain},
219 writer => '_set_message_id',
232 default => $config{default_severity},
233 writer => '_set_severity',
238 Unix epoch the bug was last unarchived. Zero if the bug has never been
247 writer => '_set_unarchived',
252 True if the bug is archived, false otherwise.
260 writer => '_set_archived',
275 for my $field (qw(owner unarchived summary outlook done forwarded)) {
280 writer => '_set_'.$field,
282 my $field_method = $meta->find_method_by_name($field);
283 die "No field method for $field" unless defined $field_method;
284 $meta->add_method('has_'.$field =>
285 sub {my $self = shift;
286 return length($field_method->($self));
292 =head3 Multi-value Fields
304 for my $field (qw(affects package tags)) {
307 traits => [qw(Array)],
308 isa => 'ArrayRef[Str]',
309 default => sub {return []},
310 writer => '_set_'.$field,
311 handles => {$field => 'elements',
315 my $field_method = $meta->find_method_by_name($field);
316 if (defined $field_method) {
317 $meta->add_method($field.'_ref'=>
318 sub {my $self = shift;
319 return [$field_method->($self)]
330 for my $field (qw(found fixed)) {
334 isa => 'HashRef[Str]',
335 default => sub {return {}},
336 writer => '_set_'.$field,
337 handles => {$field => 'keys',
341 my $field_method = $meta->find_method_by_name($field);
342 if (defined $field_method) {
343 $meta->add_method('_'.$field.'_ref'=>
344 sub {my $self = shift;
345 return [$field_method->($self)]
351 for (qw(found fixed)) {
352 around '_set_'.$_ => sub {
355 if (defined ref($_[0]) and
356 ref($_[0]) eq 'ARRAY'
358 @_ = {map {$_,'1'} @{$_[0]}};
360 @_ = {map {$_,'1'} @_};
376 for my $field (qw(blocks blocked_by mergedwith)) {
380 isa => 'HashRef[Int]',
381 default => sub {return {}},
382 writer => '_set_'.$field,
385 my $internal_field_method = $meta->find_method_by_name('_'.$field);
386 die "No field method for _$field" unless defined $internal_field_method;
387 $meta->add_method($field =>
388 sub {my $self = shift;
389 return sort {$a <=> $b}
390 keys %{$internal_field_method->($self)};
392 my $field_method = $meta->find_method_by_name($field);
393 die "No field method for _$field" unless defined $field_method;
394 $meta->add_method('_'.$field.'_ref'=>
395 sub {my $self = shift;
396 return [$field_method->($self)]
400 for (qw(blocks blocked_by mergedwith)) {
401 around '_set_'.$_ => sub {
404 if (defined ref($_[0]) and
405 ref($_[0]) eq 'ARRAY'
407 $_[0] = {map {$_,'1'} @{$_[0]}};
409 @_ = {map {$_,'1'} @{$_[0]}};
419 sub _build_split_field {
420 sub sort_and_unique {
425 if ($all_numeric and $v =~ /\D/) {
428 next if exists $u{$v};
433 return sort {$a <=> $b} @v;
438 sub split_ditch_empty {
439 return grep {length $_} map {split ' '} @_;
442 my ($val,$field) = @_;
445 if ($field =~ /^(package|affects|source)$/) {
446 return [grep {length $_} map lc, split /[\s,()?]+/, $val];
448 return [sort_and_unique(split_ditch_empty($val))];
453 __PACKAGE__->meta->make_immutable;
456 no Mouse::Util::TypeConstraints;
462 # indent-tabs-mode: nil
463 # cperl-indent-level: 4