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
5 # Copyright 2018 by Don Armstrong <don@donarmstrong.com>.
7 package Debbugs::VersionTree;
11 Debbugs::VersionTree -- OO interface to Debbugs::Versions
15 use Debbugs::VersionTree;
16 my $vt = Debbugs::VersionTree->new();
27 use namespace::autoclean;
29 use Debbugs::Config qw(:config);
30 use Debbugs::Versions;
33 extends 'Debbugs::OOBase';
35 has _versions => (is => 'bare',
36 isa => 'Debbugs::Versions',
37 default => sub {Debbugs::Versions->new(\&Debbugs::Versions::Dpkg::vercmp)},
38 handles => {_isancestor => 'isancestor',
41 _allstates => 'allstates',
45 has loaded_src_pkg => (is => 'bare',
46 isa => 'HashRef[Bool]',
49 handles => {src_pkg_loaded => 'exists',
50 _set_src_pkg_loaded => 'set',
59 $v->source_version->src_pkg_ver;
65 return @_ > 1?@return:$return[0];
69 my ($self,$ancestor,$descendant) = @_;
70 return $self->_isancestor(_srcify_version($ancestor),
71 _srcify_version($descendant),
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);
88 my $interested = shift;
89 return $self->_allstates([_srcify_version(@{$found})],
90 [_srcify_version(@{$fixed})],
91 [_srcify_version(@{$interested})],
97 for my $src_pkg (@_) {
100 $is_valid = $src_pkg->valid;
101 $src_pkg = $src_pkg->name;
103 next if $self->src_pkg_loaded($src_pkg);
104 my $srchash = substr $src_pkg, 0, 1;
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;
111 $self->_load($version_fh);
112 $self->_set_src_pkg_loaded($src_pkg,1);
116 __PACKAGE__->meta->make_immutable;
123 # indent-tabs-mode: nil
124 # cperl-indent-level: 4