File Coverage

blib/lib/CPAN/Releases/Latest.pm
Criterion Covered Total %
statement 57 99 57.5
branch 11 30 36.6
condition 0 6 0.0
subroutine 13 16 81.2
pod 2 3 66.6
total 83 154 53.9


line stmt bran cond sub pod time code
1             package CPAN::Releases::Latest;
2             $CPAN::Releases::Latest::VERSION = '0.07';
3 5     5   65276 use 5.006;
  5         17  
4 5     5   4000 use Moo;
  5         74551  
  5         28  
5 5     5   21708 use File::HomeDir;
  5         37794  
  5         309  
6 5     5   3917 use File::Spec::Functions 'catfile';
  5         4132  
  5         394  
7 5     5   4718 use MetaCPAN::Client 1.001001;
  5         1325044  
  5         253  
8 5     5   44 use Module::Runtime qw/ is_module_name require_module /;
  5         11  
  5         42  
9 5     5   4061 use CPAN::DistnameInfo;
  5         4975  
  5         155  
10 5     5   29 use Carp;
  5         9  
  5         323  
11 5     5   3882 use autodie;
  5         96888  
  5         27  
12              
13             my $FORMAT_REVISION = 1;
14              
15             has 'max_age' => (is => 'ro', default => sub { '1 day' });
16             has 'cache_path' => (is => 'rw');
17             has 'basename' => (is => 'ro', default => sub { 'latest-releases.txt' });
18             has 'path' => (is => 'ro');
19             has 'source' => (is => 'ro', default => sub { 'MetaCPAN' });
20              
21             has '_indexer' => (is => 'lazy');
22              
23             sub BUILD
24             {
25 4     4 0 33 my $self = shift;
26              
27 4 50       36 if ($self->path) {
28 4 100       130 if (-f $self->path) {
29 3         65 return;
30             }
31             else {
32 1         292 croak "the file you specified with 'path' doesn't exist";
33             }
34             }
35              
36 0 0       0 if (not $self->cache_path) {
37 0         0 my $classid = __PACKAGE__;
38 0         0 $classid =~ s/::/-/g;
39              
40 0         0 $self->cache_path(
41             catfile(File::HomeDir->my_dist_data($classid, { create => 1 }),
42             $self->basename)
43             );
44             }
45              
46 0 0       0 if (-f $self->cache_path) {
47 0         0 require Time::Duration::Parse;
48 0         0 my $max_age_in_seconds = Time::Duration::Parse::parse_duration(
49             $self->max_age
50             );
51 0 0       0 return unless time() - $max_age_in_seconds
52             > (stat($self->cache_path))[9];
53             }
54              
55 0         0 $self->_build_cached_index();
56             }
57              
58             sub _build_cached_index
59             {
60 0     0   0 my $self = shift;
61 0         0 my $indexer = $self->_indexer;
62 0         0 my $distdata = $indexer->get_release_info();
63              
64 0         0 $self->_write_cache_file($distdata);
65             }
66              
67             sub _build__indexer
68             {
69 0     0   0 my $self = shift;
70 0         0 my $base_module_name = $self->source;
71              
72 0 0       0 if (not is_module_name($base_module_name)) {
73 0         0 croak "source '$base_module_name' is not a valid module name";
74             }
75              
76 0         0 my $full_class_name = "CPAN::Releases::Latest::Source::$base_module_name";
77 0         0 require_module($full_class_name);
78              
79 0         0 return $full_class_name->new();
80             }
81              
82             sub _write_cache_file
83             {
84 0     0   0 my $self = shift;
85 0         0 my $distdata = shift;
86 0         0 my %seen;
87              
88 0         0 $seen{$_} = 1 for keys(%{ $distdata->{released} });
  0         0  
89 0         0 $seen{$_} = 1 for keys(%{ $distdata->{developer} });
  0         0  
90              
91 0         0 open(my $fh, '>', $self->cache_path);
92 0         0 print $fh "#FORMAT: $FORMAT_REVISION\n";
93 0         0 foreach my $distname (sort { lc($a) cmp lc($b) } keys %seen) {
  0         0  
94 0         0 my ($stable_release, $developer_release);
95              
96 0 0       0 if (defined($stable_release = $distdata->{released}->{$distname})) {
97             printf $fh "%s %s %d %d\n",
98             $distname,
99             $stable_release->{path},
100             $stable_release->{time},
101 0         0 $stable_release->{size};
102             }
103              
104 0 0 0     0 if ( defined($developer_release = $distdata->{developer}->{$distname})
      0        
105             && ( !defined($stable_release)
106             || $developer_release->{time} > $stable_release->{time}
107             )
108             )
109             {
110             printf $fh "%s %s %d %d\n",
111             $distname,
112             $developer_release->{path},
113             $developer_release->{time},
114 0         0 $developer_release->{size};
115             }
116              
117             }
118 0         0 close($fh);
119             }
120              
121             sub release_iterator
122             {
123 2     2 1 761 my $self = shift;
124              
125 2         1253 require CPAN::Releases::Latest::ReleaseIterator;
126 2         12 return CPAN::Releases::Latest::ReleaseIterator->new( latest => $self, @_ );
127             }
128              
129             sub distribution_iterator
130             {
131 1     1 1 10 my $self = shift;
132              
133 1         627 require CPAN::Releases::Latest::DistributionIterator;
134 1         6 return CPAN::Releases::Latest::DistributionIterator->new(
135             latest => $self,
136             @_
137             );
138             }
139              
140             sub _open_file
141             {
142 3     3   8 my $self = shift;
143 3 50       17 my $options = @_ > 0 ? shift : {};
144 3         33 my $filename = $self->cache_path;
145 3         9 my $whatfile = 'cached';
146 3         7 my $from_cache = 1;
147 3         8 my $fh;
148              
149 3 50       30 if (defined($self->path)) {
150 3         17 $filename = $self->path;
151 3         8 $from_cache = 0;
152 3         8 $whatfile = 'passed';
153             }
154              
155 3         24 open($fh, '<', $filename);
156 3         10790 my $line = <$fh>;
157 3 50       27 if ($line !~ m!^#FORMAT: (\d+)$!) {
158 0         0 croak "unexpected format of first line - should give format";
159             }
160 3         11 my $file_revision = $1;
161              
162 3 100       16 if ($file_revision > $FORMAT_REVISION) {
163 1         226 croak "the $whatfile file has a later format revision ($file_revision) ",
164             "than this version of ", __PACKAGE__,
165             " supports ($FORMAT_REVISION). Maybe it's time to upgrade?\n";
166             }
167              
168 2 100       14 if ($file_revision < $FORMAT_REVISION) {
169 1 50       4 if ($whatfile eq 'passed') {
170 1         278 croak "the passed file $filename is from an older version of ",
171             __PACKAGE__, "\n";
172             }
173              
174             # The locally cached version was written by an older version of
175             # this module, but is still within the max_age constraint, which
176             # is how we ended up here. We rebuild the cached index and call
177             # this method again. But if we're here because we were trying to
178             # rebuild the index, then bomb out, because This Should Never Happen[TM].
179 0 0       0 if ($options->{rebuilding}) {
180 0         0 croak "failed to rebuild the cached index with the expected version\n";
181             }
182 0         0 $self->_build_cached_index();
183 0         0 return $self->_open_file({ rebuilding => 1});
184             }
185              
186 1         8 return $fh;
187             }
188              
189             1;
190              
191             =head1 NAME
192              
193             CPAN::Releases::Latest - find latest release(s) of all dists on CPAN, including dev releases
194              
195             =head1 SYNOPSIS
196              
197             use CPAN::Releases::Latest;
198            
199             my $latest = CPAN::Releases::Latest->new(max_age => '1 day');
200             my $iterator = $latest->release_iterator();
201            
202             while (my $release = $iterator->next_release) {
203             printf "%s path=%s time=%d size=%d\n",
204             $release->distname,
205             $release->path,
206             $release->timestamp,
207             $release->size;
208             }
209              
210             =head1 DESCRIPTION
211              
212             This module constructs a list of all dists on CPAN, by default using the MetaCPAN API.
213             The generated index is cached locally.
214             It will let you iterate over the index, either release by release,
215             or distribution by distribution.
216              
217             See below for details of the two iterators you can instantiate.
218              
219             B this is very much an alpha release; all things may change.
220              
221             When you instantiate this class, you can specify the C of
222             the generated index. You can specify the age
223             using any of the expressions supported by L:
224              
225             5 minutes
226             1 hour and 30 minutes
227             2d
228             3600
229              
230             If no units are given, it will be interpreted as a number of seconds.
231             The default for max age is 1 day.
232              
233             If you already have a cached copy of the index, and it is less than
234             the specified age, then we'll use your cached copy and not even
235             check with MetaCPAN.
236              
237             =head2 distribution_iterator
238              
239             The C method returns an iterator which
240             will process the index dist by dist:
241              
242             my $latest = CPAN::Releases::Latest->new();
243             my $iterator = $latest->distribution_iterator();
244              
245             while (my $dist = $iterator->next_distribution) {
246             print $dist->distname, "\n";
247             process_release($dist->release);
248             process_release($dist->developer_release);
249             }
250              
251             The iterator returns instances of L,
252             or C when the index has been exhausted.
253             The distribution object has three attributes:
254              
255             =over 4
256              
257             =item * distname: the distribution name as determined by L
258              
259             =item * release: a release object for the latest non-developer release, or C
260              
261             =item * developer_release: a release object for the latest developer release that is more recent than the latest non-developer release, or C
262              
263             =back
264              
265             The release objects are instances of L,
266             which are described in the next section, below.
267              
268             =head2 release_iterator
269              
270             The C method returns an iterator which will process the index
271             release by release. See the example in the SYNOPSIS.
272              
273             You will see the releases ordered distribution by distribution.
274             For a given distribution you'll first see the latest non-developer release,
275             if there is one;
276             if the most recent release for the distribution is a developer release,
277             then you'll see that.
278             So for any dist you'll see at most two releases, and the developer release
279             will always come second.
280              
281             The release objects are instances of L,
282             which have the following attributes:
283              
284             =over 4
285              
286             =item * distname: the distribution name as determined by L
287              
288             =item * path: the partial path for the release tarball (eg C)
289              
290             =item * timestamp: an epoch-based timestamp for when the tarball was uploaded to PAUSE.
291              
292             =item * size: the size of the release tarball, in bytes.
293              
294             =item * distinfo: an instance of L, which is constructed lazily.
295              
296             =back
297              
298             =head1 Data source
299              
300             By default the locally cached index is generated using information requested
301             from MetaCPAN, using L. The plugin which does this is
302             L. You can explicitly specify
303             the source when calling the constructor:
304              
305             $latest = CPAN::Releases::Latest->new( source => 'MetaCPAN' );
306              
307             You can use a different source for the data, by providing your own plugin,
308             which must live in the C namespace.
309              
310             The plugin must return a hashref that has the following structure:
311              
312             {
313             release => {
314              
315             'Graph' => {
316             path => 'J/JH/JHI/Graph-0.96.tar.gz',
317             time => 1369483123,
318             size => 147629,
319             },
320              
321             },
322              
323             developer => {
324              
325             'Graph' => {
326             path => 'N/NE/NEILB/Graph-0.96_01.tar.gz',
327             time => 1394362358,
328             size => 147335,
329             },
330              
331             }
332              
333             }
334              
335             At the moment this isn't enforced, but a future version will croak
336             if the source doesn't return the right structure.
337              
338             =head1 SEE ALSO
339              
340             L provides a similar iterator, but for all releases
341             ever made to CPAN, even those that are no longer on CPAN.
342              
343             L is another way to get information about all releases
344             ever made to CPAN.
345              
346             =head1 REPOSITORY
347              
348             L
349              
350             =head1 AUTHOR
351              
352             Neil Bowers Eneilb@cpan.orgE
353              
354             =head1 COPYRIGHT AND LICENSE
355              
356             This software is copyright (c) 2014 by Neil Bowers .
357              
358             This is free software; you can redistribute it and/or modify it under
359             the same terms as the Perl 5 programming language system itself.
360              
361             =cut
362