X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FBug.pm;h=09c580d22a6adf77e8d4b20e6002823e0f576456;hb=19e289b4dd591ac7c757b3858a1771d4b80c41ff;hp=05d03acd9a13c4526d43172d70ab4bcb0ecc313b;hpb=0e16a5214d3617d0df54712869b2da0f3c64fcdb;p=debbugs.git

diff --git a/Debbugs/Bug.pm b/Debbugs/Bug.pm
index 05d03ac..09c580d 100644
--- a/Debbugs/Bug.pm
+++ b/Debbugs/Bug.pm
@@ -27,18 +27,25 @@ use namespace::clean;
 use v5.10; # for state
 
 use DateTime;
-use List::AllUtils qw(max);
+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}}};
 
@@ -46,22 +53,59 @@ 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 => 'HashRef',
+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;
-    $self->reset;
-    my $status = read_bug(bug=>$self->bug) or
-	confess("Unable to read bug ".$self->bug);
-    return $status;
+    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',
@@ -71,47 +115,35 @@ has 'package_collection' => (is => 'ro',
 			    );
 
 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();
 }
 
-
-sub reset {
-    my $self = shift;
-    $self->_clear_done();
-    $self->_clear_severity();
-    $self->_clear_packages();
-    $self->_clear_sources();
-    $self->_clear_affects();
-    $self->_clear_blocks();
-    $self->_clear_blockedby();
-    $self->_clear_found();
-    $self->_clear_fixed();
-    $self->_clear_mergedwith();
-    $self->_clear_pending();
-    $self->_clear_location();
-    $self->_clear_archived();
-    $self->_clear_archiveable();
-    $self->_clear_when_archiveable();
-    $self->_clear_submitter();
-    $self->_clear_created();
-    $self->_clear_modified();
-    $self->_set_saved(1);
-}
-
-sub _clear_saved_if_changed {
-    my ($self,$new,$old) = @_;
-    if (@_ > 2) {
-	if ($new ne $old) {
-	    $self->_set_saved(0);
-	}
-    }
+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
@@ -121,15 +153,14 @@ for my $attr (qw(packages affects sources)) {
 	 isa => 'Debbugs::Collection::Package',
 	 clearer => '_clear_'.$attr,
 	 builder => '_build_'.$attr,
-	 trigger => \&_clear_saved_if_changed,
 	 lazy => 1,
 	);
 }
 
 # bugs
-for my $attr (qw(blocks blockedby mergedwith)) {
+for my $attr (qw(blocks blocked_by mergedwith)) {
     has $attr =>
-	(is => 'bare',
+	(is => 'ro',
 	 isa => 'Debbugs::Collection::Bug',
 	 clearer => '_clear_'.$attr,
 	 builder => '_build_'.$attr,
@@ -139,30 +170,40 @@ for my $attr (qw(blocks blockedby mergedwith)) {
 }
 
 
-
-for my $attr (qw(done severity),
-	      qw(found fixed),
-	      qw(pending location submitter),
-	     ) {
-    has $attr =>
-	(is => 'rw',
-	 isa => 'Str',
-	 clearer => '_clear_'.$attr,
-	 builder => '_build_'.$attr,
-	 trigger => \&_clear_saved_if_changed,
-	 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 {
-    return length $_[0]->done?1:0;
-}
-sub _build_done {
-    return $_[0]->status->{done} // '';
-}
-
-sub _build_severity {
-    return $_[0]->status->{severity} // $config{default_severity};
+    my $self = shift;
+    return $self->has_done;
 }
 
 sub strong_severity {
@@ -170,88 +211,105 @@ sub strong_severity {
     return exists $strong_severities->{$self->severity};
 }
 
-sub package {
-    local $_;
-    return join(', ',map {$_->name} $_[0]->packages);
+sub short_severity {
+    $_[0]->severity =~ m/^(.)/;
+    return $1;
 }
 
 sub _build_packages {
-    return [$_[0]->package_collection->
-	    get_package($_[0]->status->{package} //
-			'')
-	   ];
+    my $self = shift;
+    return $self->package_collection->
+	    limit($self->status->package);
 }
 
-sub affect {
-    local $_;
-    return join(', ',map {$_->name} $_[0]->affects->members);
+sub is_affecting {
+    my $self = shift;
+    return $self->affects->count > 0;
 }
 
 sub _build_affects {
-    return [$_[0]->package_collection->
-	    get_package($_[0]->status->{affects} //
-			'')
-	   ];
-}
-sub source {
-    local $_;
-    return join(', ',map {$_->name} $_[0]->sources->members);
+    my $self = shift;
+    return $self->package_collection->
+	    limit($self->status->affects);
 }
 sub _build_sources {
-    local $_;
-    my @sources = map {$_->sources} $_[0]->packages;
+    my $self = shift;
+    return $self->packages->sources->clone;
 }
 
+sub is_owned {
+    my $self = shift;
+    return defined $self->owner;
+}
 
-sub _split_if_defined {
-    my ($self,$field,$split) = @_;
-    $split //= ' ';
-    my $e = $self->status->{$field};
-    my @f;
-    if (defined $e and
-	length $e) {
-	return split /$split/,$e;
-    }
-    return ();
+sub is_blocking {
+    my $self = shift;
+    return $self->blocks->count > 0;
 }
 
 sub _build_blocks {
     my $self = shift;
     return $self->bug_collection->
-	limit_or_create(sort {$a <=> $b}
-			$self->_split_if_defined('blocks'));
+	limit($self->status->blocks);
 }
 
-sub _build_blockedby {
+sub is_blocked {
+    my $self = shift;
+    return $self->blocked_by->count > 0;
+}
+
+sub _build_blocked_by {
     my $self = shift;
     return $self->bug_collection->
-	limit_or_create(sort {$a <=> $b}
-			$self->_split_if_defined('blockedby'));
+	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->sources->
-	versions($self->_split_if_defined('found',',\s*'));
+    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;
-    return $self->sources->
-	versions($self->_split_if_defined('fixed',',\s*'));
+    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_or_create(sort {$a <=> $b}
-			$self->_split_if_defined('mergedwith'));
-}
-sub _build_pending {
-    return $_[0]->status->{pending} // '';
-}
-sub _build_submitter {
-    return $_[0]->status->{originator} // '';
+	limit($self->status->mergedwith);
 }
 
 for my $attr (qw(created modified)) {
@@ -262,32 +320,51 @@ for my $attr (qw(created modified)) {
 }
 sub _build_created {
     return DateTime->
-	from_epoch(epoch => $_[0]->status->{date} // time);
+	from_epoch(epoch => $_[0]->status->date);
 }
 sub _build_modified {
     return DateTime->
-	from_epoch(epoch => max($_[0]->status->{log_modified},
-				$_[0]->status->{last_modified}
+	from_epoch(epoch => max($_[0]->status->log_modified,
+				$_[0]->status->last_modified
 			       ));
 }
-sub _build_location {
-    return $_[0]->status->{location};
-}
-has archived => (is => 'ro', isa => 'Bool',
-		 clearer => '_clear_archived',
-		 builder => '_build_archived',
-		 lazy => 1);
-sub _build_archived {
-    return $_[0]->location eq 'archived'?1:0;
-}
 
-has tags => (is => 'ro', isa => 'Object',
+has tags => (is => 'ro',
+             isa => 'Debbugs::Bug::Tag',
 	     clearer => '_clear_tags',
 	     builder => '_build_tags',
 	     lazy => 1,
 	    );
 sub _build_tags {
-    return Debbugs::Bug::Tag->new($_[0]->status->{keywords});
+    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;
 }
 
 =item buggy
@@ -307,21 +384,26 @@ sub buggy {
     my $self = shift;
     my $vertree =
 	$self->package_collection->
-	versions;
+	universe->versiontree;
     my $max_buggy = 'absent';
     for my $ver (@_) {
 	if (not ref($ver)) {
-	    $ver = Debbugs::Version->
-		new(string => $ver,
-		    package_collection => $self->package_collection,
-		   );
+            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->tree->
-	    buggy($ver->srcver,
-		  [map {$_->srcver} $self->found],
-		  [map {$_->srcver} $self->fixed]);
+	    $vertree->buggy($ver,
+                            [$self->found],
+                            [$self->fixed]);
 	if ($buggy eq 'found') {
 	    return 'found'
 	}
@@ -382,10 +464,10 @@ sub _populate_archiveable {
 	}
     }
     my $time = time;
-    state $remove_time = 24 * 60 * 60 * $config{removal_age};
+    state $remove_time = 24 * 60 * 60 * ($config{removal_age} // 30);
     # 4. Have been modified more than removal_age ago
     my $moded_ago =
-	$time - $self->last_modified;
+	$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) {
@@ -399,17 +481,18 @@ sub _populate_archiveable {
 	    @{$config{removal_strong_severity_default_distribution_tags}};
     }
     # 3. Have a maximum buggy of fixed
-    my $buggy = $self->buggy($self->package->
-			     dist_source_versions(@distributions));
+    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 = $time - $self->when_fixed(@distributions);
-    if ($fixed_ago < $remove_time) {
-	$self->_set_archiveable(0);
-    }
+    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) {
@@ -419,6 +502,178 @@ sub _populate_archiveable {
     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;
+    if (length($self->status->{package}//'')) {
+	@packages = split /,/,$self->status->{package}//'';
+    }
+    if (length($self->status->{affects}//'')) {
+	push @packages,
+            split /,/,$self->status->{affects}//'';
+    }
+    my @versions =
+        (@{$self->status->{found_versions}//[]},
+         @{$self->status->{fixed_versions}//[]});
+    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;