]> git.donarmstrong.com Git - debbugs.git/commitdiff
update OO interface to near-completion
authorDon Armstrong <don@donarmstrong.com>
Thu, 7 Jun 2018 22:32:40 +0000 (15:32 -0700)
committerDon Armstrong <don@donarmstrong.com>
Thu, 7 Jun 2018 22:33:35 +0000 (15:33 -0700)
Debbugs/Bug.pm
Debbugs/Bug/Tag.pm
Debbugs/Collection.pm
Debbugs/Collection/Bug.pm
Debbugs/Collection/Package.pm
cgi/pkgreport.cgi

index 05d03acd9a13c4526d43172d70ab4bcb0ecc313b..539e7589a4035160e3c6bd655c5bba0e57c0c28a 100644 (file)
@@ -27,16 +27,20 @@ use namespace::clean;
 use v5.10; # for state
 
 use DateTime;
-use List::AllUtils qw(max);
+use List::AllUtils qw(max first min);
 
+use Params::Validate qw(validate_with :types);
 use Debbugs::Config qw(:config);
 use Debbugs::Status qw(read_bug);
 use Debbugs::Bug::Tag;
 use Debbugs::Collection::Package;
 use Debbugs::Collection::Bug;
+use Debbugs::Collection::Correspondent;
 
 use Debbugs::OOTypes;
 
+use Carp;
+
 extends 'Debbugs::OOBase';
 
 state $strong_severities =
@@ -46,6 +50,10 @@ has bug => (is => 'ro', isa => 'Int',
            required => 1,
           );
 
+sub id {
+    return $_[0]->bug;
+}
+
 has saved => (is => 'ro', isa => 'Bool',
              default => 0,
              writer => '_set_saved',
@@ -71,16 +79,39 @@ 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();
 }
 
+has correspondent_collection =>
+    (is => 'ro',
+     isa => 'Debbugs::Collection::Correspondent',
+     builder => '_build_package_collection',
+     lazy => 1,
+    );
+sub _build_correspondent_collection   {
+    my $self = shift;
+    if ($self->has_schema) {
+        return Debbugs::Collection::Correspondent->new(schema => $self->schema);
+    }
+    return Debbugs::Collection::Correspondent->new();
+}
 
 sub reset {
     my $self = shift;
@@ -129,7 +160,7 @@ for my $attr (qw(packages affects sources)) {
 # bugs
 for my $attr (qw(blocks blockedby mergedwith)) {
     has $attr =>
-       (is => 'bare',
+       (is => 'ro',
         isa => 'Debbugs::Collection::Bug',
         clearer => '_clear_'.$attr,
         builder => '_build_'.$attr,
@@ -139,10 +170,34 @@ for my $attr (qw(blocks blockedby mergedwith)) {
 }
 
 
+for my $attr (qw(owner submitter)) {
+    has $attr.'_corr' =>
+        (is => 'ro',
+         isa => 'Debbugs::Correspondent',
+         lazy => 1,
+         builder => '_build_'.$attr.'_corr',
+         clearer => '_clear_'.$attr.'_corr',
+         handles => {$attr.'_url' => $attr.'_url',
+                     $attr.'_email' => 'email',
+                     $attr.'_phrase' => 'phrase',
+                    },
+        );
+}
+
+sub _build_owner_corr {
+    my $self = shift;
+    return $self->correspondent_collection->get_or_create($self->owner);
+}
+
+sub _build_submitter_corr {
+    my $self = shift;
+    return $self->correspondent_collection->get_or_create($self->submitter);
+}
 
 for my $attr (qw(done severity),
-             qw(found fixed),
+             qw(forwarded),
              qw(pending location submitter),
+             qw(owner subject),
             ) {
     has $attr =>
        (is => 'rw',
@@ -165,21 +220,38 @@ sub _build_severity {
     return $_[0]->status->{severity} // $config{default_severity};
 }
 
+sub _build_subject {
+    return $_[0]->status->{subject} // '(No subject)';
+}
+
 sub strong_severity {
     my $self = shift;
     return exists $strong_severities->{$self->severity};
 }
 
+sub short_severity {
+    $_[0]->severity =~ m/^(.)/;
+    return $1;
+}
+
 sub package {
-    local $_;
-    return join(', ',map {$_->name} $_[0]->packages);
+    my $self = shift;
+    return join(', ',$self->packages->apply(sub{$_->name}));
 }
 
 sub _build_packages {
-    return [$_[0]->package_collection->
-           get_package($_[0]->status->{package} //
-                       '')
-          ];
+    my $self = shift;
+    my @packages;
+    if (length($self->status->{package}//'')) {
+       @packages = split /,/,$self->status->{package}//'';
+    }
+    return $self->package_collection->
+           limit(@packages);
+}
+
+sub is_affecting {
+    my $self = shift;
+    return $self->affects->count > 0;
 }
 
 sub affect {
@@ -188,10 +260,12 @@ sub affect {
 }
 
 sub _build_affects {
-    return [$_[0]->package_collection->
-           get_package($_[0]->status->{affects} //
-                       '')
-          ];
+    my @packages;
+    if (length($_[0]->status->{affects}//'')) {
+       @packages = split /,/,$_[0]->status->{affects}//'';
+    }
+    return $_[0]->package_collection->
+           limit(@packages);
 }
 sub source {
     local $_;
@@ -199,7 +273,17 @@ sub source {
 }
 sub _build_sources {
     local $_;
-    my @sources = map {$_->sources} $_[0]->packages;
+    my @sources = map {$_->sources} $_[0]->packages->members;
+    return @sources;
+}
+
+sub is_owned {
+    my $self = shift;
+    return length($self->owner) > 0;
+}
+sub _build_owner {
+    my $self = shift;
+    return $self->status->{owner} // '';
 }
 
 
@@ -215,37 +299,84 @@ sub _split_if_defined {
     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(sort {$a <=> $b}
+             $self->_split_if_defined('blocks'));
+}
+
+sub is_blocked {
+    my $self = shift;
+    return $self->blockedby->count > 0;
 }
 
 sub _build_blockedby {
     my $self = shift;
     return $self->bug_collection->
-       limit_or_create(sort {$a <=> $b}
-                       $self->_split_if_defined('blockedby'));
+       limit(sort {$a <=> $b}
+             $self->_split_if_defined('blockedby'));
+}
+
+sub is_forwarded {
+    length($_[0]->forwarded) > 0;
+}
+
+sub _build_forwarded {
+    my $self = shift;
+    return $self->status->{forwarded} // '';
+}
+
+
+
+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 $self->found->count > 0;
 }
 
 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_versions} // []});
 }
 
+sub has_fixed {
+    my $self = shift;
+    return $self->fixed->count > 0;
+}
 
 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_versions} // []});
+}
+
+sub is_merged {
+    my $self = shift;
+    return $self->mergedwith->count > 0;
 }
+
 sub _build_mergedwith {
     my $self = shift;
     return $self->bug_collection->
-       limit_or_create(sort {$a <=> $b}
-                       $self->_split_if_defined('mergedwith'));
+       limit(sort {$a <=> $b}
+             $self->_split_if_defined('mergedwith'));
 }
 sub _build_pending {
     return $_[0]->status->{pending} // '';
@@ -307,21 +438,21 @@ 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,
+               new(version => $ver,
+                    package => $self,
                    package_collection => $self->package_collection,
                   );
        }
        $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 +513,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 +530,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 +551,128 @@ 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, map {$_->bug} $self->mergedwith->members;
+       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 url {
+    my $self = shift;
+    return $config{web_domain}.'/'.$self->id;
+}
+
+sub related_packages_and_versions {
+    my $self = shift;
+    my @packages;
+    if (length($self->status->{package}//'')) {
+       @packages = split /,/,$self->status->{package}//'';
+    }
+    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) {
+        push @return,
+            [$pkg,@unqualified_versions];
+    }
+    return @return;
+}
+
 
 no Mouse;
 1;
index 8ed9246ab5b666516f2c7714ce685f6a3dd4c23d..7b3df32074f8ecf1833094302c86c2265d3e3602 100644 (file)
@@ -25,11 +25,16 @@ use strictures 2;
 use namespace::clean;
 use v5.10; # for state
 
+use Debbugs::User;
+use List::AllUtils qw(uniq);
 use Debbugs::Config qw(:config);
 
 state $valid_tags =
     {map {($_,1)} @{$config{tags}}};
 
+state $short_tags =
+   {%{$config{tags_single_letter}}};
+
 extends 'Debbugs::OOBase';
 
 around BUILDARGS => sub {
@@ -45,20 +50,50 @@ around BUILDARGS => sub {
     }
 };
 
-has tags => (is => 'ro', isa => 'HashRef[Str]',
-            default => sub {{}},
+has tags => (is => 'ro',
+            isa => 'HashRef[Str]',
+            traits => ['Hash'],
+            lazy => 1,
+            reader => '_tags',
+            builder => '_build_tags',
+            handles => {has_tags => 'count'}
            );
-has usertags => (is => 'ro',isa => 'HashRef[Str]',
-                default => sub {{}},
+has usertags => (is => 'ro',
+                isa => 'HashRef[Str]',
+                lazy => 1,
+                reader => '_usertags',
+                builder => '_build_usertags',
                );
 
+sub _build_tags {
+    return {};
+}
+
+sub _build_usertags {
+    return {};
+}
+
+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;
+    return exists $_[0]->_tags->{$_[1]} ? 1 : 0;
+}
+
+sub usertag_is_set {
+    return exists $_[0]->_usertags->{$_[1]} ? 1 : 0;
 }
 
 sub unset_tag {
     my $self = shift;
-    delete $self->tags->{$_} foreach @_;
+    delete $self->_tags->{$_} foreach @_;
+}
+
+sub unset_usertag {
+    my $self = shift;
+    delete $self->_usertags->{$_} foreach @_;
 }
 
 sub set_tag {
@@ -67,7 +102,7 @@ sub set_tag {
        if (not $self->valid_tag($tag)) {
            confess("Invalid tag $tag");
        }
-       $self->tags->{$tag} = 1;
+       $self->_tags->{$tag} = 1;
     }
     return $self;
 }
@@ -77,7 +112,44 @@ sub valid_tag {
 }
 
 sub as_string {
-    return join(' ',sort keys %{$_[0]->tags})
+    my $self = shift;
+    return $self->join_all(' ');
+}
+
+sub join_all {
+    my $self = shift;
+    my $joiner = shift;
+    $joiner //= ', ';
+    return join($joiner,$self->all_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;
index ee478c6e6110026172d7971a2da374383378cf2e..529056391886d862fd3211de4ec2c5d745c96009 100644 (file)
@@ -30,24 +30,32 @@ has 'members' => (is => 'bare',
                  traits => ['Array'],
                  default => sub {[]},
                   writer => '_set_members',
+                  predicate => '_has_members',
                  handles => {_add => 'push',
                              members => 'elements',
                              count => 'count',
                              _get_member => 'get',
                               grep => 'grep',
                               apply => 'apply',
+                              map => 'map',
                               sort => 'sort',
                             },
                 );
 
+sub members_ref {
+    my $self = shift;
+    return [$self->members];
+}
+
 has 'member_hash' => (traits => ['Hash'],
-                     is => 'ro',
+                     is => 'bare',
                      isa => 'HashRef[Int]',
                      lazy => 1,
                      reader => '_member_hash',
                      builder => '_build_member_hash',
                       clearer => '_clear_member_hash',
-                     predicate => '_has_member_hash',
+                      predicate => '_has_member_hash',
+                      writer => '_set_member_hash',
                      handles => {_add_member_hash => 'set',
                                  _member_key_exists => 'exists',
                                  _get_member_hash => 'get',
@@ -67,19 +75,32 @@ sub _build_universe {
     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 limit {
     my $self = shift;
     my $limit = $self->clone();
     # Set the universe to whatever my universe is (potentially myself)
-    $limit->_set_universe($self->universe);
-    $limit->_set_members();
+    $limit->_set_universe($self->universe);
+    $limit->_set_members([]);
     $limit->_clear_member_hash();
-    $limit->add($self->universe->get_or_create(@_));
+    $limit->add($self->universe->get_or_create(@_)) if @_;
     return $limit;
 }
 
 sub get_or_create {
     my $self = shift;
+    return () unless @_;
     my @return;
     my @exists;
     my @need_to_add;
@@ -96,10 +117,19 @@ sub get_or_create {
         }
     }
     # create and add by key
-    @return[@need_to_add] =
-        $self->add_by_key(@_[@need_to_add]);
-    @return[@exists] =
-        $self->get(@_[@exists]);
+    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;
 }
 
@@ -116,18 +146,21 @@ sub add_by_key {
 
 sub add {
     my $self = shift;
-    my @members_to_add;
+    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(),
+                               $self->count()-1,
                               );
     }
-    $self->_add(@members_to_add);
-    return @members_to_add;
+    return @members_added;
 }
 
 sub get {
index 08f7a66d078f43fd6f48f3b29ffedfbf80cc5e8b..4982047b2c59ec799f41c835161161ae00f704c0 100644 (file)
@@ -25,52 +25,69 @@ 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';
 
 has '+members' => (isa => 'ArrayRef[Bug]');
-has 'package_collection' => (is => 'rw',
-                          isa => 'Debbugs::Collection::Package',
-                          default => sub {Debbugs::Collection::Package->new()}
-                         );
+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):());
+}
 
-around BUILDARGS => sub {
-    my $orig = shift;
-    my $class = shift;
+has 'correspondent_collection' =>
+    (is => 'ro',
+     isa => 'Debbugs::Collection::Correspondent',
+     builder => '_build_correspondent_collection',
+     lazy => 1,
+    );
 
-    my %args;
-    if (@_==1 and ref($_[0]) eq 'HASH') {
-        %args = %{$_[0]};
-    } else {
-        %args = @_;
-    }
-    $args{members} //= [];
-    if (exists $args{bugs}) {
-        push @{$args{members}},
-            _member_constructor(bugs => $args{bugs},
-                                hash_slice(%args,qw(schema constructor_args)),
-                               );
-        delete $args{bugs};
+sub _build_correspondent_collection {
+    my $self = shift;
+    return Debbugs::Collection::Correspondent->new($self->has_schema?(schema => $self->schema):());
+}
+
+sub BUILD {
+    my $self = shift;
+    my $args = shift;
+    if (exists $args->{bugs}) {
+        $self->add(
+            $self->_member_constructor(bugs => $args->{bugs}
+                                      ));
     }
-    return $class->$orig(%args);
-};
+}
 
 sub _member_constructor {
     # handle being called $self->_member_constructor;
-    if ((@_ % 2) == 1) {
-        shift;
-    }
+    my $self = shift;
     my %args = @_;
     my @return;
-    if (exists $args{schema}) {
+    my $schema;
+    $schema = $self->schema if $self->has_schema;
+
+    if (defined $schema) {
         my $statuses = get_bug_statuses(bug => [make_list($args{bugs})],
-                                        schema => $args{schema},
+                                        schema => $schema,
                                        );
         while (my ($bug, $status) = each %{$statuses}) {
             push @return,
-                Debbugs::Bug->new(bug=>$bug,
-                                  status=>$status,
-                                  schema=>$args{schema},
+                Debbugs::Bug->new(bug => $bug,
+                                  status => $status,
+                                  schema => $schema,
+                                  package_collection =>
+                                  $self->package_collection->universe,
+                                  correspondent_collection =>
+                                  $self->correspondent_collection->universe,
                                   @{$args{constructor_args}//[]},
                                  );
         }
@@ -78,6 +95,10 @@ sub _member_constructor {
         for my $bug (make_list($args{bugs})) {
             push @return,
                 Debbugs::Bug->new(bug => $bug,
+                                  package_collection =>
+                                  $self->package_collection->universe,
+                                  correspondent_collection =>
+                                  $self->correspondent_collection->universe,
                                   @{$args{constructor_args}//[]},
                                  );
         }
@@ -89,10 +110,8 @@ around add_by_key => sub {
     my $orig = shift;
     my $self = shift;
     my @members =
-        _member_constructor(bugs => [@_],
-                            $self->has_schema?(schema => $self->schema):(),
-                            constructor_args => $self->constructor_args,
-                           );
+        $self->_member_constructor(bugs => [@_],
+                                  );
     return $self->$orig(@members);
 };
 
@@ -100,6 +119,14 @@ sub member_key {
     return $_[1]->bug;
 }
 
+sub load_related_packages_and_versions {
+    my $self = shift;
+    my @related_packages_and_versions =
+        $self->map(sub {$_->related_packages_and_versions});
+    $self->package_collection->
+        add_packages_and_versions(@related_packages_and_versions);
+}
+
 __PACKAGE__->meta->make_immutable;
 
 1;
index 0459b1e04f31f6e50b7ca1921dacbea6d008530e..a78d7b75908aec7a29552b790b1bbe442243004f 100644 (file)
@@ -21,56 +21,245 @@ Debbugs::Collection::Package -- Package generation factory
 
 use Mouse;
 use strictures 2;
+use v5.10; # for state
 use namespace::autoclean;
-use Debbugs::Common qw(make_list);
+
+use Carp;
+use Debbugs::Common qw(make_list hash_slice);
+use Debbugs::Config qw(:config);
 use Debbugs::OOTypes;
-use Debbugs::Status qw(get_bug_statuses);
+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';
 
-has '+members' => (isa => 'ArrayRef[Package]');
+has '+members' => (isa => 'ArrayRef[Debbugs::Package]');
 
-around BUILDARGS => sub {
+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 $class = shift;
+    my $self = shift;
+    my @members =
+        $self->_member_constructor(packages => [@_]);
+    return $self->$orig(@members);
+};
 
-    my %args;
-    if (@_==1 and ref($_[0]) eq 'HASH') {
-        %args = %{$_[0]};
-    } else {
-        %args = @_;
+sub _member_constructor {
+    # handle being called $self->_member_constructor;
+    my $self = shift;
+    my %args = @_;
+    my $schema;
+    if ($self->has_schema) {
+        $schema = $self->schema;
     }
-    $args{members} //= [];
-    if (exists $args{packages}) {
-        if (exists $args{schema}) {
-            my $statuses = get_bug_statuses(bug => [make_list($args{bugs})],
-                                            schema => $args{schema},
-                                           );
-            while (my ($bug, $status) = each %{$statuses}) {
-                push @{$args{members}},
-                    Debbugs::Bug->new(bug=>$bug,
-                                      status=>$status,
-                                      schema=>$args{schema},
-                                      @{$args{constructor_args}//[]},
+    my @return;
+    if (defined $schema) {
+        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 $bug (make_list($args{bugs})) {
-                push @{$args{members}},
-                    Debbugs::Bug->new(bug => $bug,
-                                      @{$args{constructor_args}//[]},
+        }
+    } else {
+        carp "No schema\n";
+        for my $package (make_list($args{packages})) {
+            push @return,
+                Debbugs::Package->new(name => $package,
+                                      package_collection => $self->universe,
+                                      correspondent_collection =>
+                                      $self->correspondent_collection->universe,
                                      );
-            }
         }
-        delete $args{bugs};
     }
-    return $class->$orig(%args);
-};
+    return @return;
+}
+
+sub add_packages_and_versions {
+    my $self = shift;
+    $self->add($self->_member_constructor(packages => \@_));
+}
+
+# state $common_dists = [@{$config{distributions}}];
+# sub _get_packages {
+#     my %args = @_;
+#     my $s = $args{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 (@{$args{packages}}) {
+#         if (ref($pkg)) {
+#             if ($pkg->[0] =~ /^src:(.+)$/) {
+#                 for my $ver (@{$pkg}[1..$#{$pkg}]) {
+#                     $src_ver_packages{$1}{$ver} = 1;
+#                 }
+#             } else {
+#                 for my $ver (@{$pkg}[1..$#{$pkg}]) {
+#                     $bin_ver_packages{$pkg->[0]}{$ver} = 1;
+#                 }
+#             }
+#         } elsif ($pkg =~ /^src:(.+)$/) {
+#             $src_packages{$1} = 1;
+#         } else {
+#             $bin_packages{$pkg} = 1;
+#         }
+#     }
+#     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 %packages;
+#     my $src_rs = $s->resultset('SrcVer')->
+#         search({-or => [-and => {'src_pkg.pkg' => [keys %src_packages],
+#                                  -or => {'suite.codename' => $common_dists,
+#                                          'suite.suite_name' => $common_dists,
+#                                         },
+#                                 },
+#                         @src_ver_search,
+#                        ],
+#                },
+#               {join => ['src_pkg',
+#                         {'src_associations' => 'suite'},
+#                        ],
+#                '+select' => [qw(src_pkg.pkg),
+#                              qw(suite.codename),
+#                              qw(src_associations.modified),
+#                              q(CONCAT(src_pkg.pkg,'/',me.ver))],
+#                '+as' => [qw(src_pkg_name codename modified_time src_pkg_ver)],
+#                result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+#                order_by => {-desc => 'me.ver'}
+#               },
+#               );
+#     while (my $pkg = $src_rs->next) {
+#         my $n = 'src:'.$pkg->{src_pkg_name};
+#         if (exists $packages{$n}) {
+#             push @{$packages{$n}{versions}},
+#                 $pkg->{src_pkg_ver};
+#             if (defined $pkg->{codename}) {
+#                 push @{$packages{$n}{dists}{$pkg->{codename}}},
+#                     $#{$packages{$n}{versions}};
+#             }
+#         } else {
+#             $packages{$n} =
+#            {name => $pkg->{src_pkg_name},
+#             type => 'source',
+#             valid => 1,
+#             versions => [$pkg->{src_pkg_ver}],
+#             dists => {defined $pkg->{codename}?($pkg->{codename} => [1]):()},
+#            };
+#         }
+#     }
+#     return \%packages;
+# }
 
 sub member_key {
-    return $_[1]->bug;
+    return $_[1]->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):());
+}
+
+
+sub get_source_versions_distributions {
+    my $self = shift;
+    my @return;
+    push @return,
+            $self->apply(sub {$_->get_source_version_distribution(@_)});
+    return
+        Debbugs::Collection::Version->new(versions => \@return,
+                                          $self->has_schema?(schema => $self->schema):(),
+                                          package_collection => $self->universe,
+                                         );
 }
 
+# given a list of binary versions or src/versions, returns all of the versions
+# in this package collection which are known to match. You'll have to be sure to
+# load appropriate versions beforehand for this to actually work.
+sub get_source_versions {
+    my $self = shift;
+    my @return;
+    for my $ver (@_) {
+        my $sv;
+        if ($ver =~ m{(<src>.+?)/(?<ver>.+)$/}) {
+            my $sp = $self->get_or_create('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->has_schema?(schema => $self->schema):(),
+                                                 );
+            }
+        }
+    }
+    return
+        Debbugs::Collection::Version->new(versions => \@return,
+                                          $self->has_schema?(schema => $self->schema):(),
+                                          package_collection => $self->universe,
+                                         );
+}
+
+
 __PACKAGE__->meta->make_immutable;
 
 1;
index bbed24dc3b6aca42fbd89f8fa25fda22a17b0a80..3e616091392bc40000d35dcf24d235a84f9a2c7e 100755 (executable)
@@ -37,6 +37,7 @@ BEGIN {
     # 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;
@@ -53,6 +54,7 @@ use Debbugs::Common qw(getparsedaddrs make_list getmaintainers getpseudodesc);
 
 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);
 
@@ -464,7 +466,14 @@ my %bugs;
 @bugs{@bugs} = @bugs;
 @bugs = keys %bugs;
 
-my $result = pkg_htmlizebugs(bugs => \@bugs,
+my $bugs = Debbugs::Collection::Bug->
+    new(bugs => \@bugs,
+       @schema_arg,
+       );
+
+$bugs->load_related_packages_and_versions();
+
+my $result = pkg_htmlizebugs(bugs => $bugs,
                             names => \@names,
                             title => \@title,
                             order => \@order,