File Coverage

lib/Parse/BACKPAN/Packages.pm

Criterion	Covered	Total	%
statement	110	116	94.8
branch	19	22	86.3
condition	4	5	80.0
subroutine	19	21	90.4
pod	6	6	100.0
total	158	170	92.9

package Parse::BACKPAN::Packages;
use strict;
use warnings;
use App::Cache;
use CPAN::DistnameInfo;
use Compress::Zlib;
use IO::File;
use IO::Zlib;
use LWP::UserAgent;
use Parse::BACKPAN::Packages::File;
use Parse::BACKPAN::Packages::Distribution;
use base qw( Class::Accessor::Fast );
__PACKAGE__->mk_accessors(qw( files dists_by no_cache ));
our $VERSION = '0.36';

sub new {
    my $class = shift;
    my $self  = $class->SUPER::new(@_);

    if ( !$self->no_cache ) {
        my $cache = App::Cache->new( { ttl => 60 * 60 } );
        $self->files(
            $cache->get_code( 'files', sub { $self->_init_files() } ) );
        $self->dists_by(
            $cache->get_code( 'dists_by', sub { $self->_init_dists_by() } ) );
    } else {
        $self->files( $self->_init_files() );
        $self->dists_by( $self->_init_dists_by() );
    }

    return $self;
}

sub _init_files {
    my $self = shift;
    my $files;

    my $data;
    my $url = "http://www.astray.com/tmp/backpan.txt.gz";
    my $ua  = LWP::UserAgent->new;
    $ua->env_proxy();
    $ua->timeout(180);
    my $response = $ua->get($url);

    if ( $response->is_success ) {
        my $gzipped = $response->content;
        $data = Compress::Zlib::memGunzip($gzipped);
        die "Error uncompressing data from $url" unless $data;
    } else {
        die "Error fetching $url";
    }

    foreach my $line ( split "\n", $data ) {
        my ( $prefix, $date, $size ) = split ' ', $line;
        next unless $size;
        my $file = Parse::BACKPAN::Packages::File->new(
            {   prefix => $prefix,
                date   => $date,
                size   => $size,
            }
        );
        $files->{$prefix} = $file;
    }
    return $files;
}

sub file {
    my ( $self, $prefix ) = @_;
    return $self->files->{$prefix};
}

sub distributions {
    my ( $self, $name ) = @_;
    my @files;

    while ( my ( $prefix, $file ) = each %{ $self->files } ) {
        my $prefix = $file->prefix;
        next unless $prefix =~ m{\/$name-};
        next if $prefix =~ /\.(readme|meta)$/;
        push @files, $file;
    }

    @files = sort { $a->date <=> $b->date } @files;

    my @dists;
    foreach my $file (@files) {
        my $i = CPAN::DistnameInfo->new( $file->prefix );
        my $dist = $i->dist || '';
        next unless $dist eq $name;
        my $d = Parse::BACKPAN::Packages::Distribution->new(
            {   prefix    => $file->prefix,
                date      => $file->date,
                dist      => $dist,
                version   => $i->version,
                maturity  => $i->maturity,
                filename  => $i->filename,
                cpanid    => $i->cpanid,
                distvname => $i->distvname,
            }
        );
        push @dists, $d;
    }

    return @dists;
}

sub distributions_by {
    my ( $self, $author ) = @_;
    return unless $author;

    my $dists_by = $self->dists_by;

    my @dists = @{ $dists_by->{$author} || [] };
    return sort @dists;
}

sub authors {
    my $self     = shift;
    my $dists_by = $self->dists_by;
    return sort keys %$dists_by;
}

sub _init_dists_by {
    my ($self) = shift;
    my @files;

    while ( my ( $prefix, $file ) = each %{ $self->files } ) {
        my $prefix = $file->prefix;
        next if $prefix =~ /\.(readme|meta)$/;
        push @files, $file;
    }

    @files = sort { $a->date <=> $b->date } @files;

    my $dist_by;
    foreach my $file (@files) {
        my $i = CPAN::DistnameInfo->new( $file->prefix );
        my ( $dist, $cpanid ) = ( $i->dist, $i->cpanid );
        next unless $dist && $cpanid;

        $dist_by->{$cpanid}{$dist}++;
    }

    my %dists_by = map { $_ => [ keys %{ $dist_by->{$_} } ] } keys %$dist_by;

    return \%dists_by;
}

sub size {
    my $self = shift;
    my $size;

    foreach my $file ( values %{ $self->files } ) {
        $size += $file->size;
    }
    return $size;
}

1;

__END__