--- /dev/null
+# 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 <don@donarmstrong.com>.
+
+package Debbugs::Bug;
+
+=head1 NAME
+
+Debbugs::Bug -- OO interface to bugs
+
+=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 DateTime;
+use List::AllUtils qw(max first min any);
+
+use Params::Validate qw(validate_with :types);
+use Debbugs::Config qw(:config);
+use Debbugs::Status qw(read_bug);
+use Debbugs::Bug::Tag;
+use Debbugs::Bug::Status;
+use Debbugs::Collection::Package;
+use Debbugs::Collection::Bug;
+use Debbugs::Collection::Correspondent;
+
+use Debbugs::OOTypes;
+
+use Carp;
+
+extends 'Debbugs::OOBase';
+
+my $meta = __PACKAGE__->meta;
+
+state $strong_severities =
+ {map {($_,1)} @{$config{strong_severities}}};
+
+has bug => (is => 'ro', isa => 'Int',
+ required => 1,
+ );
+
+sub id {
+ return $_[0]->bug;
+}
+
+has saved => (is => 'ro', isa => 'Bool',
+ default => 0,
+ writer => '_set_saved',
+ );
+
+has status => (is => 'ro', isa => 'Debbugs::Bug::Status',
+ lazy => 1,
+ builder => '_build_status',
+ handles => {date => 'date',
+ subject => 'subject',
+ message_id => 'message_id',
+ severity => 'severity',
+ archived => 'archived',
+ summary => 'summary',
+ outlook => 'outlook',
+ forwarded => 'forwarded',
+ },
+ );
+
+sub _build_status {
+ my $self = shift;
+ return Debbugs::Bug::Status->new(bug=>$self->bug,
+ $self->schema_argument,
+ );
+}
+
+has log => (is => 'bare', isa => 'Debbugs::Log',
+ lazy => 1,
+ builder => '_build_log',
+ handles => {_read_record => 'read_record',
+ log_records => 'read_all_records',
+ },
+ );
+
+sub _build_log {
+ my $self = shift;
+ return Debbugs::Log->new(bug_num => $self->id,
+ inner_file => 1,
+ );
+}
+
+has spam => (is => 'bare', isa => 'Debbugs::Log::Spam',
+ lazy => 1,
+ builder => '_build_spam',
+ handles => ['is_spam'],
+ );
+sub _build_spam {
+ my $self = shift;
+ return Debbugs::Log::Spam->new(bug_num => $self->id);
+}
+
+has 'package_collection' => (is => 'ro',
+ isa => 'Debbugs::Collection::Package',
+ builder => '_build_package_collection',
+ lazy => 1,
+ );
+
+sub _build_package_collection {
+ my $self = shift;
+ if ($self->has_schema) {
+ return Debbugs::Collection::Package->new(schema => $self->schema);
+ }
+ carp "No schema when building package collection";
+ return Debbugs::Collection::Package->new();
+}
+
+has bug_collection => (is => 'ro',
+ isa => 'Debbugs::Collection::Bug',
+ builder => '_build_bug_collection',
+ );
+sub _build_bug_collection {
+ my $self = shift;
+ if ($self->has_schema) {
+ return Debbugs::Collection::Bug->new(schema => $self->schema);
+ }
+ return Debbugs::Collection::Bug->new();
+}
+
+has correspondent_collection =>
+ (is => 'ro',
+ isa => 'Debbugs::Collection::Correspondent',
+ builder => '_build_correspondent_collection',
+ lazy => 1,
+ );
+sub _build_correspondent_collection {
+ my $self = shift;
+ return Debbugs::Collection::Correspondent->new($self->schema_argument);
+}
+
+# package attributes
+for my $attr (qw(packages affects sources)) {
+ has $attr =>
+ (is => 'rw',
+ isa => 'Debbugs::Collection::Package',
+ clearer => '_clear_'.$attr,
+ builder => '_build_'.$attr,
+ lazy => 1,
+ );
+}
+
+# bugs
+for my $attr (qw(blocks blocked_by mergedwith)) {
+ has $attr =>
+ (is => 'ro',
+ isa => 'Debbugs::Collection::Bug',
+ clearer => '_clear_'.$attr,
+ builder => '_build_'.$attr,
+ handles => {},
+ lazy => 1,
+ );
+}
+
+
+for my $attr (qw(owner submitter done)) {
+ has $attr,
+ (is => 'ro',
+ isa => 'Maybe[Debbugs::Correspondent]',
+ lazy => 1,
+ builder => '_build_'.$attr.'_corr',
+ clearer => '_clear_'.$attr.'_corr',
+ handles => {$attr.'_url' => $attr.'_url',
+ $attr.'_email' => 'email',
+ $attr.'_phrase' => 'phrase',
+ },
+ );
+ $meta->add_method('has_'.$attr,
+ sub {my $self = shift;
+ my $m = $meta->find_method_by_name($attr);
+ return defined $m->($self);
+ });
+ $meta->add_method('_build_'.$attr.'_corr',
+ sub {my $self = shift;
+ my $m = $self->status->meta->find_method_by_name($attr);
+ my $v = $m->($self->status);
+ if (defined $v and length($v)) {
+ return $self->correspondent_collection->
+ get_or_add_by_key($v);
+ } else {
+ return undef;
+ }
+ }
+ );
+}
+
+sub is_done {
+ my $self = shift;
+ return $self->has_done;
+}
+
+sub strong_severity {
+ my $self = shift;
+ return exists $strong_severities->{$self->severity};
+}
+
+sub short_severity {
+ $_[0]->severity =~ m/^(.)/;
+ return $1;
+}
+
+sub _build_packages {
+ my $self = shift;
+ return $self->package_collection->
+ limit($self->status->package);
+}
+
+sub is_affecting {
+ my $self = shift;
+ return $self->affects->count > 0;
+}
+
+sub _build_affects {
+ my $self = shift;
+ return $self->package_collection->
+ limit($self->status->affects);
+}
+sub _build_sources {
+ my $self = shift;
+ return $self->packages->sources->clone;
+}
+
+sub is_owned {
+ my $self = shift;
+ return defined $self->owner;
+}
+
+sub is_blocking {
+ my $self = shift;
+ return $self->blocks->count > 0;
+}
+
+sub _build_blocks {
+ my $self = shift;
+ return $self->bug_collection->
+ limit($self->status->blocks);
+}
+
+sub is_blocked {
+ my $self = shift;
+ return $self->blocked_by->count > 0;
+}
+
+sub _build_blocked_by {
+ my $self = shift;
+ return $self->bug_collection->
+ limit($self->status->blocked_by);
+}
+
+sub is_forwarded {
+ length($_[0]->forwarded) > 0;
+}
+
+for my $attr (qw(fixed found)) {
+ has $attr =>
+ (is => 'ro',
+ isa => 'Debbugs::Collection::Version',
+ clearer => '_clear_'.$attr,
+ builder => '_build_'.$attr,
+ handles => {},
+ lazy => 1,
+ );
+}
+
+sub has_found {
+ my $self = shift;
+ return any {1} $self->status->found;
+}
+
+sub _build_found {
+ my $self = shift;
+ return $self->packages->
+ get_source_versions($self->status->found);
+}
+
+sub has_fixed {
+ my $self = shift;
+ return any {1} $self->status->fixed;
+}
+
+sub _build_fixed {
+ my $self = shift;
+ return $self->packages->
+ get_source_versions($self->status->fixed);
+}
+
+sub is_merged {
+ my $self = shift;
+ return any {1} $self->status->mergedwith;
+}
+
+sub _build_mergedwith {
+ my $self = shift;
+ return $self->bug_collection->
+ limit($self->status->mergedwith);
+}
+
+for my $attr (qw(created modified)) {
+ has $attr => (is => 'rw', isa => 'Object',
+ clearer => '_clear_'.$attr,
+ builder => '_build_'.$attr,
+ lazy => 1);
+}
+sub _build_created {
+ return DateTime->
+ from_epoch(epoch => $_[0]->status->date);
+}
+sub _build_modified {
+ return DateTime->
+ from_epoch(epoch => max($_[0]->status->log_modified,
+ $_[0]->status->last_modified
+ ));
+}
+
+has tags => (is => 'ro',
+ isa => 'Debbugs::Bug::Tag',
+ clearer => '_clear_tags',
+ builder => '_build_tags',
+ lazy => 1,
+ );
+sub _build_tags {
+ my $self = shift;
+ return Debbugs::Bug::Tag->new(keywords => join(' ',$self->status->tags),
+ bug => $self,
+ users => $self->bug_collection->users,
+ );
+}
+
+has pending => (is => 'ro',
+ isa => 'Str',
+ clearer => '_clear_pending',
+ builder => '_build_pending',
+ lazy => 1,
+ );
+
+sub _build_pending {
+ my $self = shift;
+
+ my $pending = 'pending';
+ if (length($self->status->forwarded)) {
+ $pending = 'forwarded';
+ }
+ if ($self->tags->tag_is_set('pending')) {
+ $pending = 'pending-fixed';
+ }
+ if ($self->tags->tag_is_set('pending')) {
+ $pending = 'fixed';
+ }
+ # XXX This isn't quite right
+ return $pending;
+}
+
+=head2 buggy
+
+ $bug->buggy('debbugs/2.6.0-1','debbugs/2.6.0-2');
+ $bug->buggy(Debbugs::Version->new('debbugs/2.6.0-1'),
+ Debbugs::Version->new('debbugs/2.6.0-2'),
+ );
+
+Returns the output of Debbugs::Versions::buggy for a particular
+package, version and found/fixed set. Automatically turns found, fixed
+and version into source/version strings.
+
+=cut
+
+sub buggy {
+ my $self = shift;
+ my $vertree =
+ $self->package_collection->
+ universe->versiontree;
+ my $max_buggy = 'absent';
+ for my $ver (@_) {
+ if (not ref($ver)) {
+ my @ver_opts = (version => $ver,
+ package => $self->status->package,
+ package_collection => $self->package_collection,
+ $self->schema_arg
+ );
+ if ($ver =~ m{/}) {
+ $ver = Debbugs::Version::Source->(@ver_opts);
+ } else {
+ $ver = Debbugs::Version::Binary->(@ver_opts);
+ }
+ }
+ $vertree->load($ver->source);
+ my $buggy =
+ $vertree->buggy($ver,
+ [$self->found],
+ [$self->fixed]);
+ if ($buggy eq 'found') {
+ return 'found'
+ }
+ if ($buggy eq 'fixed') {
+ $max_buggy = 'fixed';
+ }
+ }
+ return $max_buggy;
+}
+
+has archiveable =>
+ (is => 'ro', isa => 'Bool',
+ writer => '_set_archiveable',
+ builder => '_build_archiveable',
+ clearer => '_clear_archiveable',
+ lazy => 1,
+ );
+has when_archiveable =>
+ (is => 'ro', isa => 'Num',
+ writer => '_set_when_archiveable',
+ builder => '_build_when_archiveable',
+ clearer => '_clear_when_archiveable',
+ lazy => 1,
+ );
+
+sub _build_archiveable {
+ my $self = shift;
+ $self->_populate_archiveable(0);
+ return $self->archiveable;
+}
+sub _build_when_archiveable {
+ my $self = shift;
+ $self->_populate_archiveable(1);
+ return $self->when_archiveable;
+}
+
+sub _populate_archiveable {
+ my $self = shift;
+ my ($need_time) = @_;
+ $need_time //= 0;
+ # Bugs can be archived if they are
+ # 1. Closed
+ if (not $self->done) {
+ $self->_set_archiveable(0);
+ $self->_set_when_archiveable(-1);
+ return;
+ }
+ # 2. Have no unremovable tags set
+ if (@{$config{removal_unremovable_tags}}) {
+ state $unrem_tags =
+ {map {($_=>1)} @{$config{removal_unremovable_tags}}};
+ for my $tag ($self->tags) {
+ if ($unrem_tags->{$tag}) {
+ $self->_set_archiveable(0);
+ $self->_set_when_archiveable(-1);
+ return;
+ }
+ }
+ }
+ my $time = time;
+ state $remove_time = 24 * 60 * 60 * ($config{removal_age} // 30);
+ # 4. Have been modified more than removal_age ago
+ my $moded_ago =
+ $time - $self->modified->epoch;
+ # if we don't need to know when we can archive, we can stop here if it's
+ # been modified too recently
+ if ($moded_ago < $remove_time) {
+ $self->_set_archiveable(0);
+ return unless $need_time;
+ }
+ my @distributions =
+ @{$config{removal_default_distribution_tags}};
+ if ($self->strong_severity) {
+ @distributions =
+ @{$config{removal_strong_severity_default_distribution_tags}};
+ }
+ # 3. Have a maximum buggy of fixed
+ my $buggy = $self->buggy($self->packages->
+ get_source_versions_distributions(@distributions));
+ if ('found' eq $buggy) {
+ $self->_set_archiveable(0);
+ $self->_set_when_archiveable(-1);
+ return;
+ }
+ my $fixed_ago = $moded_ago;
+ # $fixed_ago = $time - $self->when_fixed(@distributions);
+ # if ($fixed_ago < $remove_time) {
+ # $self->_set_archiveable(0);
+ # }
+ $self->_set_when_archiveable(($remove_time - min($fixed_ago,$moded_ago)) / (24 * 60 * 60));
+ if ($fixed_ago > $remove_time and
+ $moded_ago > $remove_time) {
+ $self->_set_archiveable(1);
+ $self->_set_when_archiveable(0);
+ }
+ return;
+}
+
+sub filter {
+ my $self = shift;
+ my %param = validate_with(params => \@_,
+ spec => {seen_merged => {type => HASHREF,
+ default => sub {return {}},
+ },
+ repeat_merged => {type => BOOLEAN,
+ default => 1,
+ },
+ include => {type => HASHREF,
+ optional => 1,
+ },
+ exclude => {type => HASHREF,
+ optional => 1,
+ },
+ min_days => {type => SCALAR,
+ optional => 1,
+ },
+ max_days => {type => SCALAR,
+ optional => 1,
+ },
+ },
+ );
+ if (exists $param{include}) {
+ return 1 if not $self->matches($param{include});
+ }
+ if (exists $param{exclude}) {
+ return 1 if $self->matches($param{exclude});
+ }
+ if (exists $param{repeat_merged} and not $param{repeat_merged}) {
+ my @merged = sort {$a<=>$b} $self->bug, $self->status->mergedwith;
+ return 1 if first {sub {defined $_}}
+ @{$param{seen_merged}}{@merged};
+ @{$param{seen_merged}}{@merged} = (1) x @merged;
+ }
+ if (exists $param{min_days}) {
+ return 1 unless $param{min_days} <=
+ (DateTime->now() - $self->created)->days();
+ }
+ if (exists $param{max_days}) {
+ return 1 unless $param{max_days} >=
+ (DateTime->now() - $self->created)->days();
+ }
+ return 0;
+
+}
+
+sub __exact_match {
+ my ($field, $values) = @_;
+ my @ret = first {sub {$_ eq $field}} @{$values};
+ return @ret != 0;
+}
+
+sub __contains_match {
+ my ($field, $values) = @_;
+ foreach my $value (@{$values}) {
+ return 1 if (index($field, $value) > -1);
+ }
+ return 0;
+}
+
+state $field_match =
+ {subject => sub {__contains_match($_[0]->subject,@_)},
+ tags => sub {
+ for my $value (@{$_[1]}) {
+ if ($_[0]->tags->is_set($value)) {
+ return 1;
+ }
+ }
+ return 0;
+ },
+ severity => sub {__exact_match($_[0]->severity,@_)},
+ pending => sub {__exact_match($_[0]->pending,@_)},
+ originator => sub {__exact_match($_[0]->submitter,@_)},
+ submitter => sub {__exact_match($_[0]->submitter,@_)},
+ forwarded => sub {__exact_match($_[0]->forwarded,@_)},
+ owner => sub {__exact_match($_[0]->owner,@_)},
+ };
+
+sub matches {
+ my ($self,$hash) = @_;
+ for my $key (keys %{$hash}) {
+ my $sub = $field_match->{$key};
+ if (not defined $sub) {
+ carp "No subroutine for key: $key";
+ next;
+ }
+ return 1 if $sub->($self,$hash->{$key});
+ }
+ return 0;
+}
+
+sub email {
+ my $self = shift;
+ return $self->id.'@'.$config{email_domain};
+}
+
+sub subscribe_email {
+ my $self = shift;
+ return $self->id.'-subscribe@'.$config{email_domain};
+}
+
+sub url {
+ my $self = shift;
+ return $config{web_domain}.'/'.$self->id;
+}
+
+sub mbox_url {
+ my $self = shift;
+ return $config{web_domain}.'/mbox:'.$self->id;
+}
+
+sub mbox_status_url {
+ my $self = shift;
+ return $self->mbox_url.'?mboxstatus=yes';
+}
+
+sub mbox_maint_url {
+ my $self = shift;
+ $self->mbox_url.'?mboxmaint=yes';
+}
+
+sub version_url {
+ my $self = shift;
+ my $url = Debbugs::URI->new('version.cgi?');
+ $url->query_form(package => $self->status->package(),
+ found => [$self->status->found],
+ fixed => [$self->status->fixed],
+ @_,
+ );
+ return $url->as_string;
+}
+
+sub related_packages_and_versions {
+ my $self = shift;
+ my @packages = $self->status->package;
+ my @versions = ($self->status->found,
+ $self->status->fixed);
+ my @unqualified_versions;
+ my @return;
+ for my $ver (@versions) {
+ if ($ver =~ m{(<src>.+)/(<ver>.+)}) { # It's a src_pkg_ver
+ push @return, ['src:'.$+{src}, $+{ver}];
+ } else {
+ push @unqualified_versions,$ver;
+ }
+ }
+ for my $pkg (@packages) {
+ if (@unqualified_versions) {
+ push @return,
+ [$pkg,@unqualified_versions];
+ } else {
+ push @return,$pkg;
+ }
+ }
+ return @return;
+}
+
+sub CARP_TRACE {
+ my $self = shift;
+ return 'Debbugs::Bug={bug='.$self->bug.'}';
+}
+
+__PACKAGE__->meta->make_immutable;
+
+no Mouse;
+1;
+
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
projects / debbugs.git / blobdiff