X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FBug%2FStatus.pm;fp=Debbugs%2FBug%2FStatus.pm;h=9209485690059479238bfde03e525917f82d2193;hb=b1252b6797aa6a79d00a32165fb2fa8fb1bd9318;hp=0000000000000000000000000000000000000000;hpb=06424150844462de782ae112aa26c80dfa8d9401;p=debbugs.git diff --git a/Debbugs/Bug/Status.pm b/Debbugs/Bug/Status.pm new file mode 100644 index 0000000..9209485 --- /dev/null +++ b/Debbugs/Bug/Status.pm @@ -0,0 +1,576 @@ +# This module is part of debbugs, and +# is released under the terms of the GPL version 2, or any later +# version (at your option). See the file README and COPYING for more +# information. +# Copyright 2018 by Don Armstrong . + +package Debbugs::Bug::Status; + +=head1 NAME + +Debbugs::Bug::Status -- OO interface to status files + +=head1 SYNOPSIS + + use Debbugs::Bug; + Debbugs::Bug->new(schema => $s,binaries => [qw(foo)],sources => [qw(bar)]); + +=head1 DESCRIPTION + + + +=cut + +use Mouse; +use strictures 2; +use namespace::clean; +use v5.10; # for state +use Mouse::Util::TypeConstraints qw(enum); + +use DateTime; +use List::AllUtils qw(max first min); + +use Params::Validate qw(validate_with :types); +use Debbugs::Common qw(make_list); +use Debbugs::Config qw(:config); +use Debbugs::Status qw(get_bug_status); + +use Debbugs::OOTypes; + +use Carp; + +extends 'Debbugs::OOBase'; + +my $meta = __PACKAGE__->meta; + +has bug => (is => 'ro', isa => 'Int', + ); + +# status obtained from DB, filesystem, or hashref +has status_source => (is => 'ro', + isa => enum([qw(db filesystem hashref)]), + default => 'filesystem', + writer => '_set_status_source', + ); + +has _status => (is => 'bare', + writer => '_set_status', + reader => '_status', + predicate => '_has__status', + ); + +my %field_methods; + +sub BUILD { + my $self = shift; + my $args = shift; + state $field_mapping = + {originator => 'submitter', + keywords => 'tags', + msgid => 'message_id', + blockedby => 'blocked_by', + found_versions => 'found', + fixed_versions => 'fixed', + }; + if (not exists $args->{status} and exists $args->{bug}) { + if ($self->has_schema) { + ($args->{status}) = + $self->schema->resultset('BugStatus')-> + search_rs({id => [make_list($args->{bug})]}, + {result_class => 'DBIx::Class::ResultClass::HashRefInflator'})-> + all(); + for my $field (keys %{$field_mapping}) { + $args->{status}{$field_mapping->{$field}} = + $args->{status}{$field} if defined $args->{status}{$field}; + delete $args->{status}{$field}; + } + $self->_set_status_source('db'); + } else { + $args->{status} = get_bug_status(bug=>$args->{bug}); + for my $field (keys %{$field_mapping}) { + $args->{status}{$field_mapping->{$field}} = + $args->{status}{$field} if defined $args->{status}{$field}; + } + $self->_set_status_source('filesystem'); + } + } elsif (exists $args->{status}) { + for my $field (keys %{$field_mapping}) { + $args->{status}{$field_mapping->{$field}} = + $args->{status}{$field} if defined $args->{status}{$field}; + } + $self->_set_status_source('hashref'); + } + if (exists $args->{status}) { + if (ref($args->{status}) ne 'HASH') { + croak "status must be a HASHREF (argument to __PACKAGE__)"; + } + $self->_set_status($args->{status}); + delete $args->{status}; + } +} + +has saved => (is => 'ro', isa => 'Bool', + default => 0, + writer => '_set_set_saved', + ); + +sub __field_or_def { + my ($self,$field,$default) = @_; + if ($self->_has__status) { + my $s = $self->_status()->{$field}; + return $s if defined $s; + } + return $default; +} + +=head2 Status Fields + +=cut + +=head3 Single-value Fields + +=over + +=item submitter (single) + +=cut + +has submitter => + (is => 'ro', + isa => 'Str', + builder => + sub { + my $self = shift; + $self->__field_or_def('submitter', + $config{maintainer_email}); + }, + lazy => 1, + writer => '_set_submitter', + ); + +=item date (single) + +=cut + +has date => + (is => 'ro', + isa => 'Str', + builder => + sub { + my $self = shift; + $self->__field_or_def('date', + time); + }, + lazy => 1, + writer => '_set_date', + ); + +=item last_modified (single) + +=cut + +has last_modified => + (is => 'ro', + isa => 'Str', + builder => + sub { + my $self = shift; + $self->__field_or_def('last_modified', + time); + }, + lazy => 1, + writer => '_set_last_modified', + ); + +=item log_modified (single) + +=cut + +has log_modified => + (is => 'ro', + isa => 'Str', + builder => + sub { + my $self = shift; + $self->__field_or_def('log_modified', + time); + }, + lazy => 1, + writer => '_set_log_modified', + ); + + +=item subject + +=cut + +has subject => + (is => 'ro', + isa => 'Str', + builder => + sub { + my $self = shift; + $self->__field_or_def('subject', + 'No subject'); + }, + lazy => 1, + writer => '_set_subject', + ); + +=item message_id + +=cut + +has message_id => + (is => 'ro', + isa => 'Str', + lazy => 1, + builder => + sub { + my $self = shift; + $self->__field_or_def('message_id', + 'nomessageid.'.$self->date.'_'. + md5_hex($self->subject.$self->submitter). + '@'.$config{email_domain}, + ); + }, + writer => '_set_message_id', + ); + + +=item done + +=item severity + +=cut + +has severity => + (is => 'ro', + isa => 'Str', + lazy => 1, + builder => + sub { + my $self = shift; + $self->__field_or_def('severity', + $config{default_severity}); + }, + writer => '_set_severity', + ); + +=item unarchived + +Unix epoch the bug was last unarchived. Zero if the bug has never been +unarchived. + +=cut + +has unarchived => + (is => 'ro', + isa => 'Int', + lazy => 1, + builder => + sub { + my $self = shift; + $self->__field_or_def('unarchived', + 0); + }, + writer => '_set_unarchived', + ); + +=item archived + +True if the bug is archived, false otherwise. + +=cut + +has archived => + (is => 'ro', + isa => 'Int', + lazy => 1, + builder => + sub { + my $self = shift; + $self->__field_or_def('archived', + 0); + }, + writer => '_set_archived', + ); + +=item owner + +=item summary + +=item outlook + +=item done + +=item forwarded + +=cut + +for my $field (qw(owner unarchived summary outlook done forwarded)) { + has $field => + (is => 'ro', + isa => 'Str', + builder => + sub { + my $self = shift; + $self->__field_or_def($field, + ''); + }, + writer => '_set_'.$field, + lazy => 1, + ); + my $field_method = $meta->find_method_by_name($field); + die "No field method for $field" unless defined $field_method; + $meta->add_method('has_'.$field => + sub {my $self = shift; + return length($field_method->($self)); + }); +} + +=back + +=head3 Multi-value Fields + +=over + +=item affects + +=item package + +=item tags + +=cut + +for my $field (qw(affects package tags)) { + has '_'.$field => + (is => 'ro', + traits => [qw(Array)], + isa => 'ArrayRef[Str]', + builder => + sub { + my $self = shift; + if ($self->_has__status) { + my $s = $self->_status()->{$field}; + if (!ref($s)) { + $s = _build_split_field($s, + $field); + } + return $s; + } + return []; + }, + writer => '_set_'.$field, + handles => {$field => 'elements', + $field.'_count' => 'count', + $field.'_join' => 'join', + }, + lazy => 1, + ); + my $field_method = $meta->find_method_by_name($field); + if (defined $field_method) { + $meta->add_method($field.'_ref'=> + sub {my $self = shift; + return [$field_method->($self)] + }); + } +} + +=item found + +=item fixed + +=cut + +sub __hashref_field { + my ($self,$field) = @_; + + if ($self->_has__status) { + my $s = $self->_status()->{$field}; + if (!ref($s)) { + $s = _build_split_field($s, + $field); + } + return $s; + } + return []; +} + +for my $field (qw(found fixed)) { + has '_'.$field => + (is => 'ro', + traits => ['Hash'], + isa => 'HashRef[Str]', + builder => + sub { + my $self = shift; + if ($self->_has__status) { + my $s = $self->_status()->{$field}; + if (!ref($s)) { + $s = _build_split_field($s, + $field); + } + if (ref($s) ne 'HASH') { + $s = {map {$_,'1'} @{$s}}; + } + return $s; + } + return {}; + }, + default => sub {return {}}, + writer => '_set_'.$field, + handles => {$field => 'keys', + $field.'_count' => 'count', + }, + lazy => 1, + ); + my $field_method = $meta->find_method_by_name($field); + if (defined $field_method) { + $meta->add_method('_'.$field.'_ref'=> + sub {my $self = shift; + return [$field_method->($self)] + }); + $meta->add_method($field.'_join'=> + sub {my ($self,$joiner) = @_; + return join($joiner,$field_method->($self)); + }); + } +} + + +for (qw(found fixed)) { + around '_set_'.$_ => sub { + my $orig = shift; + my $self = shift; + if (defined ref($_[0]) and + ref($_[0]) eq 'ARRAY' + ) { + @_ = {map {$_,'1'} @{$_[0]}}; + } elsif (@_ > 1) { + @_ = {map {$_,'1'} @_}; + } + $self->$orig(@_); + }; +} + + + +=item mergedwith + +=item blocks + +=item blocked_by + +=cut + +for my $field (qw(blocks blocked_by mergedwith)) { + has '_'.$field => + (is => 'ro', + traits => ['Hash'], + isa => 'HashRef[Int]', + builder => + sub { + my $self = shift; + if ($self->_has__status) { + my $s = $self->_status()->{$field}; + if (!ref($s)) { + $s = _build_split_field($s, + $field); + } + if (ref($s) ne 'HASH') { + $s = {map {$_,'1'} @{$s}}; + } + return $s; + } + return {}; + }, + handles => {$field.'_count' => 'count', + }, + writer => '_set_'.$field, + lazy => 1, + ); + my $internal_field_method = $meta->find_method_by_name('_'.$field); + die "No field method for _$field" unless defined $internal_field_method; + $meta->add_method($field => + sub {my $self = shift; + return sort {$a <=> $b} + keys %{$internal_field_method->($self)}; + }); + my $field_method = $meta->find_method_by_name($field); + die "No field method for _$field" unless defined $field_method; + $meta->add_method('_'.$field.'_ref'=> + sub {my $self = shift; + return [$field_method->($self)] + }); + $meta->add_method($field.'_join'=> + sub {my ($self,$joiner) = @_; + return join($joiner,$field_method->($self)); + }); +} + +for (qw(blocks blocked_by mergedwith)) { + around '_set_'.$_ => sub { + my $orig = shift; + my $self = shift; + if (defined ref($_[0]) and + ref($_[0]) eq 'ARRAY' + ) { + $_[0] = {map {$_,'1'} @{$_[0]}}; + } elsif (@_ > 1) { + @_ = {map {$_,'1'} @{$_[0]}}; + } + $self->$orig(@_); + }; +} + +=back + +=cut + +sub _build_split_field { + sub sort_and_unique { + my @v; + my %u; + my $all_numeric = 1; + for my $v (@_) { + if ($all_numeric and $v =~ /\D/) { + $all_numeric = 0; + } + next if exists $u{$v}; + $u{$v} = 1; + push @v, $v; + } + if ($all_numeric) { + return sort {$a <=> $b} @v; + } else { + return sort @v; + } + } + sub split_ditch_empty { + return grep {length $_} map {split ' '} @_; + + } + my ($val,$field) = @_; + $val //= ''; + + if ($field =~ /^(package|affects|source)$/) { + return [grep {length $_} map lc, split /[\s,()?]+/, $val]; + } else { + return [sort_and_unique(split_ditch_empty($val))]; + } +} + + +__PACKAGE__->meta->make_immutable; + +no Mouse; +no Mouse::Util::TypeConstraints; +1; + + +__END__ +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: