| 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__ |