File Coverage

blib/lib/CPAN/YACSmoke/Plugin/Recent.pm
Criterion Covered Total %
statement 46 54 85.1
branch 8 14 57.1
condition 5 14 35.7
subroutine 11 11 100.0
pod 2 2 100.0
total 72 95 75.7


line stmt bran cond sub pod time code
1             =head1 NAME
2            
3             CPAN::YACSmoke::Plugin::Recent - Recent list for Yet Another CPAN Smoke Tester
4            
5             =head1 SYNOPSIS
6            
7             use CPAN::YACSmoke;
8             my $config = {
9             list_from => 'Recent',
10             recent_list_path => '.', # defaults to CPANPLUS base directory
11             recent_list_age => 1 # max age of file (*)
12             };
13             my $foo = CPAN::YACSmoke->new(config => $config);
14             my @list = $foo->download_list();
15            
16             # (*) defaults to always getting a fresh file
17            
18             =head1 DESCRIPTION
19            
20             This module provides the backend ability to access the list of current
21             modules in the F file from a CPAN Mirror.
22            
23             This module should be used together with L.
24            
25             =cut
26            
27             package CPAN::YACSmoke::Plugin::Recent;
28            
29 2     2   1928 use 5.006001;
  2         7  
  2         78  
30 2     2   11 use strict;
  2         4  
  2         55  
31 2     2   11 use warnings;
  2         4  
  2         90  
32            
33             our $VERSION = '0.02';
34            
35             # -------------------------------------
36             # Library Modules
37            
38 2     2   9 use CPAN::YACSmoke;
  2         4  
  2         133  
39 2     2   35 use LWP::Simple;
  2         4  
  2         21  
40 2     2   978 use URI;
  2         3  
  2         52  
41 2     2   11 use File::Spec::Functions qw( catfile );
  2         3  
  2         99  
42 2     2   12 use IO::File;
  2         4  
  2         386  
43            
44             # -------------------------------------
45             # Constants
46            
47 2     2   35 use constant RECENT_FILE => 'RECENT';
  2         4  
  2         1175  
48            
49             # -------------------------------------
50             # The Subs
51            
52             =head1 CONSTRUCTOR
53            
54             =over 4
55            
56             =item new()
57            
58             Creates the plugin object.
59            
60             =back
61            
62             =cut
63            
64             sub new {
65 2   50 2 1 6252 my $class = shift || __PACKAGE__;
66 2         6 my $hash = shift;
67            
68 2         6 my $self = {
69             recent_list_age => 1
70             };
71 2         7 foreach my $field (qw( smoke force recent_list_path recent_list_age )) {
72 8 100       27 $self->{$field} = $hash->{$field} if(exists $hash->{$field});
73             }
74            
75 2         11 bless $self, $class;
76             }
77            
78             =head1 METHODS
79            
80             =over 4
81            
82             =item download_list()
83            
84             Return the list of distributions recorded in the latest RECENT file.
85            
86             =cut
87            
88             sub download_list {
89 2     2 1 1289 my $self = shift;
90            
91 2   33     16 my $path = $self->{recent_list_path} || $self->{smoke}->basedir();
92 2         16 my $local = catfile( $path, RECENT_FILE );
93            
94 2 50 33     90 if ((!$self->{force}) && $self->{recent_list_age} &&
      33        
      33        
95             (-e $local) && ((-M $local) < $self->{recent_list_age}) ) {
96             # no need to download
97            
98             } else {
99 0         0 my $hosts = $self->{smoke}->{conf}->get_conf('hosts');
100 0         0 my $h_ind = 0;
101            
102 0         0 while ($h_ind < @$hosts) {
103 0         0 my $remote = URI->new( $hosts->[$h_ind]->{scheme} . '://' .
104             $hosts->[$h_ind]->{host} . $hosts->[$h_ind]->{path} . RECENT_FILE );
105            
106             # $self->{smoke}->msg("Downloading $remote to $local", $self->{smoke}->{verbose});
107            
108 0         0 my $status = mirror( $remote, $local );
109 0 0       0 last if ($status == RC_OK);
110 0         0 $h_ind++;
111             }
112            
113 0 0       0 return () if(@$hosts == $h_ind); # no host accessible
114             }
115            
116 2         4 my @testlist;
117 2 50       21 my $fh = IO::File->new($local)
118             or croak("Cannot access local RECENT file [$local]: $!\n");
119 2         246 while (<$fh>) {
120 13180 100       41880 next unless(/^authors/);
121 8798 100       46977 next if(/CHECKSUMS|\.meta|\.readme/);
122 1190         3539 s!authors/id/!!;
123 1190         1664 chomp;
124             # $self->{smoke}->msg("RECENT $_", $self->{smoke}->{debug});
125             # print STDERR $_, "\n";
126 1190         4353 push @testlist, $_;
127             }
128            
129 2         401 return @testlist;
130             }
131            
132             1;
133             __END__