]> git.donarmstrong.com Git - debbugs.git/commitdiff
Pkgreport now uses Mouse OO interface
authorDon Armstrong <don@donarmstrong.com>
Thu, 7 Jun 2018 22:32:01 +0000 (15:32 -0700)
committerDon Armstrong <don@donarmstrong.com>
Thu, 7 Jun 2018 22:32:01 +0000 (15:32 -0700)
Debbugs/CGI/Pkgreport.pm
Debbugs/OOBase.pm
Debbugs/Package.pm

index 331073e54164a7b232c12f439e06e636a13aceea..9d397b825976f726c72ae270fd1e332ff8aebbd2 100644 (file)
@@ -33,6 +33,11 @@ use Exporter qw(import);
 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);
@@ -210,52 +215,14 @@ display below
 
 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,
@@ -273,7 +240,7 @@ sub short_bug_status_html {
 
 sub pkg_htmlizebugs {
      my %param = validate_with(params => \@_,
-                              spec   => {bugs => {type => ARRAYREF,
+                              spec   => {bugs => {type => OBJECT,
                                                  },
                                          names => {type => ARRAYREF,
                                                   },
@@ -316,23 +283,15 @@ sub pkg_htmlizebugs {
                                                      },
                                         }
                              );
-     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 = (
@@ -363,52 +322,50 @@ sub pkg_htmlizebugs {
          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";
@@ -474,6 +431,58 @@ sub pkg_htmlizebugs {
      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|pending|severity/o) {
+               push @vals_bits, '$_[0]->'.$field.
+                   ' eq q('.$val.')';
+           } elsif ($field eq 'tag') {
+               push @vals_bits, '$_[0]->tags->is_set('.
+                   '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) = @_;
 
@@ -510,19 +519,13 @@ sub parse_order_statement_into_boolean {
 }
 
 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;
 }
index 37896bc4fee9d34af79be0f4e5b7b723fe44a254..6600e0222833fc26ac07fc26d3f02aa3f35c8f6a 100644 (file)
@@ -28,6 +28,15 @@ has schema => (is => 'ro', isa => 'Object',
               predicate => 'has_schema',
              );
 
+sub schema_argument {
+    my $self = shift;
+    if ($self->has_schema) {
+        return (schema => $self->schema);
+    } else {
+       return ();
+    }
+}
+
 __PACKAGE__->meta->make_immutable;
 
 1;
index d73474c684117bd363831a2a6223693447c81b36..06d711862ac6bbaa05e5b2c1d02896541696008f 100644 (file)
@@ -21,109 +21,562 @@ Debbugs::Package -- OO interface to packages
 
 =cut
 
-use warnings;
-use strict;
-
 use Mouse;
+use strictures 2;
+use v5.10; # for state
+use namespace::autoclean;
 
-use Debbugs::Version;
+use List::AllUtils  qw(uniq pairmap);
+use Debbugs::Config qw(:config);
+use Debbugs::Version::Source;
+use Debbugs::Version::Binary;
 
 extends 'Debbugs::OOBase';
 
 has name => (is => 'ro', isa => 'Str',
-            lazy => 1,
             required => 1,
-            builder => '_build_name',
            );
 
-has type => (is => 'ro', isa => 'Str',
+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';
+    }
+}
+
+sub qualified_name {
+    my $self = shift;
+    return
+       # src: if source, nothing if binary
+       ($self->_type eq 'source' ? 'src:':'') .
+       $self->name;
+}
+
+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);
+};
+
+sub is_source {
+    return $_[0]->_type eq 'source'
+}
+
+sub is_binary {
+    return $_[0]->_type eq 'binary'
+}
+
 has valid => (is => 'ro', isa => 'Bool',
              lazy => 1,
              builder => '_build_valid',
              writer => '_set_valid',
             );
 
-has 'sources' => (is => 'ro',isa => 'Array');
-has 'dists' => (is => 'ro',isa => 'Array');
-
-has 'versions' => (is => 'ro',isa => 'Array');
+sub _build_valid {
+    my $self = shift;
+    if ($self->_valid_versioninfo > 0) {
+       return 1;
+    }
+    return 0;
+}
 
-# gets used to retrieve packages
-has 'package_collection' => (is => 'ro',
-                            isa => 'Debbugs::Collection::Package',
-                            builder => '_build_package_collection',
-                            lazy => 1,
-                           );
+# 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_versioninfo',
+     predicate => '_has_valid_versioninfo',
+     clearer => '_clear_valid_versioninfo',
+     handles => {'_get_valid_versioninfo' => 'get',
+                '_grep_valid_versioninfo' => 'grep',
+                '_valid_versioninfo' => 'elements',
+               },
+    );
+
+sub _build_valid_versioninfo {
+    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} // [];
+}
 
-sub _build_package_collection {
-    return Debbugs::Collection::Package->new();
+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 @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 $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}}++;
+       }
+    }
+    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'},
+                      {'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',
+               order_by => {-desc => 'me.ver'}
+              },
+              );
+    add_result_to_package($packages,$src_rs,
+                          \%src_ver_packages,
+                          \%bin_ver_packages,
+                          \%src_packages,
+                          \%bin_packages,
+                         );
+    my $bin_rs = $s->resultset('BinVer')->
+       search({-or => [-and => {'bin_pkg.pkg' => [keys %bin_packages],
+                                 -or => {'suite.codename' => $common_dists,
+                                         'suite.suite_name' => $common_dists,
+                                        },
+                                },
+                        @bin_ver_search,
+                       ],
+               },
+              {join => ['bin_pkg',
+                      {'src_ver' => [{'src_associations' => 'suite'},
+                                     'src_pkg',
+                                     'maintainer',
+                                    ]},
+                       'arch',
+                       ],
+               'select' => [qw(src_pkg.pkg),
+                           qw(suite.codename),
+                           qw(suite.suite_name),
+                           qw(src_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',
+               order_by => {-desc => 'me.ver'}
+              },
+              );
+    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}}) {
+            $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}}) {
+            $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;
 }
 
-sub populate {
+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_versioninfo) {
+       push @{$info->{$v->{src_ver}}}, $i;
+       $i++;
+    }
+    return $info;
+}
 
-    my @binaries = $self->binaries;
-    my @sources = $self->sources;
-    my $s = $self->schema;
-    carp "No schema" unless $self->schema;
+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',
+               },
+    );
 
-    my $src_rs = $s->resultset('SrcVer')->
-       search({'src_pkg.pkg'=>[$self->sources],
-               -or => {'suite.codename' => [make_list($param{dist})],
-                       'suite.suite_name' => [make_list($param{dist})],
-                      }
-              },
-             {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' => ['src_pkg_name','codename',
-                        'modified_time',
-                        qw(src_pkg_ver)],
-              result_class => 'DBIx::Class::ResultClass::HashRefInflator',
-              order_by => {-desc => 'me.ver'},
-             },
-             );
-    
+sub _build_binary_version_to_info {
+    my $self = shift;
+    my $info = {};
+    my $i = 0;
+    for my $v ($self->_valid_versioninfo) {
+       push @{$info->{$v->{bin_ver}}}, $i;
+       $i++;
+    }
+    return $info;
 }
 
-sub packages {
+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;
-    $self->populate() unless $self->initialized;
+    my $info = {};
+    my $i = 0;
+    for my $v ($self->_valid_versioninfo) {
+       push @{$info->{$v->{dist}}}, $i;
+       $i++;
+    }
+    return $info;
 }
 
-sub versions {
+# 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;
-    $self->populate() unless $self->initialized;
+    if ($self->is_binary) {
+       return $self->package_collection->limit($self);
+    }
+    # OK, walk through the valid_versions for this package
+    my @binaries =
+       uniq map {$_->{bin_pkg}} $self->_valid_versioninfo;
+    return $self->package_collection->limit(@binaries);
 }
 
+has 'sources' => (is => 'ro',
+                 isa => 'Debbugs::Collection::Package',
+                 lazy => 1,
+                 builder => '_build_sources',
+                 predicate => '_has_sources',
+                );
 
-package Debbugs::Package::Version;
+sub _build_sources {
+    my $self = shift;
+    if ($self->is_source) {
+       return $self->package_collection->limit($self);
+    }
+    # OK, walk through the valid_versions for this package
+    my @sources =
+       uniq map {'src:'.$_->{src_pkg_name}} $self->_valid_versioninfo;
+    return $self->package_collection->limit(@sources);
+}
 
-use base qw(Class::Accessor);
-__PACKAGE__->mk_ro_accessors(qw(schema ));
+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 version {
+sub _add_version {
+    my $self = shift;
+    my @set;
+    for my $v (@_) {
+        push @set,
+            $v->version,$v;
+    }
+    $self->_set_version(@set);
 }
 
-sub type {
+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_versioninfo(@ver_loc)) {
+            $src_pkg_vers{$v->{src_pkg_ver}} = 1;
+        }
+    }
+    return $self->package_collection->
+        get_source_versions(keys %src_pkg_vers)->members;
 }
 
-sub 
+# 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_versioninfo($_)}
+            @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;
+}
 
-package Debbugs::Package::Package;
+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(package => $self,
+                       version => $v,
+                       package_collection => $self->package_collection,
+                        $self->has_schema?(schema => $self->schema):(),
+                      );
+       }
+    } else {
+       for my $v (@_) {
+           push @versions,
+               $v,
+               Debbugs::Version::Binary->
+                   new(package => $self,
+                       version => $v,
+                       package_collection => $self->package_collection,
+                        $self->has_schema?(schema => $self->schema):(),
+                      );
+       }
+    }
+    $self->_set_version(@versions);
+}
+
+# gets used to retrieve packages
+has 'package_collection' => (is => 'ro',
+                            isa => 'Debbugs::Collection::Package',
+                            builder => '_build_package_collection',
+                            lazy => 1,
+                           );
 
-package Debbugs::Package::Maintainer;
+sub _build_package_collection {
+    my $self = shift;
+    return Debbugs::Collection::Package->new($self->has_schema?(schema => $self->schema):());
+}
 
 
 1;