Debbugs/VersionTree.pm

   1 # This module is part of debbugs, and
   2 # is released under the terms of the GPL version 2, or any later
   3 # version (at your option). See the file README and COPYING for more
   4 # information.
   5 # Copyright 2018 by Don Armstrong <don@donarmstrong.com>.
   6
   7 package Debbugs::VersionTree;
   8
   9 =head1 NAME
  10
  11 Debbugs::VersionTree -- OO interface to Debbugs::Versions
  12
  13 =head1 SYNOPSIS
  14
  15    use Debbugs::VersionTree;
  16    my $vt = Debbugs::VersionTree->new();
  17
  18 =head1 DESCRIPTION
  19
  20
  21
  22 =cut
  23
  24 use Mouse;
  25 use v5.10;
  26 use strictures 2;
  27 use namespace::autoclean;
  28
  29 use Debbugs::Config qw(:config);
  30 use Debbugs::Versions;
  31 use Carp;
  32
  33 extends 'Debbugs::OOBase';
  34
  35 has _versions => (is => 'bare',
  36                   isa => 'Debbugs::Versions',
  37                   default => sub {Debbugs::Versions->new(\&Debbugs::Versions::Dpkg::vercmp)},
  38                   handles => {_isancestor => 'isancestor',
  39                               _load => 'load',
  40                               _buggy => 'buggy',
  41                               _allstates => 'allstates',
  42                              },
  43                  );
  44
  45 has loaded_src_pkg => (is => 'bare',
  46                      isa => 'HashRef[Bool]',
  47                      default => sub {{}},
  48                      traits => ['Hash'],
  49                      handles => {src_pkg_loaded => 'exists',
  50                                  _set_src_pkg_loaded => 'set',
  51                                 },
  52                     );
  53
  54 sub _srcify_version {
  55     my @return;
  56     for my $v (@_) {
  57         if (ref($_)) {
  58             push @return,
  59                 $v->source_version->src_pkg_ver;
  60         } else {
  61             push @return,
  62                 $v;
  63         }
  64     }
  65     return @_ > 1?@return:$return[0];
  66 }
  67
  68 sub isancestor {
  69     my ($self,$ancestor,$descendant) = @_;
  70     return $self->_isancestor(_srcify_version($ancestor),
  71                               _srcify_version($descendant),
  72                              );
  73 }
  74
  75 sub buggy {
  76     my $self = shift;
  77     my ($version,$found,$fixed) = @_;
  78     ($version) = _srcify_version($version);
  79     $found = [_srcify_version(@{$found})];
  80     $fixed = [_srcify_version(@{$fixed})];
  81     return $self->_buggy($version,$found,$fixed);
  82 }
  83
  84 sub allstates {
  85     my $self = shift;
  86     my $found = shift;
  87     my $fixed = shift;
  88     my $interested = shift;
  89     return $self->_allstates([_srcify_version(@{$found})],
  90                              [_srcify_version(@{$fixed})],
  91                              [_srcify_version(@{$interested})],
  92                             );
  93 }
  94
  95 sub load {
  96     my $self = shift;
  97     for my $src_pkg (@_) {
  98         my $is_valid = 0;
  99         if (ref($src_pkg)) {
 100             $is_valid = $src_pkg->valid;
 101             $src_pkg = $src_pkg->name;
 102         }
 103         next if $self->src_pkg_loaded($src_pkg);
 104         my $srchash = substr $src_pkg, 0, 1;
 105         my $version_fh;
 106         open($version_fh,'<',"$config{version_packages_dir}/$srchash/$src_pkg");
 107         if (not defined $version_fh) {
 108             carp "No version file for package $src_pkg" if $is_valid;
 109             next;
 110         }
 111         $self->_load($version_fh);
 112         $self->_set_src_pkg_loaded($src_pkg,1);
 113     }
 114 }
 115
 116 __PACKAGE__->meta->make_immutable;
 117 no Mouse;
 118 1;
 119
 120
 121 __END__
 122 # Local Variables:
 123 # indent-tabs-mode: nil
 124 # cperl-indent-level: 4
 125 # End: