1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
package CPAN::Audit::Query;
use strict;
use warnings;
use CPAN::Audit::Version;
our $VERSION = "1.001";
=encoding utf8
=head1 NAME
CPAN::Audit::Query - filter the database for advisories that interest you
=head1 SYNOPSIS
use CPAN::Audit::Query;
my $query = CPAN::Audit::Query->new( db => ... );
my @advisories = $query->advisories_for( $dist_name, $version_range );
=head1 DESCRIPTION
=head2 Class methods
=over 4
=item * new(HASH)
The only parameter is the hash reference from L<CPAN::Audit::DB> or
L<CPANSA::DB>. With no C<db> parameter, it uses the empty hash, which
means that you'll find no advisories.
=cut
sub new {
my($class, %params) = @_;
$params{db} ||= {};
my $self = bless {}, $class;
$self->{db} = $params{db};
return $self;
}
=back
=head2 Instance methods
=over 4
=item * advisories_for( DISTNAME, VERSION_RANGE )
Returns a list of advisories for DISTNAME in VERSION_RANGE.
my @advisories = $query->advisories_for( 'Business::ISBN', '1.23' );
my @advisories = $query->advisories_for( 'Business::ISBN', '>1.23,<2.45' );
my @advisories = $query->advisories_for( 'Business::ISBN', '<1.23' );
=cut
sub advisories_for {
my( $self, $distname, $dist_version_range ) = @_;
$dist_version_range = '>0' unless
defined $dist_version_range && 0 < length $dist_version_range;
my $dist = $self->{db}->{dists}->{$distname};
return unless $dist;
# select only the known distribution versions from the database,
# ignoring all others. For example, if $dist_version_range is
# ">5.1", we don't care about any versions less than or equal to 5.1.
# If $dist_version_range is "5.1", that really means ">=5.1"
my %advisories =
map { $_->{id}, $_ }
map {
my $dist_version = $_;
grep {
my $affected = _includes( $_->{affected_versions}, $dist_version );
my $f = $_->{fixed_versions};
if( exists $_->{fixed_versions} and defined $f and length $f ) {
my $fixed = _includes( $f, $dist_version );
$fixed ? 0 : $affected
}
else { $affected }
} @{ $dist->{advisories} };
}
grep { CPAN::Audit::Version->in_range( $_, $dist_version_range ) }
map { $_->{version}}
@{ $dist->{versions} };
values %advisories;
}
sub _includes {
my( $range, $version ) = @_;
$range = [$range] unless ref $range;
my $rc = 0;
foreach my $r ( @$range ) {
no warnings 'uninitialized';
$rc += CPAN::Audit::Version->in_range( $version, $r );
}
return $rc;
}
=back
=head1 LICENSE
Copyright (C) Viacheslav Tykhanovskyi.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 AUTHOR
Viacheslav Tykhanovskyi E<lt>viacheslav.t@gmail.comE<gt>
=cut
1;
|
