File Coverage

blib/lib/Debian/WNPP/Query.pm
Criterion Covered Total %
statement 27 67 40.3
branch 0 18 0.0
condition 0 10 0.0
subroutine 9 14 64.2
pod 2 2 100.0
total 38 111 34.2


line stmt bran cond sub pod time code
1             package Debian::WNPP::Query;
2 1     1   26939926 use strict;
  1         22  
  1         114  
3 1     1   29 use warnings;
  1         26  
  1         249  
4              
5             our $VERSION = '0.74';
6              
7             =head1 NAME
8              
9             Debian::WNPP::Query - offline storage of Debian's work-needing package lists
10              
11             =head1 SYNOPSIS
12              
13             my $wnpp = Debian::WNPP::Query->new(
14             { cache_dir => '/somewhere',
15             network_enabled => 0,
16             ttl => 3600 * 24,
17             bug_types => [qw( ITP RFP )]
18             }
19             );
20              
21             my @bugs = $wnpp->bugs_for_package('ken-lee');
22              
23             =head1 DESCRIPTION
24              
25             Debian::WNPP::Query provides a way to retrieve and cache the contents of
26             Debian's "Work-needing and prospective packages" lists.
27              
28             =head1 CONSTRUCTOR
29              
30             B is the constructor. Initial field values are to be given as a hash
31             reference.
32              
33             If B is given, it is read.
34              
35             =cut
36              
37 1     1   65 use base 'Class::Accessor';
  1         11  
  1         1434  
38              
39             __PACKAGE__->mk_accessors(
40             qw(
41             cache_file ttl bug_types
42             _bug_types _cache
43             )
44             );
45              
46 1     1   2375964 use autodie;
  1         1730724  
  1         5  
47 1     1   6488 use Debian::WNPP::Bug;
  1         3  
  1         5  
48 1     1   30 use File::Basename qw(dirname);
  1         2  
  1         134  
49 1     1   6 use File::Path;
  1         2  
  1         105  
50 1     1   961 use Storable ();
  1         3838  
  1         22  
51 1     1   49227 use WWW::Mechanize ();
  1         520955  
  1         807  
52              
53             our %list_url = (
54             ITP => 'http://www.debian.org/devel/wnpp/being_packaged',
55             RFP => 'http://www.debian.org/devel/wnpp/requested',
56             ITA => 'http://www.debian.org/devel/wnpp/being_adopted',
57             RFA => 'http://www.debian.org/devel/wnpp/rfa_bypackage',
58             O => 'http://www.debian.org/devel/wnpp/orphaned',
59             );
60              
61             sub new {
62 0     0 1   my $class = shift;
63 0           my $self = $class->SUPER::new(@_);
64              
65             # default to all types
66             $self->_bug_types(
67 0 0         { map( ( $_ => 1 ), @{ $self->bug_types || [ keys %list_url ] } ), }
  0            
68             );
69              
70             # default TTL
71 0 0         $self->ttl( 24 * 3600 )
72             unless defined $self->ttl;
73              
74 0           $self->_cache( {} );
75              
76 0 0         $self->_read_cache if $self->cache_file;
77             $self->_fetch
78             if not $self->_cache->{timestamp}
79 0 0 0       or ( ( time - $self->_cache->{timestamp} ) > $self->ttl );
80              
81 0           return $self;
82             }
83              
84             sub _read_cache {
85 0     0     my $self = shift;
86              
87 0 0 0       return unless $self->cache_file and -e $self->cache_file;
88              
89 0   0       $self->_cache( eval { Storable::retrieve( $self->cache_file ) }
90             || {} );
91             }
92              
93             sub _write_cache {
94 0     0     my $self = shift;
95              
96 0 0         return unless $self->cache_file;
97              
98 0           File::Path::make_path( dirname( $self->cache_file ) );
99              
100 0           $self->_cache->{timestamp} = scalar(time);
101              
102 0           Storable::nstore( $self->_cache, $self->cache_file );
103             }
104              
105             sub _fetch {
106 0     0     my $self = shift;
107              
108 0           my $browser = WWW::Mechanize->new();
109              
110 0           while( my( $type, $url ) = each %list_url ) {
111 0           eval {
112 0           $browser->get($url);
113             };
114 0 0         if ($@) {
115 0           warn "Error retrieving the list of $type bugs:\n";
116 0           warn $@;
117 0           next;
118             }
119              
120 0           for my $link ( $browser->links ) {
121 0 0         next unless $link->url =~ m{^http://bugs.debian.org/(\d+)};
122              
123 0           my $bug = $1;
124              
125 0           my $desc = $link->text;
126 0           $desc =~ s/^([^:]+): //;
127 0           my $package = $1;
128              
129 0   0       push @{ $self->_cache->{$package} ||= [] },
  0            
130             Debian::WNPP::Bug->new(
131             { type => $type,
132             number => $bug,
133             package => $package,
134             short_description => $desc,
135             title => "$type: $package -- $desc",
136             }
137             );
138             }
139             }
140              
141 0           $self->_write_cache;
142             }
143              
144             =head1 FIELDS
145              
146             =over
147              
148             =item cache_file I
149              
150             The path to the file holding the offline cache of the WNPP lists. If not
151             specified, no cache is read or written.
152              
153             =item ttl I
154              
155             The time after which the on-disk cache is considered too old and WNPP pages are
156             retrieved afresh. Ignored if B is not defined. Defaults to 86400 (1
157             day).
158              
159             =item bug_types I
160              
161             Specified which bug types to retrieve. For example, if you are interested in
162             ITP and RFP bugs, there is no point in downloading, parsing and storing
163             ITA/RFA/O bugs. By default all types of bugs are processed.
164              
165             =back
166              
167             =head1 METHODS
168              
169             =over
170              
171             =item bugs_for_package(I)
172              
173             Returns a list of bugs matching the given package name. Normally the list would
174             contain only one bug, but there are no guarantees.
175              
176             =cut
177              
178             sub bugs_for_package {
179 0     0 1   my ( $self, $package ) = @_;
180              
181 0 0         if (exists $self->_cache->{ $package }) {
182 0           return @{ $self->_cache->{ $package } };
  0            
183             }
184 0           return ();
185             }
186              
187             =back
188              
189             =head1 SEE ALSO
190              
191             =over
192              
193             =item L
194              
195             =item L
196              
197             =back
198              
199             =head1 AUTHOR AND COPYRIGHT
200              
201             =over
202              
203             =item Copyright (C) 2010 Damyan Ivanov
204              
205             =back
206              
207             This program is free software; you can redistribute it and/or modify it under
208             the terms of the GNU General Public License version 2 as published by the Free
209             Software Foundation.
210              
211             This program is distributed in the hope that it will be useful, but WITHOUT ANY
212             WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
213             PARTICULAR PURPOSE. See the GNU General Public License for more details.
214              
215             You should have received a copy of the GNU General Public License along with
216             this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
217             Street, Fifth Floor, Boston, MA 02110-1301 USA.
218              
219             =cut
220              
221             1;