File Coverage

blib/lib/CPAN/Recent/Uploads.pm

Criterion	Covered	Total	%
statement	50	53	94.3
branch	13	24	54.1
condition	6	17	35.2
subroutine	8	8	100.0
pod	1	1	100.0
total	78	103	75.7

package CPAN::Recent::Uploads;
$CPAN::Recent::Uploads::VERSION = '0.14';
#ABSTRACT: Find the distributions recently uploaded to CPAN

use strict;
use warnings;
use Carp;
use YAML::XS ();
use File::Spec;
use CPAN::Recent::Uploads::Retriever;

my $MIRROR = 'http://www.cpan.org/';
my @times = qw(1h 6h 1d 1W 1M 1Q 1Y);
my %periods  = (
  '1h' => (60*60),
  '6h' => (60*60*6),
  '1d' => (60*60*24),
  '1W' => (60*60*24*7),
  '1M' => (60*60*24*30),
  '1Q' => (60*60*24*90),
  '1Y' => (60*60*24*365.25),
);

sub recent {
  my $epoch = shift;
  $epoch = shift if $epoch and eval { $epoch->isa(__PACKAGE__) };
  $epoch = ( time() - ( 7 * 24 * 60 * 60 ) )
    unless $epoch and $epoch =~ /^\d+$/ and
      $epoch <= time() and $epoch >= ( time() - $periods{'1Y'} );
  my $period = _period_from_epoch( $epoch );
  my $mirror = shift || $MIRROR;
  my %data;
  OUTER: foreach my $foo ( @times ) {
    my $yaml = CPAN::Recent::Uploads::Retriever->retrieve( time => $foo, mirror => $mirror );
    my @yaml;
    eval { @yaml = YAML::XS::Load( $yaml ); };
    croak "Unable to process YAML\n" unless @yaml;
    my $record = shift @yaml;
    die unless $record;
    RECENT: foreach my $recent ( reverse @{ $record->{recent} } ) {
      next RECENT unless $recent->{path} =~ /\.(tar\.gz|tgz|tar\.bz2|zip)$/;
      if ( $recent->{type} eq 'new' ) {
        ( my $bar = $recent->{path} ) =~ s#^id/##;
        next RECENT if $recent->{epoch} < $epoch;
        {
          my @parts = split m!/!, $bar;
          next RECENT if $parts[3] =~ m!Perl6!i;
        }
        $data{ $bar } = $recent->{epoch};
      }
      else {
        ( my $bar = $recent->{path} ) =~ s#^id/##;
        delete $data{ $bar } if exists $data{ $foo };
      }
    }
    last if $foo eq $period;
  }
  return \%data unless wantarray;
  return sort { $data{$a} <=> $data{$b} } keys %data;
}

sub _period_from_epoch {
  my $epoch = shift || return;
  foreach my $period ( @times ) {
    return $period if ( time() - $periods{$period} ) < $epoch;
  }
  return;
}

q[Whats uploaded, Doc?];

__END__