File Coverage

blib/lib/CPAN/Recent/Uploads/Retriever.pm
Criterion Covered Total %
statement 40 40 100.0
branch 4 8 50.0
condition 4 11 36.3
subroutine 10 10 100.0
pod 1 1 100.0
total 59 70 84.2


line stmt bran cond sub pod time code
1             package CPAN::Recent::Uploads::Retriever;
2             $CPAN::Recent::Uploads::Retriever::VERSION = '0.16';
3             #ABSTRACT: Retrieves recentfiles from a CPAN mirror
4              
5 1     1   7 use strict;
  1         2  
  1         27  
6 1     1   5 use warnings;
  1         1  
  1         21  
7 1     1   6 use Carp;
  1         1  
  1         45  
8 1     1   545 use URI;
  1         6729  
  1         28  
9 1     1   665 use HTTP::Tiny;
  1         45275  
  1         48  
10 1     1   10 use File::Spec::Unix;
  1         2  
  1         398  
11              
12             my @times = qw(1h 6h 1d 1W 1M 1Q 1Y);
13              
14             sub retrieve {
15 1     1 1 3 my $class = shift;
16 1         5 my %opts = @_;
17 1         8 $opts{lc $_} = delete $opts{$_} for keys %opts;
18 1         3 my $self = bless \%opts, $class;
19 1   50     7 $self->{uri} = URI->new( $self->{mirror} || 'http://www.cpan.org/' );
20             croak "Unknown scheme\n"
21             unless $self->{uri} and $self->{uri}->scheme and
22 1 50 33     87 $self->{uri}->scheme =~ /^(http|ftp)$/i;
      33        
23             $self->{time} = '6h'
24             unless $self->{time}
25 1 50 33     89 and grep { $_ eq $self->{time} } @times;
  7         18  
26 1         8 $self->{uri}->path( File::Spec::Unix->catfile( $self->{uri}->path, 'authors', 'RECENT-' . $self->{time} . '.yaml' ) );
27 1         72 return $self->_fetch();
28             }
29              
30             sub _fetch {
31 1     1   2 my $self = shift;
32 1 50   1   8 open my $fooh, '>', \$self->{foo} or die "$!\n";
  1         3  
  1         7  
  1         57  
33 1         760 my $ua = HTTP::Tiny->new();
34 1     1   117 my $resp = $ua->get( $self->{uri}->as_string, { 'data_callback' => sub { my $data = shift; print {$fooh} $data; } } );
  1         8892  
  1         3  
  1         15  
35 1         139 close $fooh;
36 1 50       26 return $self->{foo} if $resp->{success};
37             }
38              
39             q[Woof];
40              
41             __END__