--- /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:
--- /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::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:
--- /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::Tag;
+
+=head1 NAME
+
+Debbugs::Bug::Tag -- OO interface to bug tags
+
+=head1 SYNOPSIS
+
+ use Debbugs::Bug::Tag;
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use Mouse;
+use strictures 2;
+use namespace::clean;
+use v5.10; # for state
+
+use Debbugs::User;
+use List::AllUtils qw(uniq);
+use Debbugs::Config qw(:config);
+use Carp qw(croak);
+
+state $valid_tags =
+ {map {($_,1)} @{$config{tags}}};
+
+state $short_tags =
+ {%{$config{tags_single_letter}}};
+
+extends 'Debbugs::OOBase';
+
+around BUILDARGS => sub {
+ my $orig = shift;
+ my $class = shift;
+ if (@_ == 1 && !ref $_[0]) {
+ return $class->$orig(keywords => $_[0]);
+ } else {
+ return $class->$orig(@_);
+ }
+};
+
+sub BUILD {
+ my $self = shift;
+ my $args = shift;
+ if (exists $args->{keywords}) {
+ my @tags;
+ if (ref($args->{keywords})) {
+ @tags = @{$args->{keywords}}
+ } else {
+ @tags = split /[, ]/,$args->{keywords};
+ }
+ return unless @tags;
+ $self->_set_tag(map {($_,1)} @tags);
+ delete $args->{keywords};
+ }
+}
+
+has tags => (is => 'ro',
+ isa => 'HashRef[Str]',
+ traits => ['Hash'],
+ lazy => 1,
+ reader => '_tags',
+ builder => '_build_tags',
+ handles => {has_tags => 'count',
+ _set_tag => 'set',
+ unset_tag => 'delete',
+ },
+ );
+has usertags => (is => 'ro',
+ isa => 'HashRef[Str]',
+ lazy => 1,
+ traits => ['Hash'],
+ handles => {unset_usertag => 'delete',
+ has_usertags => 'count',
+ },
+ reader => '_usertags',
+ builder => '_build_usertags',
+ );
+
+sub has_any_tags {
+ my $self = shift;
+ return ($self->has_tags || $self->has_usertags);
+}
+
+has bug => (is => 'ro',
+ isa => 'Debbugs::Bug',
+ required => 1,
+ );
+
+has users => (is => 'ro',
+ isa => 'ArrayRef[Debbugs::User]',
+ default => sub {[]},
+ );
+
+sub _build_tags {
+ return {};
+}
+
+sub _build_usertags {
+ my $self = shift;
+ local $_;
+ my $t = {};
+ my $id = $self->bug->id;
+ for my $user (@{$self->users}) {
+ for my $tag ($user->tags_on_bug($id)) {
+ $t->{$tag} = $user->email;
+ }
+ }
+ return $t;
+}
+
+sub is_set {
+ return ($_[0]->tag_is_set($_[1]) or
+ $_[0]->usertag_is_set($_[1]));
+}
+
+sub tag_is_set {
+ return exists $_[0]->_tags->{$_[1]} ? 1 : 0;
+}
+
+sub usertag_is_set {
+ return exists $_[0]->_usertags->{$_[1]} ? 1 : 0;
+}
+
+sub set_tag {
+ my $self = shift;
+ for my $tag (@_) {
+ if (not $self->valid_tag($tag)) {
+ confess("Invalid tag $tag");
+ }
+ $self->_tags->{$tag} = 1;
+ }
+ return $self;
+}
+
+sub valid_tag {
+ return exists $valid_tags->{$_[1]}?1:0;
+}
+
+sub as_string {
+ my $self = shift;
+ return $self->join_all(' ');
+}
+
+sub join_all {
+ my $self = shift;
+ my $joiner = shift;
+ $joiner //= ', ';
+ return join($joiner,$self->all_tags);
+}
+
+sub join_usertags {
+ my $self = shift;
+ my $joiner = shift;
+ $joiner //= ', ';
+ return join($joiner,$self->usertags);
+}
+
+sub join_tags {
+ my $self = shift;
+ my $joiner = shift;
+ $joiner //= ', ';
+ return join($joiner,$self->tags);
+}
+
+sub all_tags {
+ return uniq sort $_[0]->tags,$_[0]->usertags;
+}
+
+sub tags {
+ return sort keys %{$_[0]->_tags}
+}
+
+sub short_tags {
+ my $self = shift;
+ my @r;
+ for my $tag ($self->tags) {
+ next unless exists $short_tags->{$tag};
+ push @r,
+ {long => $tag,
+ short => $short_tags->{$tag},
+ };
+ }
+ if (wantarray) {
+ return @r;
+ } else {
+ return [@r];
+ }
+}
+
+sub usertags {
+ return sort keys %{$_[0]->_usertags}
+}
+
+no Mouse;
+1;
+
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
# identify all of the srcpackages and binpackages that match first
my $src_pkgs_rs =
$s->resultset('SrcPkg')->
- search({-or => [map {('me.pkg' => $_,
- )}
- make_list($param{src})],
+ search({'pkg' => [make_list($param{src})],
},
{ columns => ['id'],
group_by => ['me.id'],
},
);
my $bin_pkgs_rs =
- $s->resultset('BinPkg')->
- search({-or => [map {('src_pkg.pkg' => $_,
- )}
- make_list($param{src})],
- },
- {join => {bin_vers => {src_ver => 'src_pkg'}},
- columns => ['id'],
- group_by => ['me.id'],
+ $s->resultset('BinPkgSrcPkg')->
+ search({'src_pkg.pkg' => [make_list($param{src})],
+ },
+ {columns => ['bin_pkg'],
+ join => ['src_pkg'],
+ group_by => ['bin_pkg'],
});
$rs = $rs->search({-or => {'bug_binpackages.bin_pkg' =>
- { -in => $bin_pkgs_rs->get_column('id')->as_query},
+ { -in => $bin_pkgs_rs->get_column('bin_pkg')->as_query},
'bug_srcpackages.src_pkg' =>
{ -in => $src_pkgs_rs->get_column('id')->as_query},
'me.unknown_packages' =>
use Mail::Address;
use POSIX qw(ceil);
use Storable qw(dclone);
+use Scalar::Util qw(looks_like_number);
use List::AllUtils qw(max);
use File::stat;
=cut
sub bug_links {
+ state $spec = {bug => {type => SCALAR|ARRAYREF,
+ optional => 1,
+ },
+ links_only => {type => BOOLEAN,
+ default => 0,
+ },
+ class => {type => SCALAR,
+ default => '',
+ },
+ separator => {type => SCALAR,
+ default => ', ',
+ },
+ options => {type => HASHREF,
+ default => {},
+ },
+ };
my %param = validate_with(params => \@_,
- spec => {bug => {type => SCALAR|ARRAYREF,
- optional => 1,
- },
- links_only => {type => BOOLEAN,
- default => 0,
- },
- class => {type => SCALAR,
- default => '',
- },
- separator => {type => SCALAR,
- default => ', ',
- },
- options => {type => HASHREF,
- default => {},
- },
- },
+ spec => $spec,
);
my %options = %{$param{options}};
$_);
} make_list($param{bug}) if exists $param{bug};
} else {
- push @links, map {('bugreport.cgi?bug='.uri_escape_utf8($_),
- $_)}
+ push @links,
+ map {my $b = ceil($_);
+ ('bugreport.cgi?bug='.$b,
+ $b)}
+ grep {looks_like_number($_)}
make_list($param{bug}) if exists $param{bug};
}
my @return;
use IO::Scalar;
use Params::Validate qw(validate_with :types);
+use Debbugs::Collection::Bug;
+
+use Carp;
+use List::AllUtils qw(apply);
+
use Debbugs::Config qw(:config :globals);
use Debbugs::CGI qw(:url :html :util);
use Debbugs::Common qw(:misc :util :date);
# distribution.
@{$config{distributions}//[]} ?
(dist => [@{$config{distributions}}]) : (),
- );
+ ) if defined $srcforpkg;
@pkgs = grep( !/^\Q$package\E$/, @pkgs );
if ( @pkgs ) {
@pkgs = sort @pkgs;
sub short_bug_status_html {
my %param = validate_with(params => \@_,
- spec => {status => {type => HASHREF,
- },
- options => {type => HASHREF,
- default => {},
- },
- bug_options => {type => HASHREF,
- default => {},
- },
- snippet => {type => SCALAR,
- default => '',
- },
+ spec => {bug => {type => OBJECT,
+ isa => 'Debbugs::Bug',
+ },
},
);
- my %status = %{$param{status}};
-
- $status{tags_array} = [sort(split(/\s+/, $status{tags}))];
- $status{date_text} = strftime('%a, %e %b %Y %T UTC', gmtime($status{date}));
- $status{mergedwith_array} = [split(/ /,$status{mergedwith})];
-
- my @blockedby= split(/ /, $status{blockedby});
- $status{blockedby_array} = [];
- if (@blockedby && $status{"pending"} ne 'fixed' && ! length($status{done})) {
- for my $b (@blockedby) {
- my %s = %{get_bug_status($b)};
- next if (defined $s{pending} and $s{pending} eq 'fixed') or (defined $s{done} and length $s{done});
- push @{$status{blockedby_array}},{bug_num => $b, subject => $s{subject}, status => \%s};
- }
- }
-
- my @blocks= split(/ /, $status{blocks});
- $status{blocks_array} = [];
- if (@blocks && $status{"pending"} ne 'fixed' && ! length($status{done})) {
- for my $b (@blocks) {
- my %s = %{get_bug_status($b)};
- next if (defined $s{pending} and $s{pending} eq 'fixed') or (defined $s{done} and length $s{done});
- push @{$status{blocks_array}}, {bug_num => $b, subject => $s{subject}, status => \%s};
- }
- }
- my $days = bug_archiveable(bug => $status{id},
- status => \%status,
- days_until => 1,
- );
- $status{archive_days} = $days;
return fill_in_template(template => 'cgi/short_bug_status',
- variables => {status => \%status,
+ variables => {bug => $param{bug},
isstrongseverity => \&Debbugs::Status::isstrongseverity,
html_escape => \&Debbugs::CGI::html_escape,
looks_like_number => \&Scalar::Util::looks_like_number,
sub pkg_htmlizebugs {
my %param = validate_with(params => \@_,
- spec => {bugs => {type => ARRAYREF,
+ spec => {bugs => {type => OBJECT,
},
names => {type => ARRAYREF,
},
},
}
);
- my @bugs = @{$param{bugs}};
-
- my @status = ();
+ my $bugs = $param{bugs};
my %count;
my $header = '';
my $footer = "<h2 class=\"outstanding\">Summary</h2>\n";
- if (@bugs == 0) {
+ if ($bugs->count == 0) {
return "<HR><H2>No reports found!</H2></HR>\n";
}
- if ( $param{bug_rev} ) {
- @bugs = sort {$b<=>$a} @bugs;
- }
- else {
- @bugs = sort {$a<=>$b} @bugs;
- }
my %seenmerged;
my %common = (
push @{$exclude{$key}}, split /\s*,\s*/, $value;
}
- my $binary_to_source_cache = {};
- my $statuses =
- get_bug_statuses(bug => \@bugs,
- hash_slice(%param,
- qw(dist version schema bugusertags),
- ),
- (exists $param{arch}?(arch => $param{arch}):(arch => $config{default_architectures})),
- binary_to_source_cache => $binary_to_source_cache,
+ my $sorter = sub {$_[0]->id <=> $_[1]->id};
+ if ($param{bug_rev}) {
+ $sorter = sub {$_[1]->id <=> $_[0]->id}
+ }
+ elsif ($param{bug_order} eq 'age') {
+ $sorter = sub {$_[0]->modified->epoch <=> $_[1]->modified->epoch};
+ }
+ elsif ($param{bug_order} eq 'agerev') {
+ $sorter = sub {$_[1]->modified->epoch <=> $_[0]->modified->epoch};
+ }
+ my @status;
+ for my $bug ($bugs->sort($sorter)) {
+ next if
+ $bug->filter(repeat_merged => $param{repeatmerged},
+ seen_merged => \%seenmerged,
+ (keys %include ? (include => \%include):()),
+ (keys %exclude ? (exclude => \%exclude):()),
);
- for my $bug (sort {$a <=> $b} keys %{$statuses}) {
- next unless %{$statuses->{$bug}};
- next if bug_filter(bug => $bug,
- status => $statuses->{$bug},
- repeat_merged => $param{repeatmerged},
- seen_merged => \%seenmerged,
- (keys %include ? (include => \%include):()),
- (keys %exclude ? (exclude => \%exclude):()),
- );
my $html = "<li>"; #<a href=\"%s\">#%d: %s</a>\n<br>",
- $html .= short_bug_status_html(status => $statuses->{$bug},
- options => $param{options},
+ $html .= short_bug_status_html(bug => $bug,
) . "\n";
- push @status, [ $bug, $statuses->{$bug}, $html ];
- }
- if ($param{bug_order} eq 'age') {
- # MWHAHAHAHA
- @status = sort {$a->[1]{log_modified} <=> $b->[1]{log_modified}} @status;
- }
- elsif ($param{bug_order} eq 'agerev') {
- @status = sort {$b->[1]{log_modified} <=> $a->[1]{log_modified}} @status;
+ push @status, [ $bug, $html ];
}
+ # parse bug order indexes into subroutines
+ my @order_subs =
+ map {
+ my $a = $_;
+ [map {parse_order_statement_to_subroutine($_)} @{$a}];
+ } @{$param{prior}};
for my $entry (@status) {
my $key = "";
- for my $i (0..$#{$param{prior}}) {
- my $v = get_bug_order_index($param{prior}[$i], $entry->[1]);
+ for my $i (0..$#order_subs) {
+ my $v = get_bug_order_index($order_subs[$i], $entry->[0]);
$count{"g_${i}_${v}"}++;
$key .= "_$v";
}
- $section{$key} .= $entry->[2];
+ $section{$key} .= $entry->[1];
$count{"_$key"}++;
}
my $result = "";
if ($param{ordering} eq "raw") {
- $result .= "<UL class=\"bugs\">\n" . join("", map( { $_->[ 2 ] } @status ) ) . "</UL>\n";
+ $result .= "<UL class=\"bugs\">\n" . join("", map( { $_->[ 1 ] } @status ) ) . "</UL>\n";
}
else {
$header .= "<div class=\"msgreceived\">\n<ul>\n";
return $result;
}
+sub parse_order_statement_to_subroutine {
+ my ($statement) = @_;
+ if (not defined $statement or not length $statement) {
+ return sub {return 1};
+ }
+ croak "invalid statement '$statement'" unless
+ $statement =~ /^(?:(package|tag|pending|severity) # field
+ = # equals
+ ([^=|\&,\+]+(?:,[^=|\&,+])*) #value
+ (\+|,|$) # joiner or end
+ )+ # one or more of these statements
+ /x;
+ my @sub_bits;
+ while ($statement =~ /(?<joiner>^|,|\+) # joiner
+ (?<field>package|tag|pending|severity) # field
+ = # equals
+ (?<value>[^=|\&,\+]+(?:,[^=|\&,\+])*) #value
+ /xg) {
+ my $field = $+{field};
+ my $value = $+{value};
+ my $joiner = $+{joiner} // '';
+ my @vals = apply {quotemeta($_)} split /,/,$value;
+ if (length $joiner) {
+ if ($joiner eq '+') {
+ push @sub_bits, ' and ';
+ }
+ else {
+ push @sub_bits, ' or ';
+ }
+ }
+ my @vals_bits;
+ for my $val (@vals) {
+ if ($field =~ /package|severity/o) {
+ push @vals_bits, '$_[0]->status->'.$field.
+ ' eq q('.$val.')';
+ } elsif ($field eq 'tag') {
+ push @vals_bits, '$_[0]->tags->is_set('.
+ 'q('.$val.'))';
+ } elsif ($field eq 'pending') {
+ push @vals_bits, '$_[0]->'.$field.
+ ' eq q('.$val.')';
+ }
+ }
+ push @sub_bits ,' ('.join(' or ',@vals_bits).') ';
+ }
+ # return a subroutine reference which determines whether an order statement
+ # matches this bug
+ my $sub = 'sub { return ('.join ("\n",@sub_bits).');};';
+ my $subref = eval $sub;
+ if ($@) {
+ croak "Unable to generate subroutine: $@; $sub";
+ }
+ return $subref;
+}
+
sub parse_order_statement_into_boolean {
my ($statement,$status,$tags) = @_;
}
sub get_bug_order_index {
- my $order = shift;
- my $status = shift;
- my $pos = 0;
- my $tags = {map { $_, 1 } split / /, $status->{"tags"}
- }
- if defined $status->{"tags"};
- for my $el (@${order}) {
- if (not length $el or
- parse_order_statement_into_boolean($el,$status,$tags)
- ) {
- return $pos;
- }
- $pos++;
+ my ($order,$bug) = @_;
+ my $pos = 0;
+ for my $el (@{$order}) {
+ if ($el->($bug)) {
+ return $pos;
+ }
+ $pos++;
}
return $pos;
}
--- /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::Collection;
+
+=head1 NAME
+
+Debbugs::Collection -- Collection base class which can generate lots of objects
+
+=head1 SYNOPSIS
+
+This base class is designed for holding collections of objects which can be
+uniquely identified by a key and added/generated by that same key.
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use Mouse;
+use strictures 2;
+use namespace::autoclean;
+use List::AllUtils qw(pairmap);
+use Carp qw(croak);
+
+extends 'Debbugs::OOBase';
+
+=head1 METHODS
+
+=head2 Debbugs::Collection->new(%params|$params)
+
+Creates a new Debbugs::Collection object.
+
+Parameters:
+
+=over
+
+=item universe
+
+To avoid unnecessarily constructing new members, collections have a universe to
+which existing members can be obtained from. By default the universe is this
+collection. Generally, you should create exactly one universe for each
+collection type.
+
+=item schema
+
+Optional Debbugs::Schema object
+
+
+=back
+
+=head2 $collection->members()
+
+Returns list of members of this collection
+
+=head2 $collection->members_ref()
+
+Returns an ARRAYREF of members of this collection
+
+=head2 $collection->keys_of_members()
+
+Returns a list of the keys of all members of this collection
+
+=head2 $collection->member_key($member)
+
+Given a member, returns the key of that member
+
+=head2 $collection->exists($member_key)
+
+Returns true if a member with $member_key exists in the collection
+
+=head2 $collection->clone()
+
+Returns a clone of this collection with the same universe as this collection
+
+=head2 $collection->limit(@member_keys)
+
+Returns a new collection limited to the list of member keys passed. Will add new
+members to the universe if they do not currently exist.
+
+=head2 $collection->add($member)
+
+Add a member to this collection
+
+=head2 $collection->add_by_key($member_key)
+
+Add a member to this collection by key
+
+=head2 $collection->combine($collection2) or $collection + $collection2
+
+Combines the members of both collections together and returns the new collection
+
+=head2 $collection->get($member_key)
+
+Get member(s) by key, returning undef for keys which do not exist in the
+collection
+
+=head2 $collection->get_or_add_by_key($member_key)
+
+Get or add a member by the member key.
+
+=head2 $collection->count()
+
+Return the number of members in this collection
+
+=head2 $collection->grep({$_ eq 5})
+
+Return the members in this collection which satisfy the condition, setting $_
+locally to each member object
+
+=head2 $collection->join(', ')
+
+Returns the keys of the members of this collection joined
+
+=head2 $collection->apply({$_*2})
+
+Return the list of applying BLOCK to each member; each member can return 0 or
+more results
+
+=head2 $collection->map({$_*2})
+
+Returns the list of applying BLOCK to each member; each member should return
+exactly one result
+
+=head2 $collection->sort({$a <=> $b})
+
+Return the list of members sorted by BLOCK
+
+=cut
+
+has 'members' => (is => 'bare',
+ isa => 'ArrayRef',
+ traits => ['Array'],
+ default => sub {[]},
+ writer => '_set_members',
+ predicate => '_has_members',
+ handles => {_add => 'push',
+ members => 'elements',
+ count => 'count',
+ _get_member => 'get',
+ grep => 'grep',
+ map => 'map',
+ sort => 'sort',
+ },
+ );
+
+sub apply {
+ my $self = shift;
+ my $block = shift;
+ my @r;
+ for ($self->members) {
+ push @r,$block->();
+ }
+ return @r;
+}
+
+sub members_ref {
+ my $self = shift;
+ return [$self->members];
+}
+
+has 'member_hash' => (traits => ['Hash'],
+ is => 'bare',
+ # really a HashRef[Int], but type checking is too slow
+ isa => 'HashRef',
+ lazy => 1,
+ reader => '_member_hash',
+ builder => '_build_member_hash',
+ clearer => '_clear_member_hash',
+ predicate => '_has_member_hash',
+ writer => '_set_member_hash',
+ handles => {# _add_member_hash => 'set',
+ _member_key_exists => 'exists',
+ _get_member_hash => 'get',
+ },
+ );
+
+# because _add_member_hash needs to be fast, we are overriding the default set
+# method which is very safe but slow, because it makes copies.
+sub _add_member_hash {
+ my ($self,@kv) = @_;
+ pairmap {
+ defined($a)
+ or $self->meta->
+ throw_error("Hash keys passed to _add_member_hash must be defined" );
+ ($b eq int($b)) or
+ $self->meta->
+ throw_error("Values passed to _add_member_hash must be integer");
+ } @kv;
+ my @return;
+ while (my ($key, $value) = splice @kv, 0, 2 ) {
+ push @return,
+ $self->{member_hash}{$key} = $value
+ }
+ wantarray ? return @return: return $return[0];
+}
+
+=head2 $collection->universe
+
+
+=cut
+
+has 'universe' => (is => 'ro',
+ isa => 'Debbugs::Collection',
+ required => 1,
+ builder => '_build_universe',
+ writer => '_set_universe',
+ predicate => 'has_universe',
+ );
+
+sub _build_universe {
+ # By default, the universe is myself
+ return $_[0];
+}
+
+sub clone {
+ my $self = shift;
+ my $new = bless { %{$self} }, ref $self;
+ if ($self->_has_members) {
+ $new->_set_members([$self->members]);
+ }
+ if ($self->_has_member_hash) {
+ $new->_set_member_hash({%{$self->_member_hash}})
+ }
+ return $new;
+}
+
+sub _shallow_clone {
+ my $self = shift;
+ return bless { %{$self} }, ref $self;
+}
+
+sub limit {
+ my $self = shift;
+ my $limit = $self->_shallow_clone();
+ # Set the universe to whatever my universe is (potentially myself)
+ # $limit->_set_universe($self->universe);
+ $limit->_set_members([]);
+ $limit->_clear_member_hash();
+ $limit->add($self->universe->get_or_add_by_key(@_)) if @_;
+ return $limit;
+}
+
+sub get_or_add_by_key {
+ my $self = shift;
+ return () unless @_;
+ my @return;
+ my @exists;
+ my @need_to_add;
+ for my $i (0..$#_) {
+ # we assume that if it's already a blessed reference, that it's the
+ # right object to return
+ if (ref $_[$i]) {
+ croak "Passed a reference instead of a key to get_or_add_by_key";
+ }
+ elsif ($self->_member_key_exists($_[$i])) {
+ push @exists,$i;
+ } else {
+ push @need_to_add,$i;
+ }
+ }
+ # create and add by key
+ if (@need_to_add) {
+ @return[@need_to_add] =
+ $self->add_by_key(@_[@need_to_add]);
+ }
+ if (@exists) {
+ @return[@exists] =
+ $self->get(@_[@exists]);
+ }
+ # if we've only been asked to get or create one thing, then it's expected
+ # that we are returning only one thing
+ if (@_ == 1) {
+ return $return[0];
+ }
+ return @return;
+}
+
+has 'constructor_args' => (is => 'rw',
+ isa => 'ArrayRef',
+ lazy => 1,
+ builder => '_build_constructor_args',
+ );
+
+sub _build_constructor_args {
+ return [];
+}
+
+sub add_by_key {
+ my $self = shift;
+ # we'll assume that add does the right thing. around this in subclasses
+ return $self->add(@_);
+}
+
+sub add {
+ my $self = shift;
+ my @members_added;
+ for my $member (@_) {
+ if (not defined $member) {
+ confess("Undefined member to add");
+ }
+ push @members_added,$member;
+ if ($self->exists($member)) {
+ next;
+ }
+ $self->_add($member);
+ $self->_add_member_hash($self->member_key($member),
+ $self->count()-1,
+ );
+ }
+ return @members_added;
+}
+
+use overload '+' => "combine",
+ '""' => "CARP_TRACE";
+
+sub combine {
+ my $self = shift;
+ my $return = $self->clone;
+ $return->add($_->members) for @_;
+ return $return;
+}
+
+sub get {
+ my $self = shift;
+ my @res = map {$self->_get_member($_)}
+ $self->_get_member_hash(@_);
+ wantarray?@res:$res[0];
+}
+
+
+sub member_key {
+ return $_[1];
+}
+
+sub keys_of_members {
+ my $self = shift;
+ return $self->map(sub {$self->member_key($_)});
+}
+
+sub exists {
+ my $self = shift;
+ return $self->_member_key_exists($self->member_key($_[0]));
+}
+
+sub join {
+ my $self = shift;
+ my $joiner = shift;
+ return CORE::join($joiner,$self->keys_of_members);
+}
+
+sub _build_member_hash {
+ my $self = shift;
+ my $hash = {};
+ my $i = 0;
+ for my $member ($self->members) {
+ $hash->{$self->member_key($member)} =
+ $i++;
+ }
+ return $hash;
+}
+
+sub CARP_TRACE {
+ my $self = shift;
+ my @members = $self->members;
+ if (@members > 5) {
+ @members = map {$self->member_key($_)}
+ @members[0..4];
+ push @members,'...';
+ } else {
+ @members = map {$self->member_key($_)} @members;
+ }
+ return __PACKAGE__.'={n_members='.$self->count().
+ ',members=('.CORE::join(',',@members).')}';
+}
+
+
+__PACKAGE__->meta->make_immutable;
+no Mouse;
+1;
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
--- /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::Collection::Bug;
+
+=head1 NAME
+
+Debbugs::Collection::Bug -- Bug generation factory
+
+=head1 SYNOPSIS
+
+This collection extends L<Debbugs::Collection> and contains members of
+L<Debbugs::Bug>. Useful for any field which contains one or more bug or tracking
+lists of packages
+
+=head1 DESCRIPTION
+
+
+
+=head1 METHODS
+
+=cut
+
+use Mouse;
+use strictures 2;
+use namespace::autoclean;
+use Debbugs::Common qw(make_list hash_slice);
+use Debbugs::OOTypes;
+use Debbugs::Status qw(get_bug_statuses);
+use Debbugs::Collection::Package;
+use Debbugs::Collection::Correspondent;
+
+use Debbugs::Bug;
+
+extends 'Debbugs::Collection';
+
+=head2 my $bugs = Debbugs::Collection::Bug->new(%params|$param)
+
+Parameters in addition to those defined by L<Debbugs::Collection>
+
+=over
+
+=item package_collection
+
+Optional L<Debbugs::Collection::Package> which is used to look up packages
+
+
+=item correspondent_collection
+
+Optional L<Debbugs::Collection::Correspondent> which is used to look up correspondents
+
+
+=item users
+
+Optional arrayref of L<Debbugs::User> which set usertags for bugs in this collection
+
+=back
+
+=head2 $bugs->package_collection()
+
+Returns the package collection that this bug collection is using
+
+=head2 $bugs->correspondent_collection()
+
+Returns the correspondent collection that this bug collection is using
+
+=head2 $bugs->users()
+
+Returns the arrayref of users that this bug collection is using
+
+=head2 $bugs->add_user($user)
+
+Add a user to the set of users that this bug collection is using
+
+=head2 $bugs->load_related_packages_and_versions()
+
+Preload all of the related packages and versions for the bugs in this bug
+collection. You should call this if you plan on calculating whether the bugs in
+this collection are present/absent.
+
+=cut
+
+has '+members' => (isa => 'ArrayRef[Bug]');
+has 'package_collection' =>
+ (is => 'ro',
+ isa => 'Debbugs::Collection::Package',
+ builder => '_build_package_collection',
+ lazy => 1,
+ );
+
+sub _build_package_collection {
+ my $self = shift;
+ return Debbugs::Collection::Package->new($self->has_schema?(schema => $self->schema):());
+}
+
+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->has_schema?(schema => $self->schema):());
+}
+
+has 'users' =>
+ (is => 'ro',
+ isa => 'ArrayRef[Debbugs::User]',
+ traits => ['Array'],
+ default => sub {[]},
+ handles => {'add_user' => 'push'},
+ );
+
+sub BUILD {
+ my $self = shift;
+ my $args = shift;
+ if (exists $args->{bugs}) {
+ $self->add(
+ $self->_member_constructor(bugs => $args->{bugs}
+ ));
+ }
+}
+
+sub _member_constructor {
+ # handle being called $self->_member_constructor;
+ my $self = shift;
+ my %args = @_;
+ my @return;
+ my $schema;
+ $schema = $self->schema if $self->has_schema;
+
+ if (defined $schema) {
+ my $statuses = get_bug_statuses(bug => [make_list($args{bugs})],
+ schema => $schema,
+ );
+ # preload as many of the packages as we need
+ my %packages;
+ while (my ($bug, $status) = each %{$statuses}) {
+ if (defined $status->{package}) {
+ $packages{$_} = 1 for split /,/, $status->{package};
+ }
+ if (defined $status->{source}) {
+ $packages{$_} = 1 for split /,/, $status->{source};
+ }
+ }
+ $self->package_collection->universe->add_by_key(keys %packages);
+ while (my ($bug, $status) = each %{$statuses}) {
+ push @return,
+ Debbugs::Bug->new(bug => $bug,
+ status =>
+ Debbugs::Bug::Status->new(status => $status,
+ bug => $bug,
+ status_source => 'db',
+ ),
+ schema => $schema,
+ package_collection =>
+ $self->package_collection->universe,
+ bug_collection =>
+ $self->universe,
+ correspondent_collection =>
+ $self->correspondent_collection->universe,
+ @{$args{constructor_args}//[]},
+ );
+ }
+ } else {
+ for my $bug (make_list($args{bugs})) {
+ push @return,
+ Debbugs::Bug->new(bug => $bug,
+ package_collection =>
+ $self->package_collection->universe,
+ bug_collection =>
+ $self->universe,
+ correspondent_collection =>
+ $self->correspondent_collection->universe,
+ @{$args{constructor_args}//[]},
+ );
+ }
+ }
+ return @return;
+}
+
+around add_by_key => sub {
+ my $orig = shift;
+ my $self = shift;
+ my @members =
+ $self->_member_constructor(bugs => [@_],
+ );
+ return $self->$orig(@members);
+};
+
+sub member_key {
+ return $_[1]->bug;
+}
+
+sub load_related_packages_and_versions {
+ my $self = shift;
+ my @related_packages_and_versions =
+ $self->apply(sub {$_->related_packages_and_versions});
+ $self->package_collection->
+ add_packages_and_versions(@related_packages_and_versions);
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
--- /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::Collection::Correspondent;
+
+=head1 NAME
+
+Debbugs::Collection::Correspondent -- Bug generation factory
+
+=head1 SYNOPSIS
+
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use Mouse;
+use strictures 2;
+use namespace::autoclean;
+use Debbugs::Common qw(make_list hash_slice);
+use Debbugs::OOTypes;
+use Debbugs::Status qw(get_bug_statuses);
+
+use Debbugs::Correspondent;
+
+extends 'Debbugs::Collection';
+
+has '+members' => (isa => 'ArrayRef[Debbugs::Correspondent]');
+
+sub BUILD {
+ my $self = shift;
+ my $args = shift;
+ if (exists $args->{correspondent}) {
+ $self->
+ add($self->_member_constructor(correspondent =>
+ $args->{correspondent}));
+ }
+}
+
+
+sub _member_constructor {
+ # handle being called $self->_member_constructor;
+ my $self = shift;
+ my %args = @_;
+ my @return;
+ for my $corr (make_list($args{correspondent})) {
+ push @return,
+ Debbugs::Correspondent->new(name => $corr,
+ $self->schema_argument,
+ );
+ }
+ return @return;
+}
+
+around add_by_key => sub {
+ my $orig = shift;
+ my $self = shift;
+ my @members =
+ $self->_member_constructor(correspondent => [@_],
+ $self->schema_argument,
+ );
+ return $self->$orig(@members);
+};
+
+sub member_key {
+ return $_[1]->name;
+}
+
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
--- /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::Collection::Package;
+
+=head1 NAME
+
+Debbugs::Collection::Package -- Package generation factory
+
+=head1 SYNOPSIS
+
+This collection extends L<Debbugs::Collection> and contains members of
+L<Debbugs::Package>. Useful for any field which contains one or more package or
+tracking lists of packages
+
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use Mouse;
+use strictures 2;
+use v5.10; # for state
+use namespace::autoclean;
+
+use Carp;
+use Debbugs::Common qw(make_list hash_slice);
+use Debbugs::Config qw(:config);
+use Debbugs::OOTypes;
+use Debbugs::Package;
+
+use List::AllUtils qw(part);
+
+use Debbugs::Version::Binary;
+use Debbugs::Collection::Version;
+use Debbugs::Collection::Correspondent;
+use Debbugs::VersionTree;
+
+extends 'Debbugs::Collection';
+
+=head1 Object Creation
+
+=head2 my $packages = Debbugs::Collection::Package->new(%params|$param)
+
+Parameters in addition to those defined by L<Debbugs::Collection>
+
+=over
+
+=item correspondent_collection
+
+Optional L<Debbugs::Collection::Correspondent> which is used to look up correspondents
+
+
+=item versiontree
+
+Optional L<Debbugs::VersionTree> which contains known package source versions
+
+=back
+
+=head1 Methods
+
+=head2 correspondent_collection
+
+ $packages->correspondent_collection
+
+Returns the L<Debbugs::Collection::Correspondent> for this package collection
+
+=head2 versiontree
+
+Returns the L<Debbugs::VersionTree> for this package collection
+
+=cut
+
+has '+members' => (isa => 'ArrayRef[Debbugs::Package]');
+
+sub BUILD {
+ my $self = shift;
+ my $args = shift;
+ if (exists $args->{packages}) {
+ $self->
+ add($self->_member_constructor(packages =>
+ $args->{packages}));
+ }
+}
+
+around add_by_key => sub {
+ my $orig = shift;
+ my $self = shift;
+ my @members =
+ $self->_member_constructor(packages => [@_]);
+ return $self->$orig(@members);
+};
+
+sub _member_constructor {
+ # handle being called $self->_member_constructor;
+ my $self = shift;
+ my %args = @_;
+ my $schema;
+ if ($self->has_schema) {
+ $schema = $self->schema;
+ }
+ my @return;
+ if (defined $schema) {
+ if (not ref($args{packages}) or @{$args{packages}} == 1 and
+ $self->universe->count() > 0
+ ) {
+ carp("Likely inefficiency; member_constructor called with one argument");
+ }
+ my $packages =
+ Debbugs::Package::_get_valid_version_info_from_db(packages => $args{packages},
+ schema => $schema,
+ );
+ for my $package (keys %{$packages}) {
+ push @return,
+ Debbugs::Package->new(%{$packages->{$package}},
+ schema => $schema,
+ package_collection => $self->universe,
+ correspondent_collection =>
+ $self->correspondent_collection->universe,
+ );
+ }
+ } else {
+ for my $package (make_list($args{packages})) {
+ push @return,
+ Debbugs::Package->new(name => $package,
+ package_collection => $self->universe,
+ correspondent_collection =>
+ $self->correspondent_collection->universe,
+ );
+ }
+ }
+ return @return;
+}
+
+sub add_packages_and_versions {
+ my $self = shift;
+ $self->add($self->_member_constructor(packages => \@_));
+}
+
+
+sub member_key {
+ return $_[1]->qualified_name;
+}
+
+has 'correspondent_collection' =>
+ (is => 'ro',
+ isa => 'Debbugs::Collection::Correspondent',
+ default => sub {Debbugs::Collection::Correspondent->new()},
+ );
+
+has 'versiontree' =>
+ (is => 'ro',
+ isa => 'Debbugs::VersionTree',
+ lazy => 1,
+ builder => '_build_versiontree',
+ );
+
+sub _build_versiontree {
+ my $self = shift;
+ return Debbugs::VersionTree->new($self->has_schema?(schema => $self->schema):());
+}
+
+=head2 get_source_versions_distributions
+
+ $packages->get_source_versions_distributions('unstable')
+
+Given a list of distributions or suites, returns a
+L<Debbugs::Collection::Version> of all of the versions in this package
+collection which are known to match.
+
+Effectively, this calls L<Debbugs::Package/get_source_version_distribution> for
+each package in the collection and merges the results and returns them
+
+=cut
+
+sub get_source_versions_distributions {
+ my $self = shift;
+ my @return;
+ push @return,
+ $self->map(sub {$_->get_source_version_distribution(@_)});
+ if (@return > 1) {
+ return $return[0]->combine($return[1..$#return]);
+ }
+ return @return;
+}
+
+
+=head2 get_source_versions
+
+ $packages->get_source_versions('1.2.3-1','foo/1.2.3-5')
+
+Given a list of binary versions or src/versions, returns a
+L<Debbugs::Collection::Version> of all of the versions in this package
+collection which are known to match.
+
+If you give a binary version ('1.2.3-1'), you must have already loaded source
+packages into this package collection for it to find an appropriate match.
+
+If no package is known to match, an version which is invalid will be returned
+
+For fully qualified versions this loads the appropriate source package into the
+universe of this collection and calls L<Debbugs::Package/get_source_version>.
+For unqualified versions, calls L<Debbugs::Package/get_source_version>; if no
+valid versions are returned, creates an invalid version.
+
+=cut
+
+sub get_source_versions {
+ my $self = shift;
+ my @return;
+ for my $ver (@_) {
+ my $sv;
+ if ($ver =~ m{(?<src>.+?)/(?<ver>.+)$}) {
+ my $sp = $self->universe->
+ get_or_add_by_key('src:'.$+{src});
+ push @return,
+ $sp->get_source_version($+{ver});
+ next;
+ } else {
+ my $found_valid = 0;
+ for my $p ($self->members) {
+ local $_;
+ my @vs =
+ grep {$_->is_valid}
+ $p->get_source_version($ver);
+ if (@vs) {
+ $found_valid = 1;
+ push @return,@vs;
+ next;
+ }
+ }
+ if (not $found_valid) {
+ push @return,
+ Debbugs::Version::Binary->new(version => $ver,
+ package_collection => $self->universe,
+ valid => 0,
+ $self->schema_argument,
+ );
+ }
+ }
+ }
+ return
+ Debbugs::Collection::Version->new(members => \@return,
+ $self->schema_argument,
+ package_collection => $self->universe,
+ );
+}
+
+=head2 source_names
+
+ $packages->source_names()
+
+Returns a unique list of source names from all members of this collection by
+calling L<Debbugs::Package/source_names> on each member.
+
+=cut
+
+sub source_names {
+ my $self = shift;
+ local $_;
+ return uniq map {$_->source_names} $self->members;
+}
+
+=head2 sources
+
+ $packages->sources()
+
+Returns a L<Debbugs::Collection::Package> limited to source packages
+corresponding to all packages in this collection
+
+=cut
+
+sub sources {
+ my $self = shift;
+ return $self->universe->limit($self->source_names);
+}
+
+
+__PACKAGE__->meta->make_immutable;
+no Mouse;
+
+1;
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
--- /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::Collection::Version;
+
+=head1 NAME
+
+Debbugs::Collection::Version -- Version generation factory
+
+=head1 SYNOPSIS
+
+This collection extends L<Debbugs::Collection> and contains members of
+L<Debbugs::Version>. Useful for any field which contains package versions.
+
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use Mouse;
+use strictures 2;
+use v5.10; # for state
+use namespace::autoclean;
+use Debbugs::Common qw(make_list hash_slice);
+use Debbugs::Config qw(:config);
+use Debbugs::OOTypes;
+use Debbugs::Version;
+
+use List::AllUtils qw(part);
+
+extends 'Debbugs::Collection';
+
+=head2 my $bugs = Debbugs::Collection::version->new(%params|$param)
+
+Parameters in addition to those defined by L<Debbugs::Collection>
+
+=over
+
+=item package_collection
+
+Optional L<Debbugs::Collection::Package> which is used to look up packages
+
+=item versions
+
+Optional arrayref of C<package/version/arch> string triples
+
+=back
+
+=cut
+
+has '+members' => (isa => 'ArrayRef[Debbugs::Version]');
+
+has 'package_collection' =>
+ (is => 'ro',
+ isa => 'Debbugs::Collection::Package',
+ builder => '_build_package_collection',
+ lazy => 1,
+ );
+
+sub _build_package_collection {
+ my $self = shift;
+ return Debbugs::Collection::Package->new($self->schema_argument);
+}
+
+sub member_key {
+ my ($self,$v) = @_;
+ confess("v not defined") unless defined $v;
+ return $v->package.'/'.$v->version.'/'.$v->arch;
+}
+
+
+around add_by_key => sub {
+ my $orig = shift;
+ my $self = shift;
+ my @members =
+ $self->_member_constructor(versions => [@_]);
+ return $self->$orig(@members);
+};
+
+sub _member_constructor {
+ my $self = shift;
+ my %args = @_;
+ my @return;
+ for my $pkg_ver_arch (make_list($args{versions})) {
+ my ($pkg,$ver,$arch) = $pkg_ver_arch =~ m{^([^/]+)/([^/]+)/?([^/]*)$} or
+ confess("Invalid version key: $pkg_ver_arch");
+ if ($pkg =~ s/^src://) {
+ $arch = 'source';
+ }
+ if (not length $arch) {
+ $arch = 'any';
+ }
+ if ($arch eq 'source') {
+ push @return,
+ Debbugs::Version::Source->
+ new($self->schema_argument,
+ package => $pkg,
+ version => $ver,
+ );
+ } else {
+ push @return,
+ Debbugs::Version::Binary->
+ new($self->schema_argument,
+ package => $pkg,
+ version => $ver,
+ arch => [$arch],
+ );
+ }
+ }
+ return @return;
+}
+
+=head2 $versions->universe
+
+Unlike most collections, Debbugs::Collection::Version do not have a universe.
+
+=cut
+
+sub universe {
+ return $_[0];
+}
+
+=head2 $versions->source
+
+Returns a (potentially duplicated) list of source packages which are part of
+this version collection
+
+=cut
+
+sub source {
+ my $self = shift;
+ return $self->map(sub{$_->source});
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
return;
}
# first, figure out what type of file we're reading in.
- my $fh = new IO::File $conf_file,'r'
+ my $fh = IO::File->new($conf_file,'r')
or die "Unable to open configuration file $conf_file for reading: $!";
# A new version configuration file must have a comment as its first line
my $first_line = <$fh>;
--- /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::Correspondent;
+
+=head1 NAME
+
+Debbugs::Correspondent -- OO interface to bugs
+
+=head1 SYNOPSIS
+
+ use Debbugs::Correspondent;
+ Debbugs::Correspondent->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 Mail::Address;
+use Debbugs::OOTypes;
+use Debbugs::Config qw(:config);
+
+use Carp;
+
+extends 'Debbugs::OOBase';
+
+has name => (is => 'ro', isa => 'Str',
+ required => 1,
+ writer => '_set_name',
+ );
+
+has _mail_address => (is => 'bare', isa => 'Mail::Address',
+ lazy => 1,
+ handles => [qw(address phrase comment)],
+ builder => '_build_mail_address',
+ );
+
+sub _build_mail_address {
+ my @addr = Mail::Address->parse($_[0]->name) or
+ confess("unable to parse mail address");
+ if (@addr > 1) {
+ warn("Multiple addresses to Debbugs::Correspondent");
+ }
+ return $addr[0];
+}
+
+sub email {
+ my $email = $_[0]->address;
+ warn "No email" unless defined $email;
+ return $email;
+}
+
+sub url {
+ my $self = shift;
+ return $config{web_domain}.'/correspondent:'.$self->email;
+}
+
+sub maintainer_url {
+ my $self = shift;
+ return $config{web_domain}.'/maintainer:'.$self->email;
+}
+
+sub owner_url {
+ my $self = shift;
+ return $config{web_domain}.'/owner:'.$self->email;
+}
+
+sub submitter_url {
+ my $self = shift;
+ return $config{web_domain}.'/submitter:'.$self->email;
+}
+
+sub CARP_TRACE {
+ my $self = shift;
+ return 'Debbugs::Correspondent={name='.$self->name.'}';
+}
+
+
+__PACKAGE__->meta->make_immutable;
+
+no Mouse;
+1;
+
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
);
-# Created by DBIx::Class::Schema::Loader v0.07048 @ 2018-04-18 16:55:56
-# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:Uoaf3KzTvRYIf33q7tBnZw
+# Created by DBIx::Class::Schema::Loader v0.07049 @ 2019-07-05 20:56:47
+# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:VH/9QrwjZx0r7FLaEWGYMg
# You can replace this text with custom code or comments, and it will be preserved on regeneration
--- /dev/null
+use utf8;
+package Debbugs::DB::Result::BinPkgSrcPkg;
+
+# Created by DBIx::Class::Schema::Loader
+# DO NOT MODIFY THE FIRST PART OF THIS FILE
+
+=head1 NAME
+
+Debbugs::DB::Result::BinPkgSrcPkg - Binary package <-> source package mapping sumpmary table
+
+=cut
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Core';
+
+=head1 COMPONENTS LOADED
+
+=over 4
+
+=item * L<DBIx::Class::InflateColumn::DateTime>
+
+=item * L<DBIx::Class::TimeStamp>
+
+=back
+
+=cut
+
+__PACKAGE__->load_components("InflateColumn::DateTime", "TimeStamp");
+
+=head1 TABLE: C<bin_pkg_src_pkg>
+
+=cut
+
+__PACKAGE__->table("bin_pkg_src_pkg");
+
+=head1 ACCESSORS
+
+=head2 bin_pkg
+
+ data_type: 'integer'
+ is_foreign_key: 1
+ is_nullable: 0
+
+Binary package id (matches bin_pkg)
+
+=head2 src_pkg
+
+ data_type: 'integer'
+ is_foreign_key: 1
+ is_nullable: 0
+
+Source package id (matches src_pkg)
+
+=cut
+
+__PACKAGE__->add_columns(
+ "bin_pkg",
+ { data_type => "integer", is_foreign_key => 1, is_nullable => 0 },
+ "src_pkg",
+ { data_type => "integer", is_foreign_key => 1, is_nullable => 0 },
+);
+
+=head1 UNIQUE CONSTRAINTS
+
+=head2 C<bin_pkg_src_pkg_bin_pkg_src_pkg>
+
+=over 4
+
+=item * L</bin_pkg>
+
+=item * L</src_pkg>
+
+=back
+
+=cut
+
+__PACKAGE__->add_unique_constraint("bin_pkg_src_pkg_bin_pkg_src_pkg", ["bin_pkg", "src_pkg"]);
+
+=head2 C<bin_pkg_src_pkg_src_pkg_bin_pkg>
+
+=over 4
+
+=item * L</src_pkg>
+
+=item * L</bin_pkg>
+
+=back
+
+=cut
+
+__PACKAGE__->add_unique_constraint("bin_pkg_src_pkg_src_pkg_bin_pkg", ["src_pkg", "bin_pkg"]);
+
+=head1 RELATIONS
+
+=head2 bin_pkg
+
+Type: belongs_to
+
+Related object: L<Debbugs::DB::Result::BinPkg>
+
+=cut
+
+__PACKAGE__->belongs_to(
+ "bin_pkg",
+ "Debbugs::DB::Result::BinPkg",
+ { id => "bin_pkg" },
+ { is_deferrable => 0, on_delete => "CASCADE", on_update => "CASCADE" },
+);
+
+=head2 src_pkg
+
+Type: belongs_to
+
+Related object: L<Debbugs::DB::Result::SrcPkg>
+
+=cut
+
+__PACKAGE__->belongs_to(
+ "src_pkg",
+ "Debbugs::DB::Result::SrcPkg",
+ { id => "src_pkg" },
+ { is_deferrable => 0, on_delete => "CASCADE", on_update => "CASCADE" },
+);
+
+
+# Created by DBIx::Class::Schema::Loader v0.07048 @ 2018-04-18 16:55:56
+# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:O/v5RtjJF9SgxXEy76U/xw
+
+sub sqlt_deploy_hook {
+ my ($self, $sqlt_table) = @_;
+ $sqlt_table->schema->
+ add_procedure(name => 'bin_ver_to_src_pkg',
+ sql => <<'EOF',
+CREATE OR REPLACE FUNCTION bin_ver_to_src_pkg(bin_ver INT) RETURNS INT
+ AS $src_pkg_from_bin_ver$
+ DECLARE
+ src_pkg int;
+ BEGIN
+ SELECT sv.src_pkg INTO STRICT src_pkg
+ FROM bin_ver bv JOIN src_ver sv ON bv.src_ver=sv.id
+ WHERE bv.id=bin_ver;
+ RETURN src_pkg;
+ END
+ $src_pkg_from_bin_ver$ LANGUAGE plpgsql;
+EOF
+ );
+ $sqlt_table->schema->
+ add_procedure(name => 'src_ver_to_src_pkg',
+ sql => <<'EOF',
+CREATE OR REPLACE FUNCTION src_ver_to_src_pkg(src_ver INT) RETURNS INT
+ AS $src_ver_to_src_pkg$
+ DECLARE
+ src_pkg int;
+ BEGIN
+ SELECT sv.src_pkg INTO STRICT src_pkg
+ FROM src_ver sv WHERE sv.id=src_ver;
+ RETURN src_pkg;
+ END
+ $src_ver_to_src_pkg$ LANGUAGE plpgsql;
+EOF
+ );
+ $sqlt_table->schema->
+ add_procedure(name => 'update_bin_pkg_src_pkg_bin_ver',
+ sql => <<'EOF',
+CREATE OR REPLACE FUNCTION update_bin_pkg_src_pkg_bin_ver () RETURNS TRIGGER
+ AS $update_bin_pkg_src_pkg_bin_ver$
+ DECLARE
+ src_ver_rows integer;
+ BEGIN
+ IF (TG_OP = 'DELETE' OR TG_OP = 'UPDATE' ) THEN
+ -- if there is still a bin_ver with this src_pkg, then do nothing
+ PERFORM * FROM bin_ver bv JOIN src_ver sv ON bv.src_ver = sv.id
+ WHERE sv.id = OLD.src_ver LIMIT 2;
+ GET DIAGNOSTICS src_ver_rows = ROW_COUNT;
+ IF (src_ver_rows <= 1) THEN
+ DELETE FROM bin_pkg_src_pkg
+ WHERE bin_pkg=OLD.bin_pkg AND
+ src_pkg=src_ver_to_src_pkg(OLD.src_ver);
+ END IF;
+ END IF;
+ IF (TG_OP = 'INSERT' OR TG_OP = 'UPDATE') THEN
+ BEGIN
+ INSERT INTO bin_pkg_src_pkg (bin_pkg,src_pkg)
+ VALUES (NEW.bin_pkg,src_ver_to_src_pkg(NEW.src_ver))
+ ON CONFLICT (bin_pkg,src_pkg) DO NOTHING;
+ END;
+ END IF;
+ RETURN NULL;
+ END
+ $update_bin_pkg_src_pkg_bin_ver$ LANGUAGE plpgsql;
+EOF
+ );
+
+}
+
+1;
);
-# Created by DBIx::Class::Schema::Loader v0.07048 @ 2018-04-20 10:29:04
-# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:PJ2U+jVEO2uKfwgCYtho1A
+# Created by DBIx::Class::Schema::Loader v0.07049 @ 2019-07-05 21:00:23
+# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:STaqCap5Dk4AORK6ghGnPg
sub sqlt_deploy_hook {
=cut
__PACKAGE__->table("bug_status");
-__PACKAGE__->result_source_instance->view_definition(" SELECT b.id,\n b.id AS bug_num,\n string_agg(t.tag, ','::text) AS tags,\n b.subject,\n ( SELECT s.severity\n FROM severity s\n WHERE (s.id = b.severity)) AS severity,\n ( SELECT string_agg(package.package, ','::text ORDER BY package.package) AS string_agg\n FROM ( SELECT bp.pkg AS package\n FROM (bug_binpackage bbp\n JOIN bin_pkg bp ON ((bbp.bin_pkg = bp.id)))\n WHERE (bbp.bug = b.id)\n UNION\n SELECT concat('src:', sp.pkg) AS package\n FROM (bug_srcpackage bsp\n JOIN src_pkg sp ON ((bsp.src_pkg = sp.id)))\n WHERE (bsp.bug = b.id)) package) AS package,\n ( SELECT string_agg(affects.affects, ','::text ORDER BY affects.affects) AS string_agg\n FROM ( SELECT bp.pkg AS affects\n FROM (bug_affects_binpackage bbp\n JOIN bin_pkg bp ON ((bbp.bin_pkg = bp.id)))\n WHERE (bbp.bug = b.id)\n UNION\n SELECT concat('src:', sp.pkg) AS affects\n FROM (bug_affects_srcpackage bsp\n JOIN src_pkg sp ON ((bsp.src_pkg = sp.id)))\n WHERE (bsp.bug = b.id)) affects) AS affects,\n b.submitter_full AS originator,\n date_part('epoch'::text, b.log_modified) AS log_modified,\n date_part('epoch'::text, b.creation) AS date,\n date_part('epoch'::text, b.last_modified) AS last_modified,\n b.done_full AS done,\n string_agg((bb.blocks)::text, ' '::text ORDER BY bb.blocks) AS blocks,\n string_agg((bbb.bug)::text, ' '::text ORDER BY bbb.bug) AS blockedby,\n ( SELECT string_agg((bug.bug)::text, ' '::text ORDER BY bug.bug) AS string_agg\n FROM ( SELECT bm.merged AS bug\n FROM bug_merged bm\n WHERE (bm.bug = b.id)\n UNION\n SELECT bm.bug\n FROM bug_merged bm\n WHERE (bm.merged = b.id)) bug) AS mergedwith,\n ( SELECT string_agg(bv.ver_string, ' '::text) AS string_agg\n FROM bug_ver bv\n WHERE ((bv.bug = b.id) AND (bv.found IS TRUE))) AS found_versions,\n ( SELECT string_agg(bv.ver_string, ' '::text) AS string_agg\n FROM bug_ver bv\n WHERE ((bv.bug = b.id) AND (bv.found IS FALSE))) AS fixed_versions\n FROM ((((bug b\n LEFT JOIN bug_tag bt ON ((bt.bug = b.id)))\n LEFT JOIN tag t ON ((bt.tag = t.id)))\n LEFT JOIN bug_blocks bb ON ((bb.bug = b.id)))\n LEFT JOIN bug_blocks bbb ON ((bbb.blocks = b.id)))\n GROUP BY b.id");
+__PACKAGE__->result_source_instance->view_definition(" SELECT b.id,\n b.id AS bug_num,\n string_agg(t.tag, ','::text) AS tags,\n b.subject,\n ( SELECT s.severity\n FROM severity s\n WHERE (s.id = b.severity)) AS severity,\n ( SELECT string_agg(package.package, ','::text ORDER BY package.package) AS string_agg\n FROM ( SELECT bp.pkg AS package\n FROM (bug_binpackage bbp\n JOIN bin_pkg bp ON ((bbp.bin_pkg = bp.id)))\n WHERE (bbp.bug = b.id)\n UNION\n SELECT concat('src:', sp.pkg) AS package\n FROM (bug_srcpackage bsp\n JOIN src_pkg sp ON ((bsp.src_pkg = sp.id)))\n WHERE (bsp.bug = b.id)) package) AS package,\n ( SELECT string_agg(affects.affects, ','::text ORDER BY affects.affects) AS string_agg\n FROM ( SELECT bp.pkg AS affects\n FROM (bug_affects_binpackage bbp\n JOIN bin_pkg bp ON ((bbp.bin_pkg = bp.id)))\n WHERE (bbp.bug = b.id)\n UNION\n SELECT concat('src:', sp.pkg) AS affects\n FROM (bug_affects_srcpackage bsp\n JOIN src_pkg sp ON ((bsp.src_pkg = sp.id)))\n WHERE (bsp.bug = b.id)) affects) AS affects,\n ( SELECT m.msgid\n FROM (message m\n LEFT JOIN bug_message bm ON ((bm.message = m.id)))\n WHERE (bm.bug = b.id)\n ORDER BY m.sent_date\n LIMIT 1) AS message_id,\n b.submitter_full AS originator,\n date_part('epoch'::text, b.log_modified) AS log_modified,\n date_part('epoch'::text, b.creation) AS date,\n date_part('epoch'::text, b.last_modified) AS last_modified,\n b.done_full AS done,\n string_agg((bb.blocks)::text, ' '::text ORDER BY bb.blocks) AS blocks,\n string_agg((bbb.bug)::text, ' '::text ORDER BY bbb.bug) AS blockedby,\n ( SELECT string_agg((bug.bug)::text, ' '::text ORDER BY bug.bug) AS string_agg\n FROM ( SELECT bm.merged AS bug\n FROM bug_merged bm\n WHERE (bm.bug = b.id)\n UNION\n SELECT bm.bug\n FROM bug_merged bm\n WHERE (bm.merged = b.id)) bug) AS mergedwith,\n ( SELECT string_agg(bv.ver_string, ' '::text) AS string_agg\n FROM bug_ver bv\n WHERE ((bv.bug = b.id) AND (bv.found IS TRUE))) AS found_versions,\n ( SELECT string_agg(bv.ver_string, ' '::text) AS string_agg\n FROM bug_ver bv\n WHERE ((bv.bug = b.id) AND (bv.found IS FALSE))) AS fixed_versions\n FROM ((((bug b\n LEFT JOIN bug_tag bt ON ((bt.bug = b.id)))\n LEFT JOIN tag t ON ((bt.tag = t.id)))\n LEFT JOIN bug_blocks bb ON ((bb.bug = b.id)))\n LEFT JOIN bug_blocks bbb ON ((bbb.blocks = b.id)))\n GROUP BY b.id");
=head1 ACCESSORS
data_type: 'text'
is_nullable: 1
+=head2 message_id
+
+ data_type: 'text'
+ is_nullable: 1
+
=head2 originator
data_type: 'text'
{ data_type => "text", is_nullable => 1 },
"affects",
{ data_type => "text", is_nullable => 1 },
+ "message_id",
+ { data_type => "text", is_nullable => 1 },
"originator",
{ data_type => "text", is_nullable => 1 },
"log_modified",
);
-# Created by DBIx::Class::Schema::Loader v0.07048 @ 2018-04-20 10:29:04
-# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:OPfPxXCqSaz2OeYsZqilAg
+# Created by DBIx::Class::Schema::Loader v0.07049 @ 2019-07-05 20:55:00
+# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:xkAEshcLIPrG/6hoRbSsrw
# You can replace this text with custom code or comments, and it will be preserved on regeneration
);
-# Created by DBIx::Class::Schema::Loader v0.07048 @ 2018-04-18 16:55:56
-# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:fMMA9wnkPIdT5eiUIkLxqg
+# Created by DBIx::Class::Schema::Loader v0.07049 @ 2019-07-05 20:56:47
+# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:G2uhLQ7coWRoAHFiDkF5cQ
sub sqlt_deploy_hook {
package Debbugs::Log;
-
-use warnings;
-use strict;
+use Mouse;
+use strictures 2;
+use namespace::clean;
+use v5.10; # for state
use vars qw($VERSION $DEBUG @EXPORT @EXPORT_OK %EXPORT_TAGS);
use Exporter qw(import);
use Params::Validate qw(:types validate_with);
use Encode qw(encode encode_utf8 is_utf8);
use IO::InnerFile;
-use feature 'state';
=head1 NAME
=cut
-sub new
-{
- my $this = shift;
- my %param;
- if (@_ == 1) {
- ($param{logfh}) = @_;
- $param{inner_file} = 0;
- }
- else {
- state $spec =
- {bug_num => {type => SCALAR,
- optional => 1,
- },
- logfh => {type => HANDLE,
- optional => 1,
- },
- log_name => {type => SCALAR,
- optional => 1,
- },
- inner_file => {type => BOOLEAN,
- default => 0,
- },
- };
- %param = validate_with(params => \@_,
- spec => $spec,
- );
- }
- if (grep({exists $param{$_} and defined $param{$_}}
- qw(bug_num logfh log_name)) ne 1) {
+sub BUILD {
+ my ($self,$args) = @_;
+ if (not ($self->_has_bug_num or
+ $self->_has_logfh or
+ $self->_has_log_name)) {
croak "Exactly one of bug_num, logfh, or log_name ".
"must be passed and must be defined";
}
+}
- my $class = ref($this) || $this;
- my $self = {};
- bless $self, $class;
-
- if (exists $param{logfh}) {
- $self->{logfh} = $param{logfh}
+has 'bug_num' =>
+ (is => 'ro',
+ isa => 'Int',
+ predicate => '_has_bug_num',
+ );
+
+has 'logfh' =>
+ (is => 'ro',
+ lazy => 1,
+ builder => '_build_logfh',
+ predicate => '_has_logfh',
+ );
+
+sub _build_logfh {
+ my $self = shift;
+ my $bug_log =
+ $self->log_name;
+ my $log_fh;
+ if ($bug_log =~ m/\.gz$/) {
+ my $oldpath = $ENV{'PATH'};
+ $ENV{'PATH'} = '/bin:/usr/bin';
+ open($log_fh,'-|','gzip','-dc',$bug_log) or
+ die "Unable to open $bug_log for reading: $!";
+ $ENV{'PATH'} = $oldpath;
} else {
- my $bug_log;
- if (exists $param{bug_num}) {
- my $location = getbuglocation($param{bug_num},'log');
- $bug_log = getbugcomponent($param{bug_num},'log',$location);
- } else {
- $bug_log = $param{log_name};
- }
- if ($bug_log =~ m/\.gz$/) {
- my $oldpath = $ENV{'PATH'};
- $ENV{'PATH'} = '/bin:/usr/bin';
- open($self->{logfh},'-|','gzip','-dc',$bug_log) or
- die "Unable to open $bug_log for reading: $!";
- $ENV{'PATH'} = $oldpath;
- } else {
- open($self->{logfh},'<',$bug_log) or
- die "Unable to open $bug_log for reading: $!";
- }
+ open($log_fh,'<',$bug_log) or
+ die "Unable to open $bug_log for reading: $!";
}
+ return $log_fh;
+}
- $self->{state} = 'kill-init';
- $self->{linenum} = 0;
- $self->{inner_file} = $param{inner_file};
- return $self;
+has 'log_name' =>
+ (is => 'ro',
+ isa => 'Str',
+ lazy => 1,
+ builder => '_build_log_name',
+ predicate => '_has_log_name',
+ );
+
+sub _build_log_name {
+ my $self = shift;
+ my $location = getbuglocation($self->bug_num,'log');
+ return getbugcomponent($self->bug_num,'log',$location);
}
+has 'inner_file' =>
+ (is => 'ro',
+ isa => 'Bool',
+ default => 0,
+ );
+
+has 'state' =>
+ (is => 'ro',
+ isa => 'Str',
+ default => 'kill-init',
+ writer => '_state',
+ );
+
+sub state_transition {
+ my $self = shift;
+ my $new_state = shift;
+ my $old_state = $self->state;
+ local $_ = "$old_state $new_state";
+ unless (/^(go|go-nox|html) kill-end$/ or
+ /^(kill-init|kill-end) (incoming-recv|autocheck|recips|html)$/ or
+ /^autocheck autowait$/ or
+ /^autowait go-nox$/ or
+ /^recips kill-body$/ or
+ /^(kill-body|incoming-recv) go$/) {
+ confess "transition from $old_state to $new_state at $self->linenum disallowed";
+ }
+ $self->_state($new_state);
+}
+
+sub increment_linenum {
+ my $self = shift;
+ $self->_linenum($self->_linenum+1);
+}
+has '_linenum' =>
+ (is => 'rw',
+ isa => 'Int',
+ default => 0,
+ );
+
=item read_record
Reads and returns a single record from a log reader object. At end of file,
sub read_record
{
my $this = shift;
- my $logfh = $this->{logfh};
+ my $logfh = $this->logfh;
# This comes from bugreport.cgi, but is much simpler since it doesn't
# worry about the details of output.
while (defined (my $line = <$logfh>)) {
$record->{start} = $logfh->tell() if not defined $record->{start};
chomp $line;
- ++$this->{linenum};
+ $this->increment_linenum;
if (length($line) == 1 and exists $states{ord($line)}) {
# state transitions
- my $newstate = $states{ord($line)};
-
- # disallowed transitions
- $_ = "$this->{state} $newstate";
- unless (/^(go|go-nox|html) kill-end$/ or
- /^(kill-init|kill-end) (incoming-recv|autocheck|recips|html)$/ or
- /^kill-body go$/) {
- die "transition from $this->{state} to $newstate at $this->{linenum} disallowed";
- }
-
- $this->{state} = $newstate;
- if ($this->{state} =~ /^(autocheck|recips|html|incoming-recv)$/) {
- $record->{type} = $this->{state};
- $record->{start} = $logfh->tell;
- $record->{stop} = $logfh->tell;
- $record->{inner_file} = $this->{inner_file};
- } elsif ($this->{state} eq 'kill-end') {
- if ($this->{inner_file}) {
- $record->{fh} = IO::InnerFile->new($logfh,$record->{start},$record->{stop} - $record->{start})
- }
+ $this->state_transition($states{ord($line)});
+ if ($this->state =~ /^(autocheck|recips|html|incoming-recv)$/) {
+ $record->{type} = $this->state;
+ $record->{start} = $logfh->tell;
+ $record->{stop} = $logfh->tell;
+ $record->{inner_file} = $this->inner_file;
+ } elsif ($this->state eq 'kill-end') {
+ if ($this->inner_file) {
+ $record->{fh} =
+ IO::InnerFile->new($logfh,$record->{start},
+ $record->{stop} - $record->{start})
+ }
return $record;
}
next;
}
- $record->{stop} = $logfh->tell;
+ $record->{stop} = $logfh->tell;
$_ = $line;
- if ($this->{state} eq 'incoming-recv') {
+ if ($this->state eq 'incoming-recv') {
my $pl = $_;
unless (/^Received: \(at \S+\) by \S+;/) {
die "bad line '$pl' in state incoming-recv";
}
- $this->{state} = 'go';
- $record->{text} .= "$_\n" unless $this->{inner_file};
- } elsif ($this->{state} eq 'html') {
- $record->{text} .= "$_\n" unless $this->{inner_file};
- } elsif ($this->{state} eq 'go') {
+ $this->state_transition('go');
+ $record->{text} .= "$_\n" unless $this->inner_file;
+ } elsif ($this->state eq 'html') {
+ $record->{text} .= "$_\n" unless $this->inner_file;
+ } elsif ($this->state eq 'go') {
s/^\030//;
- $record->{text} .= "$_\n" unless $this->{inner_file};
- } elsif ($this->{state} eq 'go-nox') {
- $record->{text} .= "$_\n" unless $this->{inner_file};
- } elsif ($this->{state} eq 'recips') {
+ $record->{text} .= "$_\n" unless $this->inner_file;
+ } elsif ($this->state eq 'go-nox') {
+ $record->{text} .= "$_\n" unless $this->inner_file;
+ } elsif ($this->state eq 'recips') {
if (/^-t$/) {
undef $record->{recips};
} else {
# preserve trailing null fields, e.g. #2298
$record->{recips} = [split /\04/, $_, -1];
}
- $this->{state} = 'kill-body';
- $record->{start} = $logfh->tell+2;
- $record->{stop} = $logfh->tell+2;
- $record->{inner_file} = $this->{inner_file};
- } elsif ($this->{state} eq 'autocheck') {
- $record->{text} .= "$_\n" unless $this->{inner_file};
+ $this->state_transition('kill-body');
+ $record->{start} = $logfh->tell+2;
+ $record->{stop} = $logfh->tell+2;
+ $record->{inner_file} = $this->inner_file;
+ } elsif ($this->state eq 'autocheck') {
+ $record->{text} .= "$_\n" unless $this->inner_file;
next if !/^X-Debian-Bugs(-\w+)?: This is an autoforward from (\S+)/;
- $this->{state} = 'autowait';
- } elsif ($this->{state} eq 'autowait') {
- $record->{text} .= "$_\n" unless $this->{inner_file};
+ $this->state_transition('autowait');
+ } elsif ($this->state eq 'autowait') {
+ $record->{text} .= "$_\n" unless $this->inner_file;
next if !/^$/;
- $this->{state} = 'go-nox';
+ $this->state_transition('go-nox');
} else {
- die "state $this->{state} at line $this->{linenum} ('$_')";
+ die "state $this->state at line $this->linenum ('$_')";
}
}
- die "state $this->{state} at end" unless $this->{state} eq 'kill-end';
+ die "state $this->state at end" unless $this->state eq 'kill-end';
if (keys %$record) {
return $record;
}
}
+=item rewind
+
+Rewinds the Debbugs::Log to the beginning
+
+=cut
+
+sub rewind {
+ my $self = shift;
+ if ($self->_has_log_name) {
+ $self->_clear_log_fh;
+ } else {
+ $self->log_fh->seek(0);
+ }
+ $self->_state('kill-init');
+ $self->_linenum(0);
+}
+
+=item read_all_records
+
+Reads all of the Debbugs::Records
+
+=cut
+
+sub read_all_records {
+ my $self = shift;
+ if ($self->_linenum != 0) {
+ $self->rewind;
+ }
+ my @records;
+ while (defined(my $record = $self->read_record())) {
+ push @records, $record;
+ }
+ return @records;
+}
+
+
=item read_log_records
Takes a .log filehandle as input, and returns an array of all records in
--- /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::OOBase;
+
+=head1 NAME
+
+Debbugs::OOBase -- OO Base class for Debbugs
+
+=head1 SYNOPSIS
+
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use Mouse;
+use strictures 2;
+use namespace::autoclean;
+
+has schema => (is => 'ro', isa => 'Object',
+ required => 0,
+ predicate => 'has_schema',
+ );
+
+sub schema_argument {
+ my $self = shift;
+ if ($self->has_schema) {
+ return (schema => $self->schema);
+ } else {
+ return ();
+ }
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
--- /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::OOTypes;
+
+=head1 NAME
+
+Debbugs::OOTypes -- OO Types for Debbugs
+
+=head1 SYNOPSIS
+
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use Mouse::Util::TypeConstraints;
+use strictures 2;
+use namespace::autoclean;
+
+# Bug Subtype
+subtype 'Bug' =>
+ as 'Debbugs::Bug';
+
+coerce 'Bug' =>
+ from 'Int' =>
+ via {Debbugs::Bug->new($_)};
+
+# Package Subtype
+subtype 'Package' =>
+ as 'Debbugs::Package';
+
+coerce 'Package' =>
+ from 'Str' =>
+ via {Debbugs::Package->new(package => $_)};
+
+
+# Version Subtype
+subtype 'Version' =>
+ as 'Debbugs::Version';
+
+coerce 'Version' =>
+ from 'Str' =>
+ via {Debbugs::Version->new(string=>$_)};
+
+no Mouse::Util::TypeConstraints;
+1;
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
--- /dev/null
+# This module is part of debbugs, and
+# is released under the terms of the GPL version 3, 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::Package;
+
+=head1 NAME
+
+Debbugs::Package -- OO interface to packages
+
+=head1 SYNOPSIS
+
+ use Debbugs::Package;
+ Debbugs::Package->new(schema => $s,binaries => [qw(foo)],sources => [qw(bar)]);
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use Mouse;
+use strictures 2;
+use v5.10; # for state
+use namespace::autoclean;
+
+use List::AllUtils qw(uniq pairmap);
+use Debbugs::Config qw(:config);
+use Debbugs::Version::Source;
+use Debbugs::Version::Binary;
+
+extends 'Debbugs::OOBase';
+
+=head2 name
+
+Name of the Package
+
+=head2 qualified_name
+
+name if binary, name prefixed with C<src:> if source
+
+=cut
+
+has name => (is => 'ro', isa => 'Str',
+ required => 1,
+ );
+
+sub qualified_name {
+ my $self = shift;
+ return
+ # src: if source, nothing if binary
+ ($self->_type eq 'source' ? 'src:':'') .
+ $self->name;
+}
+
+
+=head2 type
+
+Type of the package; either C<binary> or C<source>
+
+=cut
+
+has type => (is => 'bare', isa => 'Str',
+ lazy => 1,
+ builder => '_build_type',
+ clearer => '_clear_type',
+ reader => '_type',
+ writer => '_set_type',
+ );
+
+sub _build_type {
+ my $self = shift;
+ if ($self->name !~ /^src:/) {
+ return 'binary';
+ }
+}
+
+=head2 url
+
+url to the package
+
+=cut
+
+sub url {
+ my $self = shift;
+ return $config{web_domain}.'/'.$self->qualified_name;
+}
+
+around BUILDARGS => sub {
+ my $orig = shift;
+ my $class = shift;
+ my %args;
+ if (@_==1 and ref($_[0]) eq 'HASH') {
+ %args = %{$_[0]};
+ } else {
+ %args = @_;
+ }
+ $args{name} //= '(unknown)';
+ if ($args{name} =~ /src:(.+)/) {
+ $args{name} = $1;
+ $args{type} = 'source';
+ } else {
+ $args{type} = 'binary' unless
+ defined $args{type};
+ }
+ return $class->$orig(%args);
+};
+
+=head2 is_source
+
+true if the package is a source package
+
+=head2 is_binary
+
+true if the package is a binary package
+
+=cut
+
+sub is_source {
+ return $_[0]->_type eq 'source'
+}
+
+sub is_binary {
+ return $_[0]->_type eq 'binary'
+}
+
+=head2 valid -- true if the package has any valid versions
+
+=cut
+
+has valid => (is => 'ro', isa => 'Bool',
+ lazy => 1,
+ builder => '_build_valid',
+ writer => '_set_valid',
+ );
+
+sub _build_valid {
+ my $self = shift;
+ if ($self->valid_version_info_count> 0) {
+ return 1;
+ }
+ return 0;
+}
+
+# this contains source name, source version, binary name, binary version, arch,
+# and dist which have been selected from the database. It is used to build
+# versions and anything else which are known as required.
+has 'valid_version_info' =>
+ (is => 'bare', isa => 'ArrayRef',
+ traits => ['Array'],
+ lazy => 1,
+ builder => '_build_valid_version_info',
+ predicate => '_has_valid_version_info',
+ clearer => '_clear_valid_version_info',
+ handles => {'_get_valid_version_info' => 'get',
+ 'valid_version_info_grep' => 'grep',
+ '_valid_version_info' => 'elements',
+ 'valid_version_info_count' => 'count',
+ },
+ );
+
+sub _build_valid_version_info {
+ my $self = shift;
+ my $pkgs = $self->_get_valid_version_info_from_db;
+ for my $invalid_version (@{$pkgs->{$self->qualified_name}->{invalid_versions}}) {
+ $self->_mark_invalid_version($invalid_version,1);
+ }
+ return $pkgs->{$self->qualified_name}->{valid_version_info} // [];
+}
+
+state $common_dists = [@{$config{distributions}}];
+sub _get_valid_version_info_from_db {
+ my $self;
+ if ((@_ % 2) == 1 and
+ blessed($_[0])) {
+ $self = shift;
+ }
+ my %args = @_;
+ my @packages;
+ my $s; # schema
+ if (defined $self) {
+ if ($self->has_schema) {
+ $s = $self->schema;
+ } else {
+ $s = $args{schema};
+ }
+ @packages = $self->qualified_name;
+ } else {
+ $s = $args{schema};
+ @packages = @{$args{packages}};
+ }
+ if (not defined $s) {
+ confess("get_info_from_db not implemented without schema");
+ }
+ my %src_packages;
+ my %src_ver_packages;
+ my %bin_packages;
+ my %bin_ver_packages;
+ # split packages into src/ver, bin/ver, src, and bin so we can select them
+ # from the database
+ local $_;
+ for my $pkg (@packages) {
+ if (ref($pkg)) {
+ if ($pkg->[0] =~ /^src:(.+)$/) {
+ for my $ver (@{$pkg}[1..$#{$pkg}]) {
+ $src_ver_packages{$1}{$ver} = 0;
+ }
+ } else {
+ for my $ver (@{$pkg}[1..$#{$pkg}]) {
+ $bin_ver_packages{$pkg->[0]}{$ver} = 0;
+ }
+ }
+ } elsif ($pkg =~ /^src:(.+)$/) {
+ $src_packages{$1} = 0;
+ } else {
+ $bin_packages{$pkg} = 0;
+ }
+ }
+ # calculate searches for packages where we want specific versions. We
+ # calculate this here so add_result_to_package can stomp over
+ # %src_ver_packages and %bin_ver_packages
+ my @src_ver_search;
+ for my $sp (keys %src_ver_packages) {
+ push @src_ver_search,
+ (-and => {'src_pkg.pkg' => $sp,
+ 'me.ver' => [keys %{$src_ver_packages{$sp}}],
+ },
+ );
+ }
+ my @src_packages = keys %src_packages;
+
+ my @bin_ver_search;
+ for my $sp (keys %bin_ver_packages) {
+ push @bin_ver_search,
+ (-and => {'bin_pkg.pkg' => $sp,
+ 'me.ver' => [keys %{$bin_ver_packages{$sp}}],
+ },
+ );
+ }
+ my @bin_packages = keys %bin_packages;
+ my $packages = {};
+ sub _default_pkg_info {
+ return {name => $_[0],
+ type => $_[1]//'source',
+ valid => $_[2]//1,
+ valid_version_info => [],
+ invalid_versions => {},
+ };
+ }
+ sub add_result_to_package {
+ my ($pkgs,$rs,$svp,$bvp,$sp,$bp) = @_;
+ while (my $pkg = $rs->next) {
+ my $n = 'src:'.$pkg->{src_pkg};
+ if (not exists $pkgs->{$n}) {
+ $pkgs->{$n} =
+ _default_pkg_info($pkg->{src_pkg});
+ }
+ push @{$pkgs->{$n}{valid_version_info}},
+ {%$pkg};
+ $n = $pkg->{bin_pkg};
+ if (not exists $pkgs->{$n}) {
+ $pkgs->{$n} =
+ _default_pkg_info($pkg->{bin_pkg},'binary');
+ }
+ push @{$pkgs->{$n}{valid_version_info}},
+ {%$pkg};
+ # this is a package with a valid src_ver
+ $svp->{$pkg->{src_pkg}}{$pkg->{src_ver}}++;
+ $sp->{$pkg->{src_pkg}}++;
+ # this is a package with a valid bin_ver
+ $bvp->{$pkg->{bin_pkg}}{$pkg->{bin_ver}}++;
+ $bp->{$pkg->{bin_pkg}}++;
+ }
+ }
+ if (@src_packages) {
+ my $src_rs = $s->resultset('SrcVer')->
+ search({-or => [-and => {'src_pkg.pkg' => [@src_packages],
+ -or => {'suite.codename' => $common_dists,
+ 'suite.suite_name' => $common_dists,
+ },
+ },
+ @src_ver_search,
+ ],
+ },
+ {join => ['src_pkg',
+ {
+ 'src_associations' => 'suite'},
+ {
+ 'bin_vers' => ['bin_pkg','arch']},
+ 'maintainer',
+ ],
+ 'select' => [qw(src_pkg.pkg),
+ qw(suite.codename),
+ qw(suite.suite_name),
+ qw(src_associations.modified),
+ qw(me.ver),
+ q(CONCAT(src_pkg.pkg,'/',me.ver)),
+ qw(bin_vers.ver bin_pkg.pkg arch.arch),
+ qw(maintainer.name),
+ ],
+ 'as' => [qw(src_pkg codename suite_name),
+ qw(modified_time src_ver src_pkg_ver),
+ qw(bin_ver bin_pkg arch maintainer),
+ ],
+ result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+ },
+ );
+ add_result_to_package($packages,$src_rs,
+ \%src_ver_packages,
+ \%bin_ver_packages,
+ \%src_packages,
+ \%bin_packages,
+ );
+ }
+ if (@bin_packages) {
+ my $bin_assoc_rs =
+ $s->resultset('BinAssociation')->
+ search({-and => {'bin_pkg.pkg' => [@bin_packages],
+ -or => {'suite.codename' => $common_dists,
+ 'suite.suite_name' => $common_dists,
+ },
+ }},
+ {join => [{'bin' =>
+ [{'src_ver' => ['src_pkg',
+ 'maintainer',
+ ]},
+ 'bin_pkg',
+ 'arch']},
+ 'suite',
+ ],
+ 'select' => [qw(src_pkg.pkg),
+ qw(suite.codename),
+ qw(suite.suite_name),
+ qw(me.modified),
+ qw(src_ver.ver),
+ q(CONCAT(src_pkg.pkg,'/',src_ver.ver)),
+ qw(bin.ver bin_pkg.pkg arch.arch),
+ qw(maintainer.name),
+ ],
+ 'as' => [qw(src_pkg codename suite_name),
+ qw(modified_time src_ver src_pkg_ver),
+ qw(bin_ver bin_pkg arch maintainer),
+ ],
+ result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+ },
+ );
+ add_result_to_package($packages,$bin_assoc_rs,
+ \%src_ver_packages,
+ \%bin_ver_packages,
+ \%src_packages,
+ \%bin_packages,
+ );
+ }
+ if (@bin_ver_search) {
+ my $bin_rs = $s->resultset('BinVer')->
+ search({-or => [@bin_ver_search,
+ ],
+ },
+ {join => ['bin_pkg',
+ {
+ 'bin_associations' => 'suite'},
+ {'src_ver' => ['src_pkg',
+ 'maintainer',
+ ]},
+ 'arch',
+ ],
+ 'select' => [qw(src_pkg.pkg),
+ qw(suite.codename),
+ qw(suite.suite_name),
+ qw(bin_associations.modified),
+ qw(src_ver.ver),
+ q(CONCAT(src_pkg.pkg,'/',src_ver.ver)),
+ qw(me.ver bin_pkg.pkg arch.arch),
+ qw(maintainer.name),
+ ],
+ 'as' => [qw(src_pkg codename suite_name),
+ qw(modified_time src_ver src_pkg_ver),
+ qw(bin_ver bin_pkg arch maintainer),
+ ],
+ result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+ },
+ );
+ add_result_to_package($packages,$bin_rs,
+ \%src_ver_packages,
+ \%bin_ver_packages,
+ \%src_packages,
+ \%bin_packages,
+ );
+ }
+ for my $sp (keys %src_ver_packages) {
+ if (not exists $packages->{'src:'.$sp}) {
+ $packages->{'src:'.$sp} =
+ _default_pkg_info($sp,'source',0);
+ }
+ for my $sv (keys %{$src_ver_packages{$sp}}) {
+ next if $src_ver_packages{$sp}{$sv} > 0;
+ $packages->{'src:'.$sp}{invalid_versions}{$sv} = 1;
+ }
+ }
+ for my $bp (keys %bin_ver_packages) {
+ if (not exists $packages->{$bp}) {
+ $packages->{$bp} =
+ _default_pkg_info($bp,'binary',0);
+ }
+ for my $bv (keys %{$bin_ver_packages{$bp}}) {
+ next if $bin_ver_packages{$bp}{$bv} > 0;
+ $packages->{$bp}{invalid_versions}{$bv} = 1;
+ }
+ }
+ for my $sp (keys %src_packages) {
+ next if $src_packages{$sp} > 0;
+ $packages->{'src:'.$sp} =
+ _default_pkg_info($sp,'source',0);
+ }
+ for my $bp (keys %bin_packages) {
+ next if $bin_packages{$bp} > 0;
+ $packages->{$bp} =
+ _default_pkg_info($bp,'binary',0);
+ }
+ return $packages;
+}
+
+has 'source_version_to_info' =>
+ (is => 'bare', isa => 'HashRef',
+ traits => ['Hash'],
+ lazy => 1,
+ builder => '_build_source_version_to_info',
+ handles => {_get_source_version_to_info => 'get',
+ },
+ );
+
+sub _build_source_version_to_info {
+ my $self = shift;
+ my $info = {};
+ my $i = 0;
+ for my $v ($self->_valid_version_info) {
+ push @{$info->{$v->{src_ver}}}, $i;
+ $i++;
+ }
+ return $info;
+}
+
+has 'binary_version_to_info' =>
+ (is => 'bare', isa => 'HashRef',
+ traits => ['Hash'],
+ lazy => 1,
+ builder => '_build_binary_version_to_info',
+ handles => {_get_binary_version_to_info => 'get',
+ },
+ );
+
+sub _build_binary_version_to_info {
+ my $self = shift;
+ my $info = {};
+ my $i = 0;
+ for my $v ($self->_valid_version_info) {
+ push @{$info->{$v->{bin_ver}}}, $i;
+ $i++;
+ }
+ return $info;
+}
+
+has 'dist_to_info' =>
+ (is => 'bare', isa => 'HashRef',
+ traits => ['Hash'],
+ lazy => 1,
+ builder => '_build_dist_to_info',
+ handles => {_get_dist_to_info => 'get',
+ },
+ );
+sub _build_dist_to_info {
+ my $self = shift;
+ my $info = {};
+ my $i = 0;
+ for my $v ($self->_valid_version_info) {
+ next unless defined $v->{suite_name} and length($v->{suite_name});
+ push @{$info->{$v->{suite_name}}}, $i;
+ $i++;
+ }
+ return $info;
+}
+
+# this is a hashref of versions that we know are invalid
+has 'invalid_versions' =>
+ (is => 'bare',isa => 'HashRef[Bool]',
+ lazy => 1,
+ default => sub {{}},
+ clearer => '_clear_invalid_versions',
+ traits => ['Hash'],
+ handles => {_invalid_version => 'exists',
+ _mark_invalid_version => 'set',
+ },
+ );
+
+has 'binaries' => (is => 'ro',
+ isa => 'Debbugs::Collection::Package',
+ lazy => 1,
+ builder => '_build_binaries',
+ predicate => '_has_binaries',
+ );
+
+sub _build_binaries {
+ my $self = shift;
+ if ($self->is_binary) {
+ return $self->package_collection->limit($self->name);
+ }
+ # OK, walk through the valid_versions for this package
+ my @binaries =
+ uniq map {$_->{bin_pkg}} $self->_valid_version_info;
+ return $self->package_collection->limit(@binaries);
+}
+
+has 'sources' => (is => 'ro',
+ isa => 'Debbugs::Collection::Package',
+ lazy => 1,
+ builder => '_build_sources',
+ predicate => '_has_sources',
+ );
+
+sub _build_sources {
+ my $self = shift;
+ return $self->package_collection->limit($self->source_names);
+}
+
+sub source_names {
+ my $self = shift;
+
+ if ($self->is_source) {
+ return $self->name
+ }
+ return uniq map {'src:'.$_->{src_pkg}} $self->_valid_version_info;
+}
+
+=head2 maintainers
+
+L<Debbugs::Collection::Correspondent> of the maintainer(s) of the current package
+
+=cut
+
+has maintainers => (is => 'ro',
+ isa => 'Debbugs::Collection::Correspondent',
+ lazy => 1,
+ builder => '_build_maintainers',
+ predicate => '_has_maintainers',
+ );
+
+sub _build_maintainers {
+ my $self = shift;
+ my @maintainers;
+ for my $v ($self->_valid_version_info) {
+ next unless length($v->{suite_name}) and length($v->{maintainer});
+ push @maintainers,$v->{maintainer};
+ }
+ @maintainers =
+ uniq @maintainers;
+ return $self->correspondent_collection->limit(@maintainers);
+}
+
+has 'versions' => (is => 'bare',
+ isa => 'HashRef[Debbugs::Version]',
+ traits => ['Hash'],
+ handles => {_exists_version => 'exists',
+ _get_version => 'get',
+ _set_version => 'set',
+ },
+ lazy => 1,
+ builder => '_build_versions',
+ );
+
+sub _build_versions {
+ my $self = shift;
+ return {};
+}
+
+sub _add_version {
+ my $self = shift;
+ my @set;
+ for my $v (@_) {
+ push @set,
+ $v->version,$v;
+ }
+ $self->_set_version(@set);
+}
+
+sub get_source_version_distribution {
+ my $self = shift;
+
+ my %src_pkg_vers = @_;
+ for my $dist (@_) {
+ my @ver_loc =
+ grep {defined $_}
+ $self->_get_dist_to_info($dist);
+ for my $v ($self->
+ _get_valid_version_info(@ver_loc)) {
+ $src_pkg_vers{$v->{src_pkg_ver}} = 1;
+ }
+ }
+ return $self->package_collection->
+ get_source_versions(keys %src_pkg_vers)->members;
+}
+
+# returns the source version(s) corresponding to the version of *this* package; the
+# version passed may be binary or source, depending.
+sub get_source_version {
+ my $self = shift;
+ if ($self->is_source) {
+ return $self->get_version(@_);
+ }
+ my %src_pkg_vers;
+ for my $ver (@_) {
+ my %archs;
+ if (ref $ver) {
+ my @archs;
+ ($ver,@archs) = @{$ver};
+ @archs{@archs} = (1) x @archs;
+ }
+ my @ver_loc =
+ @{$self->_get_binary_version_to_info($ver)//[]};
+ next unless @ver_loc;
+ my @vers = map {$self->
+ _get_valid_version_info($_)}
+ @ver_loc;
+ for my $v (@vers) {
+ if (keys %archs) {
+ next unless exists $archs{$v->{arch}};
+ }
+ $src_pkg_vers{$v->{src_pkg_ver}} = 1;
+ }
+ }
+ return $self->package_collection->
+ get_source_versions(keys %src_pkg_vers)->members;
+}
+
+sub get_version {
+ my $self = shift;
+ my @ret;
+ for my $v (@_) {
+ if ($self->_exists_version($v)) {
+ push @ret,$self->_get_version($v);
+ } else {
+ push @ret,
+ $self->_create_version($v);
+ }
+ }
+ return @ret;
+}
+
+sub _create_version {
+ my $self = shift;
+ my @versions;
+ if ($self->is_source) {
+ for my $v (@_) {
+ push @versions,
+ $v,
+ Debbugs::Version::Source->
+ new(pkg => $self,
+ version => $v,
+ package_collection => $self->package_collection,
+ $self->schema_argument,
+ );
+ }
+ } else {
+ for my $v (@_) {
+ push @versions,
+ $v,
+ Debbugs::Version::Binary->
+ new(pkg => $self,
+ version => $v,
+ package_collection => $self->package_collection,
+ $self->schema_argument,
+ );
+ }
+ }
+ $self->_set_version(@versions);
+}
+
+=head2 package_collection
+
+L<Debbugs::Collection::Package> to get additional packages required
+
+=cut
+
+# gets used to retrieve packages
+has 'package_collection' => (is => 'ro',
+ isa => 'Debbugs::Collection::Package',
+ builder => '_build_package_collection',
+ lazy => 1,
+ );
+
+sub _build_package_collection {
+ my $self = shift;
+ return Debbugs::Collection::Package->new($self->schema_argument)
+}
+
+=head2 correspondent_collection
+
+L<Debbugs::Collection::Correspondent> to get additional maintainers required
+
+=cut
+
+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)
+}
+
+sub CARP_TRACE {
+ my $self = shift;
+ return 'Debbugs::Package={package='.$self->qualified_name.'}';
+}
+
+__PACKAGE__->meta->make_immutable;
+no Mouse;
+
+1;
+
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
"visible_cats" => [],
"unknown_stanzas" => [],
values => {},
+ bug_tags => {},
email => $email,
};
bless $self, $class;
my %tag = @stanza;
my $t = $tag{"Tag"};
$ut->{$t} = [] unless defined $ut->{$t};
- push @{$ut->{$t}}, split /\s*,\s*/, $tag{Bugs};
+ my @bugs = split /\s*,\s*/, $tag{Bugs};
+ push @{$ut->{$t}}, @bugs;
+ for my $bug (@bugs) {
+ push @{$self->{bug_tags}{$bug}},
+ $t;
+ }
} elsif ($stanza[0] eq "Category") {
my @cat = ();
my %stanza = @stanza;
return $self;
}
+sub email {
+ my $self = shift;
+ return $self->{email};
+}
+
+sub tags {
+ my $self = shift;
+
+ return $self->{"tags"};
+}
+
+sub tags_on_bug {
+ my $self = shift;
+ return map {@{$self->{"bug_tags"}{$_}//[]}} @_;
+}
+
+sub has_bug_tags {
+ my $self = shift;
+ return keys %{$self->{bug_tags}} > 0;
+}
+
sub write {
my $self = shift;
--- /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::Version;
+
+=head1 NAME
+
+Debbugs::Version -- OO interface to Version
+
+=head1 SYNOPSIS
+
+This package provides a convenient interface to refer to package versions and
+potentially make calculations based upon them
+
+ use Debbugs::Version;
+ my $v = Debbugs::Version->new(schema => $s,binaries => [qw(foo)],sources => [qw(bar)]);
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use Mouse;
+use v5.10;
+use strictures 2;
+use namespace::autoclean;
+
+use Debbugs::Config qw(:config);
+use Debbugs::Collection::Package;
+use Debbugs::OOTypes;
+use Carp;
+
+extends 'Debbugs::OOBase';
+
+=head1 Object Creation
+
+=head2 my $version = Debbugs::Version::Source->new(%params|$param)
+
+or C<Debbugs::Version::Binary->new(%params|$param)> for a binary version
+
+=over
+
+=item schema
+
+L<Debbugs::DB> schema which can be used to look up versions
+
+=item package
+
+String representation of the package
+
+=item pkg
+
+L<Debbugs::Package> which refers to the package given.
+
+Only one of C<package> or C<pkg> should be given
+
+=item package_collection
+
+L<Debbugs::Collection::Package> which is used to generate a L<Debbugs::Package>
+object from the package name
+
+=back
+
+=cut
+
+around BUILDARGS => sub {
+ my $orig = shift;
+ my $class = shift;
+ if ($class eq __PACKAGE__) {
+ confess("You should not be instantiating Debbugs::Version. ".
+ "Use Debbugs::Version::Source or ::Binary");
+ }
+ my %args;
+ if (@_==1 and ref($_[0]) eq 'HASH') {
+ %args = %{$_[0]};
+ } else {
+ %args = @_;
+ }
+ return $class->$orig(%args);
+};
+
+
+
+state $strong_severities =
+ {map {($_,1)} @{$config{strong_severities}}};
+
+=head1 Methods
+
+=head2 version
+
+ $version->version
+
+Returns the source or binary package version
+
+=cut
+
+has version => (is => 'ro', isa => 'Str',
+ required => 1,
+ builder => '_build_version',
+ predicate => '_has_version',
+ );
+
+=head2 type
+
+Returns 'source' if this is a source version, or 'binary' if this is a binary
+version.
+
+=cut
+
+=head2 source_version
+
+Returns the source version for this version; if this is a source version,
+returns itself.
+
+=cut
+
+=head2 src_pkg_ver
+
+Returns the fully qualified source_package/version string for this version.
+
+=cut
+
+=head2 package
+
+Returns the name of the package that this version is in
+
+=cut
+
+has package => (is => 'ro',
+ isa => 'Str',
+ builder => '_build_package',
+ predicate => '_has_package',
+ lazy => 1,
+ );
+
+sub _build_package {
+ my $self = shift;
+ if ($self->_has_pkg) {
+ return $self->pkg->name;
+ }
+ return '(unknown)';
+}
+
+=head2 pkg
+
+Returns a L<Debbugs::Package> object corresponding to C<package>.
+
+=cut
+
+
+has pkg => (is => 'ro',
+ isa => 'Debbugs::Package',
+ lazy => 1,
+ builder => '_build_pkg',
+ reader => 'pkg',
+ predicate => '_has_pkg',
+ );
+
+sub _build_pkg {
+ my $self = shift;
+ return Debbugs::Package->new(package => $self->package,
+ type => $self->type,
+ valid => 0,
+ package_collection => $self->package_collection,
+ $self->schema_argument,
+ );
+}
+
+
+=head2 valid
+
+Returns 1 if this package is valid, 0 otherwise.
+
+=cut
+
+has valid => (is => 'ro',
+ isa => 'Bool',
+ reader => 'is_valid',
+ lazy => 1,
+ builder => '_build_valid',
+ );
+
+sub _build_valid {
+ my $self = shift;
+ return 0;
+}
+
+
+=head2 package_collection
+
+Returns the L<Debugs::Collection::Package> which is in use by this version
+object.
+
+=cut
+
+has 'package_collection' => (is => 'ro',
+ isa => 'Debbugs::Collection::Package',
+ builder => '_build_package_collection',
+ lazy => 1,
+ );
+sub _build_package_collection {
+ my $self = shift;
+ return Debbugs::Collection::Package->new($self->schema_arg)
+}
+
+
+__PACKAGE__->meta->make_immutable;
+no Mouse;
+1;
+
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
--- /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::Version::Binary;
+
+=head1 NAME
+
+Debbugs::Version::Binary -- OO interface to Version
+
+=head1 SYNOPSIS
+
+ use Debbugs::Version::Binary;
+ Debbugs::Version::Binary->new(schema => $s,binaries => [qw(foo)],sources => [qw(bar)]);
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use Mouse;
+use v5.10;
+use strictures 2;
+use namespace::autoclean;
+
+use Debbugs::Config qw(:config);
+use Debbugs::Collection::Package;
+use Debbugs::OOTypes;
+
+extends 'Debbugs::Version';
+
+sub type {
+ return 'binary';
+}
+
+has source_version => (is => 'ro',
+ isa => 'Debbugs::Version::Source',
+ lazy => 1,
+ builder => '_build_source_version',
+ );
+
+sub _build_source_version {
+ my $self = shift;
+ my $source_version =
+ $self->pkg->
+ get_source_version(version => $self->version,
+ $self->_count_archs?(archs => [$self->_archs]):(),
+ );
+ if (defined $source_version) {
+ return $source_version;
+ }
+ return Debbugs::Version::Source->new(version => $self->version,
+ package => '(unknown)',
+ valid => 0,
+ package_collection => $self->package_collection,
+ );
+}
+
+sub src_pkg_ver {
+ my $self = shift;
+ return $self->source->src_pkg_ver;
+}
+
+has archs => (is => 'bare',
+ isa => 'ArrayRef[Str]',
+ builder => '_build_archs',
+ traits => ['Array'],
+ handles => {'_archs' => 'elements',
+ '_count_archs' => 'count',
+ },
+ );
+
+sub _build_archs {
+ my $self = shift;
+ # this is wrong, but we'll start like this for now
+ return ['any'];
+}
+
+sub arch {
+ my $self = shift;
+ return $self->_count_archs > 0?join(',',$self->_archs):'any';
+}
+
+
+__PACKAGE__->meta->make_immutable;
+no Mouse;
+1;
+
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
--- /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::Version::Source;
+
+=head1 NAME
+
+Debbugs::Version::Source -- OO interface to Version
+
+=head1 SYNOPSIS
+
+ use Debbugs::Version::Source;
+ Debbugs::Version::Source->new(schema => $s,binaries => [qw(foo)],sources => [qw(bar)]);
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use Mouse;
+use v5.10;
+use strictures 2;
+use namespace::autoclean;
+
+use Debbugs::Config qw(:config);
+use Debbugs::Collection::Package;
+use Debbugs::OOTypes;
+
+extends 'Debbugs::Version';
+
+sub type {
+ return 'source';
+}
+
+sub source_version {
+ return $_[0];
+}
+
+sub src_pkg_ver {
+ my $self = shift;
+ return $self->package.'/'.$self->version;
+}
+
+has maintainer => (is => 'ro',
+ isa => 'Str',
+ );
+
+sub source {
+ my $self = shift;
+ return $self->pkg;
+}
+
+sub arch {
+ return 'source';
+}
+
+
+__PACKAGE__->meta->make_immutable;
+no Mouse;
+1;
+
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
--- /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::VersionTree;
+
+=head1 NAME
+
+Debbugs::VersionTree -- OO interface to Debbugs::Versions
+
+=head1 SYNOPSIS
+
+ use Debbugs::VersionTree;
+ my $vt = Debbugs::VersionTree->new();
+
+=head1 DESCRIPTION
+
+
+
+=cut
+
+use Mouse;
+use v5.10;
+use strictures 2;
+use namespace::autoclean;
+
+use Debbugs::Config qw(:config);
+use Debbugs::Versions;
+use Carp;
+
+extends 'Debbugs::OOBase';
+
+has _versions => (is => 'bare',
+ isa => 'Debbugs::Versions',
+ default => sub {Debbugs::Versions->new(\&Debbugs::Versions::Dpkg::vercmp)},
+ handles => {_isancestor => 'isancestor',
+ _load => 'load',
+ _buggy => 'buggy',
+ _allstates => 'allstates',
+ },
+ );
+
+has loaded_src_pkg => (is => 'bare',
+ isa => 'HashRef[Bool]',
+ default => sub {{}},
+ traits => ['Hash'],
+ handles => {src_pkg_loaded => 'exists',
+ _set_src_pkg_loaded => 'set',
+ },
+ );
+
+sub _srcify_version {
+ my @return;
+ for my $v (@_) {
+ if (ref($_)) {
+ push @return,
+ $v->source_version->src_pkg_ver;
+ } else {
+ push @return,
+ $v;
+ }
+ }
+ return @_ > 1?@return:$return[0];
+}
+
+sub isancestor {
+ my ($self,$ancestor,$descendant) = @_;
+ return $self->_isancestor(_srcify_version($ancestor),
+ _srcify_version($descendant),
+ );
+}
+
+sub buggy {
+ my $self = shift;
+ my ($version,$found,$fixed) = @_;
+ ($version) = _srcify_version($version);
+ $found = [_srcify_version(@{$found})];
+ $fixed = [_srcify_version(@{$fixed})];
+ return $self->_buggy($version,$found,$fixed);
+}
+
+sub allstates {
+ my $self = shift;
+ my $found = shift;
+ my $fixed = shift;
+ my $interested = shift;
+ return $self->_allstates([_srcify_version(@{$found})],
+ [_srcify_version(@{$fixed})],
+ [_srcify_version(@{$interested})],
+ );
+}
+
+sub load {
+ my $self = shift;
+ for my $src_pkg (@_) {
+ my $is_valid = 0;
+ if (ref($src_pkg)) {
+ $is_valid = $src_pkg->valid;
+ $src_pkg = $src_pkg->name;
+ }
+ next if $self->src_pkg_loaded($src_pkg);
+ my $srchash = substr $src_pkg, 0, 1;
+ my $version_fh;
+ open($version_fh,'<',"$config{version_packages_dir}/$srchash/$src_pkg");
+ if (not defined $version_fh) {
+ carp "No version file for package $src_pkg" if $is_valid;
+ next;
+ }
+ $self->_load($version_fh);
+ $self->_set_src_pkg_loaded($src_pkg,1);
+ }
+}
+
+__PACKAGE__->meta->make_immutable;
+no Mouse;
+1;
+
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
use Debbugs::Log::Spam;
use Debbugs::CGI qw(:url :html :util :cache :usertags);
use Debbugs::CGI::Bugreport qw(:all);
-use Debbugs::Common qw(buglog getmaintainers make_list bug_status);
-use Debbugs::Packages qw(getpkgsrc);
+use Debbugs::Common qw(buglog getmaintainers make_list bug_status package_maintainer);
+use Debbugs::Packages qw(binary_to_source);
use Debbugs::DB;
use Debbugs::Status qw(splitpackages split_status_fields get_bug_status isstrongseverity);
+use Debbugs::Bug;
use Scalar::Util qw(looks_like_number);
use List::AllUtils qw(max);
my $s;
+my @schema_arg = ();
if (defined $config{database}) {
$s = Debbugs::DB->connect($config{database}) or
- die "Unable to connect to database";
+ die "Unable to connect to DB";
+ @schema_arg = ('schema',$s);
}
use CGI::Simple;
-my $q = new CGI::Simple;
+my $q = CGI::Simple->new();
# STDOUT should be using the utf8 io layer
binmode(STDOUT,':raw:encoding(UTF-8)');
}
}
+my $bug = Debbugs::Bug->new(bug => $ref,
+ @schema_arg,
+ );
+
my %status;
if ($need_status) {
%status = %{split_status_fields(get_bug_status(bug=>$ref,
bugusertags => \%bugusertags,
- defined $s?(schema => $s):(),
+ @schema_arg,
))}
}
my @records;
-my $spam;
eval{
- @records = read_log_records(bug_num => $ref,inner_file => 1);
- $spam = Debbugs::Log::Spam->new(bug_num => $ref);
+ @records = $bug->log_records();
};
if ($@) {
quitcgi("Bad bug log for $gBug $ref. Unable to read records: $@");
next if not $boring and not $record->{type} eq $wanted_type and not $record_wanted_anyway and @records > 1;
$seen_message_ids{$msg_id} = 1 if defined $msg_id;
# skip spam messages if we're outputting more than one message
- next if @records > 1 and $spam->is_spam($msg_id);
+ next if @records > 1 and $bug->is_spam($msg_id);
my @lines;
if ($record->{inner_file}) {
push @lines, scalar $record->{fh}->getline;
terse => $terse,
# if we're only looking at one record, allow
# spam to be output
- spam => (@records > 1)?$spam:undef,
+ spam => (@records > 1)?$bug:undef,
);
}
}
# All of the below should be turned into a template
-my %maintainer = %{getmaintainers()};
-my %pkgsrc = %{getpkgsrc()};
-
my $indexentry;
my $showseverity;
-my $tpack;
-my $tmain;
-
-my $dtime = strftime "%a, %e %b %Y %T UTC", gmtime;
-
unless (%status) {
no_such_bug($q,$ref);
}
-#$|=1;
-
-
my @packages = make_list($status{package});
-my %packages_affects;
-for my $p_a (qw(package affects)) {
- foreach my $pkg (make_list($status{$p_a})) {
- if ($pkg =~ /^src\:/) {
- my ($srcpkg) = $pkg =~ /^src:(.*)/;
- my @maint = package_maintainer(source => $srcpkg,
- @schema_arg,
- );
- $packages_affects{$p_a}{$pkg} =
- {maintainer => @maint?\@maint : ['(unknown)'],
- source => $srcpkg,
- package => $pkg,
- is_source => 1,
- };
- }
- else {
- my @maint = package_maintainer(binary => $pkg,
- @schema_arg,
- );
- my $source =
- binary_to_source(binary => $pkg,
- source_only => 1,
- scalar_only => 1,
- @schema_arg,
- );
- $packages_affects{$p_a}{$pkg} =
- {maintainer => @maint?\@maint : '(unknown)',
- length($source)?(source => $source):(),
- package => $pkg,
- };
- }
- }
-}
-
-# fixup various bits of the status
-$status{tags_array} = [sort(make_list($status{tags}))];
-$status{date_text} = strftime('%a, %e %b %Y %T UTC', gmtime($status{date}));
-$status{mergedwith_array} = [make_list($status{mergedwith})];
-
-
-my $version_graph = '';
-if (@{$status{found_versions}} or @{$status{fixed_versions}}) {
- $version_graph = q(<a href=").
- html_escape(version_url(package => $status{package},
- found => $status{found_versions},
- fixed => $status{fixed_versions},
- )
- ).
- q("><img alt="version graph" src=").
- html_escape(version_url(package => $status{package},
- found => $status{found_versions},
- fixed => $status{fixed_versions},
- width => 2,
- height => 2,
- )
- ).
- qq{"></a>};
-}
-
-
-
-my @blockedby= make_list($status{blockedby});
-$status{blockedby_array} = [];
-if (@blockedby && $status{"pending"} ne 'fixed' && ! length($status{done})) {
- for my $b (@blockedby) {
- my %s = %{get_bug_status($b)};
- next if (defined $s{pending} and
- $s{"pending"} eq 'fixed') or
- length $s{done};
- push @{$status{blockedby_array}},{bug_num => $b, subject => $s{subject}, status => \%s};
- }
-}
-
-my @blocks= make_list($status{blocks});
-$status{blocks_array} = [];
-if (@blocks && $status{"pending"} ne 'fixed' && ! length($status{done})) {
- for my $b (@blocks) {
- my %s = %{get_bug_status($b)};
- next if $s{"pending"} eq 'fixed' || length $s{done};
- push @{$status{blocks_array}}, {bug_num => $b, subject => $s{subject}, status => \%s};
- }
-}
-
-if ($buglog !~ m#^\Q$gSpoolDir/db#) {
- $status{archived} = 1;
-}
-
-my $descriptivehead = $indexentry;
-
print $q->header(-type => "text/html",
-charset => 'utf-8',
-cache_control => 'public, max-age=300',
);
print fill_in_template(template => 'cgi/bugreport',
- variables => {status => \%status,
- package => $packages_affects{'package'},
- affects => $packages_affects{'affects'},
+ variables => {bug => $bug,
log => $log,
- bug_num => $ref,
- version_graph => $version_graph,
msg => $msg,
isstrongseverity => \&Debbugs::Status::isstrongseverity,
html_escape => \&Debbugs::CGI::html_escape,
# if the first directory in @INC is not an absolute directory, assume that
# someone has overridden us via -I.
if ($INC[0] !~ /^\//) {
+ undef $debbugs_dir;
}
}
use if defined $debbugs_dir, lib => $debbugs_dir;
use Debbugs::Bugs qw(get_bugs bug_filter newest_bug);
use Debbugs::Packages qw(source_to_binary binary_to_source get_versions);
+use Debbugs::Collection::Bug;
use Debbugs::Status qw(splitpackages);
my %ut;
my %seen_users;
+my @users;
for my $user (map {split /[\s*,\s*]+/} make_list($param{users}||[])) {
next unless length($user);
+ push @users, $user;
add_user($user,\%ut,\%bugusertags,\%seen_users,\%cats,\%hidden);
}
Debbugs::User::read_usertags(\%select_ut, $u);
unless (defined $t && $t ne "") {
$t = join(",", keys(%select_ut));
- }
+ }
+ push @users,$u;
add_user($u,\%ut,\%bugusertags,\%seen_users,\%cats,\%hidden);
push @{$param{tag}}, split /,/, $t;
}
}
for my $package (@possible_packages) {
next unless defined $package and length $package;
+ push @users,
+ $package.'@'.$config{usertag_package_domain};
add_user($package.'@'.$config{usertag_package_domain},
\%ut,\%bugusertags,\%seen_users,\%cats,\%hidden);
}
@bugs{@bugs} = @bugs;
@bugs = keys %bugs;
-my $result = pkg_htmlizebugs(bugs => \@bugs,
+my $bugs = Debbugs::Collection::Bug->
+ new(bugs => \@bugs,
+ @schema_arg,
+ users => [map {my $u = Debbugs::User->new($_);
+ $u->has_bug_tags()?($u):()
+ } @users],
+ );
+
+$bugs->load_related_packages_and_versions();
+
+my $result = pkg_htmlizebugs(bugs => $bugs,
names => \@names,
title => \@title,
order => \@order,
libdbix-class-timestamp-perl,
libdbix-class-deploymenthandler-perl,
libdatetime-format-mail-perl,
+ libdatetime-perl,
libaliased-perl,
postgresql,
postgresql-9.6-debversion|postgresql-10-debversion,
libtext-xslate-perl, graphviz, libtext-iconv-perl, libnet-server-perl,
+ libmouse-perl, libmousex-nativetraits-perl,
# used to make the logo
inkscape
Homepage: https://salsa.debian.org/debbugs-team
libcgi-simple-perl, libparams-validate-perl, libtext-xslate-perl,
libmail-rfc822-address-perl, liblist-allutils-perl,
graphviz, libtext-iconv-perl, libuser-perl,
+ libmouse-perl, libmousex-nativetraits-perl,
# used by Debbugs::Libravatar and libravatar.cgi
libfile-libmagic-perl, libgravatar-url-perl, libwww-perl, imagemagick
# used by the database
libdbix-class-timestamp-perl,
libdbix-class-deploymenthandler-perl,
+ libdatetime-perl,
libaliased-perl,
libdatetime-format-mail-perl, libdbix-class-perl, libdatetime-format-pg-perl
Section: perl
bin_pkg INT NOT NULL REFERENCES bin_pkg ON UPDATE CASCADE ON DELETE CASCADE
);
CREATE UNIQUE INDEX bug_binpackage_id_pkg ON bug_binpackage(bug,bin_pkg);
+CREATE UNIQUE INDEX bug_binpackage_bin_pkg_bug_idx ON bug_binpackage(bin_pkg,bug);
INSERT INTO table_comments VALUES ('bug_binpackage','Bug <-> binary package mapping');
INSERT INTO column_comments VALUES ('bug_binpackage','bug','Bug id (matches bug)');
INSERT INTO column_comments VALUES ('bug_binpackage','bin_pkg','Binary package id (matches bin_pkg)');
JOIN src_pkg sp ON bsp.src_pkg=sp.id
WHERE bsp.bug=b.id) AS affects
) AS affects,
+ (SELECT msgid FROM message m LEFT JOIN bug_message bm ON bm.message=m.id
+ WHERE bm.bug=b.id ORDER BY m.sent_date ASC limit 1) AS message_id,
b.submitter_full AS originator,
EXTRACT(EPOCH FROM b.log_modified) AS log_modified,
EXTRACT(EPOCH FROM b.creation) AS date,
+++ /dev/null
-# -*- mode: cperl;-*-
-
-use Test::More;
-
-use warnings;
-use strict;
-
-plan tests => 4;
-
-use_ok('Debbugs::CGI::Pkgreport');
-
-my @usertags = ('severity=serious,severity=grave,severity=critical',
- 'tag=second',
- 'tag=third',
- '',
- );
-
-my @bugs =
- ({severity => 'normal',
- tags => 'wrongtag',
- order => 3,
- },
- {severity => 'critical',
- tags => 'second',
- order => 0,
- },
- {severity => 'normal',
- tags => 'third',
- order => 2,
- },
- );
-
-for my $bug (@bugs) {
- my $order = Debbugs::CGI::Pkgreport::get_bug_order_index(\@usertags,$bug);
- ok($order == $bug->{order},
- "order $bug->{order} == $order",
- );
-}
-
-
--- /dev/null
+# -*- mode: cperl;-*-
+
+use Test::More;
+
+use warnings;
+use strict;
+
+# Here, we're going to shoot messages through a set of things that can
+# happen.
+
+# First, we're going to send mesages to receive.
+# To do so, we'll first send a message to submit,
+# then send messages to the newly created bugnumber.
+
+use IO::File;
+use File::Temp qw(tempdir);
+use Cwd qw(getcwd);
+use Debbugs::MIME qw(create_mime_message);
+use File::Basename qw(dirname basename);
+use Test::WWW::Mechanize;
+use HTTP::Status qw(RC_NOT_MODIFIED);
+# The test functions are placed here to make things easier
+use lib qw(t/lib);
+use DebbugsTest qw(:all);
+
+# This must happen before anything is used, otherwise Debbugs::Config will be
+# set to wrong values.
+my %config = create_debbugs_configuration();
+
+my $tests = 0;
+use_ok('Debbugs::Bug');
+$tests++;
+use_ok('Debbugs::Collection::Bug');
+$tests++;
+
+# create 4 bugs
+for (1..4) {
+ submit_bug(subject => 'Submitting a bug '.$_,
+ pseudoheaders => {Severity => 'normal',
+ Tags => 'wontfix moreinfo',
+ },
+ );
+}
+run_processall();
+
+my $bc = Debbugs::Collection::Bug->new(bugs => [1..4]);
+
+my $bug;
+ok($bug = $bc->get(1),
+ "Created a bug correctly"
+ );
+$tests++;
+
+ok(!$bug->archiveable,
+ "Newly created bugs are not archiveable"
+ );
+$tests++;
+
+is($bug->submitter->email,'foo@bugs.something',
+ "Submitter works"
+ );
+$tests++;
+
+ok($bug->tags->tag_is_set('wontfix'),
+ "Wontfix tag set"
+ );
+$tests++;
+
+is($bug->tags->as_string(),
+ 'moreinfo wontfix',
+ "as_string works"
+ );
+$tests++;
+
+### run some tests with the database creation
+
+## create the database
+my $pgsql = create_postgresql_database();
+update_postgresql_database($pgsql);
+
+use_ok('Debbugs::DB');
+$tests++;
+my $s;
+ok($s = Debbugs::DB->connect($pgsql->dsn),
+ "Able to connect to database");
+$tests++;
+
+$bc = Debbugs::Collection::Bug->new(bugs => [1..4],
+ schema => $s);
+ok($bug = $bc->get(1),
+ "Created a bug correctly with DB"
+ );
+$tests++;
+
+done_testing($tests);
+
}
}
$prog_bar->target($tot) if $prog_bar;
-use Data::Printer;
-p %s_di;
my $i = 0;
my $avg_pkgs = 0;
my $tot_suites = scalar keys %s_p;
use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
use base qw(Exporter);
+use v5.10;
+
use IO::File;
use File::Temp qw(tempdir);
use Cwd qw(getcwd);
$DEBUG = 0 unless defined $DEBUG;
@EXPORT = ();
- %EXPORT_TAGS = (configuration => [qw(dirsize create_debbugs_configuration send_message)],
+ %EXPORT_TAGS = (configuration => [qw(dirsize create_debbugs_configuration send_message),
+ qw(submit_bug run_processall)],
mail => [qw(num_messages_sent)],
control => [qw(test_control_commands)],
database => [qw(create_postgresql_database update_postgresql_database)]
}
# now we should run processall to see if the message gets processed
if ($param{run_processall}) {
- system('scripts/processall') == 0 or die "processall failed";
+ run_processall();
}
return 1;
}
+sub run_processall {
+ system('scripts/processall') == 0 or die "processall failed";
+}
+
=item test_control_commands
test_control_commands(\%config,
}
}
+sub submit_bug {
+ state $spec =
+ {subject => {type => SCALAR,
+ default => 'Submitting a bug',
+ },
+ body => {type => SCALAR,
+ default => 'This is a silly bug',
+ },
+ submitter => {type => SCALAR,
+ default => 'foo@bugs.something',
+ },
+ pseudoheaders => {type => HASHREF,
+ default => sub {{}},
+ },
+ package => {type => SCALAR,
+ default => 'foo',
+ },
+ run_processall => {type => SCALAR,
+ default => 0,
+ },
+ };
+ my %param =
+ validate_with(params => \@_,
+ spec => $spec);
+ my $body = 'Package: '.$param{package}."\n";
+ foreach my $key (keys %{$param{pseudoheaders}}) {
+ for my $val (ref($param{pseudoheaders}{$key}) ?
+ @{$param{pseudoheaders}{$key}} :
+ $param{pseudoheaders}{$key}) {
+ $body .= $key. ': '.$val."\n";
+ }
+ }
+ $body .="\n".$param{body};
+ send_message(to => 'submit@bugs.something',
+ headers => [To => 'submit@bugs.something',
+ From => $param{submitter},
+ Subject => $param{subject},
+ ],
+ run_processall => $param{run_processall},
+ body => $body
+ );
+}
+
{
package DebbugsTest::HTTPServer;
-<: include "html/pre_title.tx" :>#<: $bug_num :> - <: $status.subject :> - <: $config.project :> <: $config.bug :> report logs<: include "html/post_title.tx" :>
-<link rel="canonical" href="<: bug_links(bug=>$bug_num,links_only=>1) :>">
+<: include "html/pre_title.tx" :>#<: $bug.id :> - <: $bug.subject :> - <: $config.project :> <: $config.bug :> report logs<: include "html/post_title.tx" :>
+<link rel="canonical" href="<: $bug.url :>">
<script type="text/javascript">
<!--
function toggle_infmessages()
</head>
<body>
<div class="debbugs_install"><: $config.project :> <: $config.bug :> report logs</div>
- <h1 class="bug_header"><a class="bug_email" href="mailto:<: $bug_num :>@<: $config.email_domain :>">#<: $bug_num :></a>
- <span class="bug_subject"><: $status.subject :></span>
+ <h1 class="bug_header"><a class="bug_email" href="mailto:<: $bug.id :>@<: $config.email_domain :>">#<: $bug.id :></a>
+ <span class="bug_subject"><: $bug.subject :></span>
</h1>
-<div class="versiongraph"><: raw($version_graph) :></div>
+: if $bug.has_found or $bug.has_fixed {
+ <div class="versiongraph">
+ <a href="<: $bug.version_url :>">
+ <img alt="version graph"
+ src="<: $bug.version_url("width",2,"height",2) :>">
+ </a></div>
+: }
<: include "cgi/bugreport_pkginfo.tx" :>
<: include "cgi/bugreport_buginfo.tx" :>
<div class="bugreport_operations">
: if looks_like_number($msg) {
- <span><a href="<: bug_links(bug => $bug_num, links_only => 1) :>">Full log</a></span>
+ <span><a href="<: $bug.url :>">Full log</a></span>
: } else {
: if ! $status.archived {
-<span><a href="mailto:<: $bug_num :>@<: $config.email_domain :>">Reply</a>
-or <a href="mailto:<: $bug_num :>-subscribe@<: $config.email_domain :>">subscribe</a>
+<span><a href="mailto:<: $bug.email :>">Reply</a>
+or <a href="mailto:<: $bug.subscribe_email :>">subscribe</a>
to this <: $config.bug :>.</span>
: }
<span>View this <: $config.bug :> as an
-<a href="<: bug_links("bug",$bug_num,links_only=>1,options=>{mbox=>"yes"}) :>">mbox</a>,
-<a href="<: bug_links("bug",$bug_num,links_only=>1,options=>{mbox=>"yes",mboxstatus => "yes"}) :>">status mbox</a>, or
-<a href="<: bug_links("bug",$bug_num,links_only=>1,options=>{mbox=>"yes",mboxmaint => "yes"}) :>">maintainer mbox</a>
+ <a href="<: $bug.mbox_url :>">mbox</a>,
+ <a href="<: $bug.mbox_status_url :>">status mbox</a>, or
+ <a href="<: $bug.mbox_maint_url :>">maintainer mbox</a>
</span>
</div>
: }
<div class="buginfo">
<ul>
<li><span class="key">Reported by</span>
- <span class="value"><: package_links(submitter=>$status.originator) :></span>
+ <span class="value"><a href="<: $bug.submitter_url :>"><: $bug.submitter.name :></a></span>
</li>
<li><span class="key">Date</span>
- <span class="value"><: $status.date_text :></span>
+ <span class="value"><: $bug.created :></span>
</li>
- : if defined($status.owner) && $status.owner.length() {
+ : if $bug.has_owner {
<li><span class="key">Owned by</span>
- <span class="value"><: package_links("owner",$status.owner) :></span>
+ <span class="value"><a href="<: $bug.owner_url :>"><: $bug.owner.name :></a></span>
</li>
: }
<li><span class="key">Severity</span>
<span class="value">
- <:- if $status.severity { :><em class="severity"><: } -:>
- <:- $status.severity -:>
- <:- if $status.severity { :></em><: } -:>
+ <:- if $bug.severity { :><em class="severity"><: } -:>
+ <:- $bug.severity -:>
+ <:- if $bug.severity { :></em><: } -:>
</span>
</li>
- : if $status.tags_array {
+ : if $bug.tags.has_any_tags {
<li><span class="key">Tags</span>
- <span class="value"><: $status.tags_array.join(' ') :></span>
+ <span class="value"><: $bug.tags.as_string :></span>
</li>
: }
- : if $status.mergedwith_array.count > 0 {
+ : if $bug.mergedwith.count > 0 {
<li><span class="key">Merged with</span>
- <span class="value"><: bug_links(bug=>$status.mergedwith_array).join(",\n") :></span>
+ <span class="value"><: bug_links(bug=>$bug.mergedwith).join(",\n") :></span>
</li>
: }
- : if $status.found_versions.count {
+ : if $bug.has_found {
<li><span class="key">Found in
- version<:- if $status.found_versions.count > 1 { -:>s<: } -:></span>
- <span class="value"><: $status.found_versions.join(', ') :></span>
+ version<:- if $bug.found.count > 1 { -:>s<: } -:></span>
+ <span class="value"><: $bug.found.join(', ') :></span>
</li>
: }
- : if $status.fixed_versions.count {
+ : if $bug.has_fixed {
<li><span class="key">Fixed in
- version<: if $status.fixed_versions.count > 1 { :>s<: } :></span>
- <span class="value"><: $status.fixed_versions.join(', ') :></span>
+ version<: if $bug.fixed.count > 1 { :>s<: } :></span>
+ <span class="value"><: $bug.fixed.join(', ') :></span>
</li>
: }
- <: if $status.done.length() { :>
+ <: if $bug.is_done { :>
<li><span class="key">Done</span>
- <span class="value"><: $status.done :></span>
+ <span class="value"><a href="<: $bug.done.url :>"><: $bug.done.name :></a></span>
</li>
: }
- : if $status.blockedby_array.count {
+ : if $bug.blocked_by.count {
<li><span class="key">Fix blocked by</span>
<span class="value">
- : for $status.blockedby_array -> $bug {
+ : for $bug.blockedby_array -> $bug {
<: bug_links("bug",$bug.bug_num) :>: <: $bug.subject -:>
<:- if !$~bug.is_last { :>, <: } else { :>.<: } :>
: }
</span>
</li>
: }
- : if $status.blocks_array.count {
+ : if $bug.blocks.count {
<li><span class="key">Blocking fix for</span>
<span class="value"
- : for $status.blocks_array -> $bug {
+ : for $bug.blocks_array -> $bug {
<: bug_links("bug",$bug.bug_num) :>: <: $bug.subject -:>
<:- if ! $~bug.is_last { :>, <: } else { :>.<: } :>
: }
</span>
</li>
: }
- : if $status.archived {
+ : if $bug.archived {
<li><span class="key">Bug is</span>
<span class="value">Archived</span>
</li>
: }
- : if defined $status.forwarded and $status.forwarded.length() {
+ : if defined $bug.forwarded and $bug.forwarded.length() {
<li><span class="key">Forwarded to</span>
- <span class="value"><: split($status.forwarded,',\s+').map(maybelink).join(', ') :></span>
+ <span class="value"><: split($bug.forwarded,',\s+').map(maybelink).join(', ') :></span>
</li>
: }
- : if defined $status.summary and $status.summary.length() {
+ : if defined $bug.summary and $bug.summary.length() {
<li><span class="key">Summary</span>
- <span class="value"><: $status.summary :></span>
+ <span class="value"><: $bug.summary :></span>
</li>
: }
- : if defined $status.outlook and $status.outlook.length() {
+ : if defined $bug.outlook and $bug.outlook.length() {
<li><span class="key">Outlook</span>
- <span class="value"><: $status.outlook :></span>
+ <span class="value"><: $bug.outlook :></span>
</li>
: }
</ul>
,
: } } }
<div class="pkginfo">
- <p>Package<: if ($package.keys.count > 1) {:>s<: } :>
- <: link_to_package($package) :>
-: for $package.values() -> $pkg {
-<p>Maintainer for <: package_links($pkg.is_source ? "source": "package",$pkg.is_source ? $pkg.source : $pkg.package ) :> is <: package_links(maintainer => $pkg.maintainer) :>;
-<: if defined($pkg.source) && not $pkg.is_source { :>
-Source for <: package_links(package => $pkg.package) :> is
-<: package_links(source => $pkg.source) :>.
-<: } :></p>
+ <table><th>Package</th><th>Source(s)</th><th></th><th>Maintainer(s)</th>
+: for $bug.packages.members_ref -> $pkg {
+ <tr>
+ <td><a href="<: $pkg.url :>"><: $pkg.name :></a></td>
+ <td>
+: for $pkg.sources.members_ref -> $src {
+ <a href="<: $src.url :>"><: $src.name :></a>
+ <:- if ! $~src.is_last { :>, <: } -:>
: }
+ </td>
+ <td><a href="https://tracker.debian.org/<:$pkg.name:>">PTS</a>
+ <a href="https://buildd.debian.org/<:$pkg.name:>">Buildd</a>
+ <a href="https://qa.debian.org/popcon.php?package=<:$pkg.name:>">Popcon</a>
+ </td>
+ <td>
+: for $pkg.maintainers.members_ref -> $maint {
+ <a href="<: $maint.maintainer_url :>"><: $maint.name :></a>
+ <:- if ! $~maint.is_last { :>, <: } -:>
+: }
+ </td>
+ </tr>
+: }
+ </table>
: if $affects.keys.size > 0 {
<p>Affects: <: link_to_package($affects) :>
</p>
+<:- macro bug_url_subject->($bug) {-:>
+<a href="<: $bug.url :>"<:$bug.is_done?' style="text-decoration:line-through"':'':>>#
+ <:- $bug.bug :>: <: $bug.subject :></a>
+<:- } -:>
<div class="shortbugstatus">
- <a href="<: bug_links(bug=>$status.bug_num,links_only=>1):>"<:length($status.done)?' style="text-decoration:line-through"':'':>>#<: $status.bug_num :></a>
- [<font face="fixed"><span class="link" onclick="javascript:extra_status_visible(<: $status.bug_num :>)"><abbr title="<: $status.severity :>">
- <:- my $short_sev = substr($status.severity,0,1) -:>
- <:- if isstrongseverity($status.severity) { -:><em class="severity"><: uc($short_sev) :></em>
- <:- } else { -:>
- <:- $short_sev } -:></abbr>|
- <:- for $status.tags_array -> $tag { -:>
- <:- if defined($config.tags_single_letter[$tag]) { -:>
- <abbr title="<: $tag :>"><: $config.tags_single_letter[$tag] :></abbr><:- } -:>
- : }
- <:- if $status.tags_array.size() == 0 { -:> <: } :>|
- <:- if $status.mergedwith_array.size() > 0 { -:>
- <abbr title="merged">=</abbr>
- <:- } -:>
- <:- if $status.fixed_versions.size() > 0 { -:>
- <abbr title="fixed versions">☺</abbr>
- <:- } -:>
- <:- if $status.fixed_versions.size() > 0 { -:>
- <abbr title="fixed versions">☺</abbr>
- <:- } -:>
- <:- if $status.blockedby_array.size() > 0 { -:>
- <abbr title="blocked by">♙</abbr>
- <:- } -:>
- <:- if $status.blocks_array.size() > 0 { -:>
- <abbr title="blocks">♔</abbr>
- <:- } -:>
- <:- if length($status.forwarded) { -:>
- <abbr title="forwarded">↝</abbr>
- <:- } -:>
- <:- if $status.archived { -:>
- <abbr title="archived">♲</abbr>
- <:- } -:>
- <:- if length($status.affects) { -:>
- <abbr title="affects">☣</abbr>
- <:- } -:></span></font>]
- [<: raw(package_links(package=>$status.package.split(','),class=>"submitter")) :>]
- <a href="<: bug_links(bug=>$status.bug_num,links_only=>1) :>"><: $status.subject :></a>
- <div id="extra_status_<: $status.bug_num :>" class="shortbugstatusextra">
- <span>Reported by: <: raw(package_links(submitter=>$status.originator)) :>;</span>
- <span>Date: <: $status.date_text :>;</span>
- <:- if (defined $status.owner and length($status.owner)) { -:>
- <span>Owned by: <: raw(package_links(owner=>$status.owner)) :>;</span>
+ <a href="<: $bug.url :>"<:$bug.is_done?' style="text-decoration:line-through"':'':>>#<: $bug.bug :></a>
+ [<font face="fixed"><span class="link" onclick="javascript:extra_status_visible(<: $bug.bug :>)"><abbr title="<: $bug.severity :>">
+ <:- if $bug.strong_severity { -:><em class="severity"><: $bug.short_severity :></em>
+ <:- } else { -:>
+ <:- $bug.short_severity } -:></abbr>|
+ <:- for $bug.tags.short_tags -> $tag { -:>
+ <abbr title="<: $tag.long :>"><: $tag.short :></abbr>
+ <:- } else { -:> <: } :>|
+ <:- if $bug.is_merged > 0 { -:>
+ <abbr title="merged">=</abbr>
+ <:- } -:>
+ <:- if $bug.has_fixed { -:>
+ <abbr title="fixed versions">☺</abbr>
+ <:- } -:>
+ <:- if $bug.is_blocked { -:>
+ <abbr title="blocked by">♙</abbr>
+ <:- } -:>
+ <:- if $bug.is_blocking { -:>
+ <abbr title="blocks">♔</abbr>
+ <:- } -:>
+ <:- if $bug.is_forwarded { -:>
+ <abbr title="forwarded">↝</abbr>
+ <:- } -:>
+ <:- if $bug.archived { -:>
+ <abbr title="archived">♲</abbr>
+ <:- } -:>
+ <:- if $bug.is_affecting { -:>
+ <abbr title="affects">☣</abbr>
+ <:- } -:></span></font>]
+ [<: for $bug.packages.members_ref -> $package { -:>
+ <a href="<: $package.url :>"><: $package.name :></a>
+ <:- if ! $~package.is_last { -:>, <: } else if ! $~package.is_first { -:>.<:- } -:>
+ <:- } :>]
+ <a href="<: $bug.url :>"><: $bug.subject :></a>
+ <div id="extra_status_<: $bug.bug :>" class="shortbugstatusextra">
+ <table class="extra_status">
+ <tr><td>Reported by</td><td><a href="<: $bug.submitter_url :>"><: $bug.submitter.name :></a></td></tr>
+ <tr><td>Date</td><td><: $bug.created.iso8601 :></td></tr>
+ <:- if $bug.is_owned { -:>
+ <tr><td>Owned by</td><td><a href="<: $bug.owner_url :>"><: $bug.owner.name :></a></td></tr>
<:- } :>
- <span>Severity:
- <:- if (isstrongseverity($status.severity)) { -:>
- <em class="severity">)<: $status.severity :></em>
+ <tr><td>Severity</td><td>
+ <: if $bug.strong_severity { -:>
+ <em class="severity"><: $bug.severity :></em>
<:- } else { -:>
- <: $status.severity :>
- <:- } -:></span>
- <span>
- <:- if $status.tags_array.size > 0 { -:>
- Tags: <: $status.tags_array.join(', ') :>;
+ <: $bug.severity :>
+ <:- } -:></td></tr>
+ <:- if $bug.tags.has_any_tags { -:>
+ <tr><td>Tags</td><td>
+ : if $bug.tags.has_tags {
+ <span class="tags"><: $bug.tags.join_tags(', ') :></span>
+ : }
+ <: if $bug.tags.has_usertags {
+ if $bug.tags.has_tags { :>, <: } -:>
+ <span class="usertags"><: $bug.tags.join_usertags(', ') :></span>
+ <:- } -:>
+ </td></tr>
+ <: } :>
+ <:- if $bug.is_merged > 0 { -:>
+ <tr><td>Merged with </td><td>
+ <: for $bug.mergedwith.members_ref -> $bug { -:>
+ <:- bug_url_subject($bug) -:>
+ <:- if ! $~bug.is_last {-:>, <: } else { -:>.<:- } -:>
<:- } -:>
- </span>
- : if $status.mergedwith_array.size > 0 {
- <span>Merged with <: bug_links(bug=>$status.mergedwith_array).join(",\n") :>;</span>
- : }
- : if $status.found_versions.size > 0 or $status.fixed_versions.size > 0 {
- <a href="<:
- version_url(package => $status.package,
- found => $status.found_versions,
- fixed => $status.fixed_versions,
- ):>">
+ </td></tr>
<:- } -:>
- <:- if $status.found_versions.size > 0 { -:>
- <span>Found in version<: if $status.found_versions.size > 1 { :>s<: } :>
- <:- $status.found_versions.join(', ') -:>;
- </span>
+ <:- if $bug.has_found { -:>
+ <tr><td>Found in version<: if $bug.status.found_count > 1 { :>s<: } :></td>
+ <td><a href="<: $bug.version_url :>"><:- $bug.status.found_join(', ') -:></a></td></tr>
<:- } -:>
- <:- if $status.fixed_versions.size > 0 { :>
- <span>Fixed in version<: if $status.fixed_versions.size > 1 { :>s<: } :>
- <:- $status.fixed_versions.join(', ') -:>;
- </span>
+ <:- if $bug.has_fixed { :>
+ <tr><td>Fixed in version<: if $bug.status.fixed_count > 1 { :>s<: } :></td><td>
+ <a href="<: $bug.version_url :>"><:- $bug.status.fixed_join(', ') -:></a></td></tr>
<:- } -:>
- <:- if $status.found_versions.size > 0 or $status.fixed_versions.size > 0 { -:>
+ <:- if $bug.has_found or $bug.has_fixed { -:>
</a>
<:- } -:>
- <:- if (length($status.forwarded)) { :>
- <span><strong>Forwarded</strong> to
- <: $status.forwarded.split('\,\s+').map(maybelink).join(', ') :>
- </span>
+ <:- if $bug.is_forwarded { :>
+ <tr><td><strong>Forwarded</strong> to</td>
+ <td><: $bug.forwarded.split('\,\s+').map(maybelink).join(', ') :></td>
+ </tr>
<:- } -:>
- <:- if (length($status.done)) { -:>
- <span><strong>Done:</strong>
- <: $status.done :>
- </span>
+ <:- if $bug.is_done { -:>
+ <tr><td><strong>Done:</strong></td><td>
+ <: $bug.done.name :></td>
+ </tr>
<:- } -:>
- <:- if $status.archive_days >= 0 and
- defined($status.location) && $status.location != "archive" { -:>
- <span><strong>Can be archived
- <: if $status.archive_days == 0 { :>
+ <:- if not $bug.archived and $bug.when_archiveable >= 0 { -:>
+ <tr><td><strong>Can be archived</strong></td><td><strong>
+ <: if $bug.when_archiveable == 0 { :>
today
- <: } else if $status.archive_days == 1 { :>
+ <: } else if $bug.when_archiveable == 1 { :>
in 1 day
<: } else { :>
- in <: $status.archive_days :> days
- <:- } :>;</strong></span>
- <:- } else if defined($status.location) && $status.location == "archived" { -:>
- <span><strong>Archived</strong></span>
+ in <: $bug.when_archiveable :> days
+ <:- } :></strong></td></tr>
+ <:- } else if $bug.archived { -:>
+ <tr><td><strong>Archived</strong></td></tr>
<:- } -:>
- <:- if $status.blockedby_array.count > 0 { :>
- <span>Fix blocked by
- <: for $status.blockedby_array -> $bug { :>
- <: bug_links("bug",bug.bug_num) :>:
- <: $bug.subject -:>
+ <:- if $bug.is_blocked { :>
+ <tr><td>Fix blocked by</td><td>
+ <: for $bug.blocked_by -> $bug { :>
+ <: bug_url_subject($bug) :>
<:- if ! $~bug.is_last { -:>, <: } else { -:>.<:- } -:>
- <:- } -:>
- </span>
+ <:- } -:></td>
+ </tr>
<:- } -:>
- <:- if $status.blocks_array.count > 0 { :>
- <span>Blocking fix for
- <: for $status.blocks_array -> $bug { :>
- <: bug_links("bug",bug.bug_num) :>:
- <: $bug.subject -:>
+ <:- if $bug.blocks.count > 0 { :>
+ <tr><td>Blocking fix for</td><td>
+ <: for $bug.blocks -> $bug { :>
+ <: bug_url_subject($bug) :>
<:- if ! $~bug.is_last {-:>, <: } else { -:>.<:- } -:>
<:- } -:>
- </span>
+ </td></tr>
<:- } -:>
<:- macro days_ago->($what,$ago) {-:>
- <span>
+ <tr>
<:- if ($time - $ago) / 86400 > 60 { -:>
- <strong><: $what :> <: secs_to_english($time-$ago) :> ago.</strong>
+ <td class="ancient"><: $what :></td><td><: secs_to_english($time-$ago) :> ago.</td>
<:- } else if ($time - $ago) / 86400 > 30 { :>
- <strong><: $what :> <: secs_to_english($time-$ago) :> ago.</strong>
- <:- } -:>;
- </span>
+ <td class="old"><: $what :></td><td><: secs_to_english($time-$ago) :> ago.</td>
+ <:- } -:>
+ </tr>
<:- } -:>
- <: days_ago("Filed",$status.date) :>
- <: days_ago("Modified",$status.log_modified) :>
- <:- if defined $status.archived and $status.archived {:>
+ <: days_ago("Filed",$bug.created.epoch) :>
+ <: days_ago("Modified",$bug.modified.epoch) :>
+ </table>
+ <:- if $bug.archived {:>
<span>Bug is archived. No further changes may be made.</span>
<:- } -:>
</div>
projects / debbugs.git / commitdiff