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',
56 has _status => (is => 'bare',
57 writer => '_set_status',
59 predicate => '_has__status',
67 if (not exists $args->{status} and exists $args->{bug}) {
68 if ($self->has_schema) {
70 $self->schema->resultset('BugStatus')->
71 search_rs({id => [make_list($args->{bug})]},
72 {result_class => 'DBIx::Class::ResultClass::HashRefInflator'})->
74 state $field_mapping =
75 {originator => 'submitter',
76 blockedby => 'blocked_by',
77 found_versions => 'found',
78 fixed_versions => 'fixed',
80 for my $field (keys %{$field_mapping}) {
81 $args->{status}{$field_mapping->{$field}} =
82 $args->{status}{$field} if defined $args->{status}{$field};
83 delete $args->{status}{$field};
85 $self->_set_status_source('db');
87 $args->{status} = get_bug_status(bug=>$args->{bug});
88 state $field_mapping =
89 {originator => 'submitter',
91 msgid => 'message_id',
92 blockedby => 'blocked_by',
93 found_versions => 'found',
94 fixed_versions => 'fixed',
96 for my $field (keys %{$field_mapping}) {
97 $args->{status}{$field_mapping->{$field}} =
98 $args->{status}{$field};
100 $self->_set_status_source('filesystem');
102 } elsif (exists $args->{status}) {
103 $self->_set_status_source('hashref');
105 if (exists $args->{status}) {
106 if (ref($args->{status}) ne 'HASH') {
107 croak "status must be a HASHREF (argument to __PACKAGE__)";
109 $self->_set_status($args->{status});
110 # single value fields
111 for my $field (qw(submitter date subject message_id done severity unarchived),
112 qw(owner summary outlook bug log_modified),
113 qw(last_modified archived forwarded)) {
114 next unless defined $args->{status}{$field};
115 # we're going to let status override passed values in args for now;
116 # maybe this should change
117 if (not exists $field_methods{'_set_'.$field}) {
118 $field_methods{'_set_'.$field} =
119 $meta->find_method_by_name('_set_'.$field);
120 if (not defined $field_methods{'_set_'.$field}) {
121 croak "Unable to find field method for _set_$field";
124 $field_methods{'_set_'.$field}->($self,$args->{status}{$field});
127 for my $field (qw(affects package tags blocks blocked_by mergedwith),
129 next unless defined $args->{status}{$field};
130 my $field_method = $meta->find_method_by_name('_set_'.$field);
131 if (not exists $field_methods{'_set_'.$field}) {
132 $field_methods{'_set_'.$field} =
133 $meta->find_method_by_name('_set_'.$field);
134 if (not defined $field_methods{'_set_'.$field}) {
135 croak "Unable to find field method for _set_$field";
138 my $split_field = $args->{status}{$field};
139 if (!ref($split_field)) {
141 _build_split_field($args->{status}{$field},
144 $field_methods{'_set_'.$field}->($self,
147 delete $args->{status};
151 has saved => (is => 'ro', isa => 'Bool',
153 writer => '_set_set_saved',
157 my ($self,$field,$default) = @_;
158 if ($self->_has__status) {
159 my $s = $self->_status()->{$field};
160 return $s if defined $s;
169 =head3 Single-value Fields
173 =item submitter (single)
183 $self->__field_or_def('submitter',
184 $config{maintainer_email});
186 writer => '_set_submitter',
199 $self->__field_or_def('date',
203 writer => '_set_date',
206 =item last_modified (single)
216 $self->__field_or_def('last_modified',
220 writer => '_set_last_modified',
223 =item log_modified (single)
233 $self->__field_or_def('log_modified',
237 writer => '_set_log_modified',
251 $self->__field_or_def('subject',
254 writer => '_set_subject',
268 $self->__field_or_def('message_id',
269 'nomessageid.'.$self->date.'_'.
270 md5_hex($self->subject.$self->submitter).
271 '@'.$config{email_domain},
274 writer => '_set_message_id',
290 $self->__field_or_def('severity',
291 $config{default_severity});
293 writer => '_set_severity',
298 Unix epoch the bug was last unarchived. Zero if the bug has never been
309 $self->__field_or_def('unarchived',
312 writer => '_set_unarchived',
317 True if the bug is archived, false otherwise.
327 $self->__field_or_def('archived',
330 writer => '_set_archived',
345 for my $field (qw(owner unarchived summary outlook done forwarded)) {
352 $self->__field_or_def($field,
355 writer => '_set_'.$field,
357 my $field_method = $meta->find_method_by_name($field);
358 die "No field method for $field" unless defined $field_method;
359 $meta->add_method('has_'.$field =>
360 sub {my $self = shift;
361 return length($field_method->($self));
367 =head3 Multi-value Fields
379 for my $field (qw(affects package tags)) {
382 traits => [qw(Array)],
383 isa => 'ArrayRef[Str]',
387 if ($self->_has__status) {
388 my $s = $self->_status()->{$field};
390 $s = _build_split_field($s,
397 writer => '_set_'.$field,
398 handles => {$field => 'elements',
402 my $field_method = $meta->find_method_by_name($field);
403 if (defined $field_method) {
404 $meta->add_method($field.'_ref'=>
405 sub {my $self = shift;
406 return [$field_method->($self)]
417 sub __hashref_field {
418 my ($self,$field) = @_;
420 if ($self->_has__status) {
421 my $s = $self->_status()->{$field};
423 $s = _build_split_field($s,
431 for my $field (qw(found fixed)) {
435 isa => 'HashRef[Str]',
439 if ($self->_has__status) {
440 my $s = $self->_status()->{$field};
442 $s = _build_split_field($s,
445 if (ref($s) ne 'HASH') {
446 $s = {map {$_,'1'} @{$s}};
452 default => sub {return {}},
453 writer => '_set_'.$field,
454 handles => {$field => 'keys',
458 my $field_method = $meta->find_method_by_name($field);
459 if (defined $field_method) {
460 $meta->add_method('_'.$field.'_ref'=>
461 sub {my $self = shift;
462 return [$field_method->($self)]
468 for (qw(found fixed)) {
469 around '_set_'.$_ => sub {
472 if (defined ref($_[0]) and
473 ref($_[0]) eq 'ARRAY'
475 @_ = {map {$_,'1'} @{$_[0]}};
477 @_ = {map {$_,'1'} @_};
493 for my $field (qw(blocks blocked_by mergedwith)) {
497 isa => 'HashRef[Int]',
501 if ($self->_has__status) {
502 my $s = $self->_status()->{$field};
504 $s = _build_split_field($s,
507 if (ref($s) ne 'HASH') {
508 $s = {map {$_,'1'} @{$s}};
514 writer => '_set_'.$field,
517 my $internal_field_method = $meta->find_method_by_name('_'.$field);
518 die "No field method for _$field" unless defined $internal_field_method;
519 $meta->add_method($field =>
520 sub {my $self = shift;
521 return sort {$a <=> $b}
522 keys %{$internal_field_method->($self)};
524 my $field_method = $meta->find_method_by_name($field);
525 die "No field method for _$field" unless defined $field_method;
526 $meta->add_method('_'.$field.'_ref'=>
527 sub {my $self = shift;
528 return [$field_method->($self)]
532 for (qw(blocks blocked_by mergedwith)) {
533 around '_set_'.$_ => sub {
536 if (defined ref($_[0]) and
537 ref($_[0]) eq 'ARRAY'
539 $_[0] = {map {$_,'1'} @{$_[0]}};
541 @_ = {map {$_,'1'} @{$_[0]}};
551 sub _build_split_field {
552 sub sort_and_unique {
557 if ($all_numeric and $v =~ /\D/) {
560 next if exists $u{$v};
565 return sort {$a <=> $b} @v;
570 sub split_ditch_empty {
571 return grep {length $_} map {split ' '} @_;
574 my ($val,$field) = @_;
577 if ($field =~ /^(package|affects|source)$/) {
578 return [grep {length $_} map lc, split /[\s,()?]+/, $val];
580 return [sort_and_unique(split_ditch_empty($val))];
585 __PACKAGE__->meta->make_immutable;
588 no Mouse::Util::TypeConstraints;
594 # indent-tabs-mode: nil
595 # cperl-indent-level: 4