From 3e8d51e818f450663b9523a4039f752071fcffe7 Mon Sep 17 00:00:00 2001 From: Don Armstrong Date: Mon, 27 May 2019 16:19:15 -0700 Subject: [PATCH] add Debbugs::Bug::Status, interface to .status files --- Debbugs/Bug/Status.pm | 464 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 464 insertions(+) create mode 100644 Debbugs/Bug/Status.pm diff --git a/Debbugs/Bug/Status.pm b/Debbugs/Bug/Status.pm new file mode 100644 index 0000000..46c82dc --- /dev/null +++ b/Debbugs/Bug/Status.pm @@ -0,0 +1,464 @@ +# 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', + ); + +sub BUILD { + my $self = shift; + my $args = shift; + 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(); + state $field_mapping = + {originator => 'submitter', + blockedby => 'blocked_by', + found_versions => 'found', + fixed_versions => 'fixed', + }; + 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}); + state $field_mapping = + {originator => 'submitter', + keywords => 'tags', + msgid => 'message_id', + blockedby => 'blocked_by', + found_versions => 'found', + fixed_versions => 'fixed', + }; + for my $field (keys %{$field_mapping}) { + $args->{status}{$field_mapping->{$field}} = + $args->{status}{$field}; + } + $self->_set_status_source('filesystem'); + } + } elsif (exists $args->{status}) { + $self->_set_status_source('hashref'); + } + if (exists $args->{status}) { + if (ref($args->{status}) ne 'HASH') { + croak "status must be a HASHREF (argument to __PACKAGE__)"; + } + # single value fields + for my $field (qw(submitter date subject message_id done severity unarchived), + qw(owner summary outlook bug log_modified), + qw(last_modified archived forwarded)) { + next unless defined $args->{status}{$field}; + # we're going to let status override passed values in args for now; + # maybe this should change + my $field_method = $meta->find_method_by_name('_set_'.$field); + if (not defined $field_method) { + croak "Unable to find field method for _set_$field"; + } + $field_method->($self,$args->{status}{$field}); + } + # multi value fields + for my $field (qw(affects package tags blocks blocked_by mergedwith), + qw(found fixed)) { + next unless defined $args->{status}{$field}; + my $field_method = $meta->find_method_by_name('_set_'.$field); + my $split_field = $args->{status}{$field}; + if (!ref($split_field)) { + $split_field = + _build_split_field($args->{status}{$field}, + $field); + } + $field_method->($self, + $split_field, + ); + } + delete $args->{status}; + } +} + +has saved => (is => 'ro', isa => 'Bool', + default => 0, + writer => '_set_set_saved', + ); + +=head2 Status Fields + +=cut + +=head3 Single-value Fields + +=over + +=item submitter (single) + +=cut + +has submitter => + (is => 'ro', + isa => 'Str', + default => $config{maintainer_email}, + writer => '_set_submitter', + ); + +=item date (single) + +=cut + +has date => + (is => 'ro', + isa => 'Str', + builder => sub {return time}, + lazy => 1, + writer => '_set_date', + ); + +=item last_modified (single) + +=cut + +has last_modified => + (is => 'ro', + isa => 'Str', + builder => sub {return time}, + lazy => 1, + writer => '_set_last_modified', + ); + +=item log_modified (single) + +=cut + +has log_modified => + (is => 'ro', + isa => 'Str', + builder => sub {return time}, + lazy => 1, + writer => '_set_log_modified', + ); + + +=item subject + +=cut + +has subject => + (is => 'ro', + isa => 'Str', + default => 'No subject', + writer => '_set_subject', + ); + +=item message_id + +=cut + +has message_id => + (is => 'ro', + isa => 'Str', + lazy => 1, + builder => + sub { + my $self = shift; + return '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', + default => $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', + default => 0, + writer => '_set_unarchived', + ); + +=item archived + +True if the bug is archived, false otherwise. + +=cut + +has archived => + (is => 'ro', + isa => 'Int', + default => 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', + default => '', + writer => '_set_'.$field, + ); + 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]', + default => sub {return []}, + writer => '_set_'.$field, + handles => {$field => 'elements', + }, + 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 + +for my $field (qw(found fixed)) { + has '_'.$field => + (is => 'ro', + traits => ['Hash'], + isa => 'HashRef[Str]', + default => sub {return {}}, + writer => '_set_'.$field, + handles => {$field => 'keys', + }, + 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)] + }); + } +} + + +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]', + default => sub {return {}}, + 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)] + }); +} + +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: -- 2.39.2