File Coverage

blib/lib/WWW/CPANRatings/RSS.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package WWW::CPANRatings::RSS;

use warnings;
use strict;

our $VERSION = '0.0307';


use XML::Simple;
use LWP::UserAgent;
use Storable qw/lock_retrieve lock_store/;

use base 'Class::Data::Accessor';
__PACKAGE__->mk_classaccessors (qw/
    error
    ua
    ratings
    ratings_unique
/);

sub new {
    my $class = shift;
    my %args = @_;
    $args{ua}{timeout} ||= 30;

    my $self = bless {}, $class;

    $self->ua( LWP::UserAgent->new( %{ $args{ua} || {} } ) );

    return $self;
}

sub fetch {
    my $self = shift;

    $self->$_(undef)
        for qw/error ratings/;

    my $response = $self->ua->get('http://cpanratings.perl.org/index.rss');
    unless ( $response->is_success ) {
        $self->error( 'Network error: ' . $response->status_line );
        return;
    }

    my $feed;
    # calling XMLin caused warnings to print out on my system....
    # YES OMG!! LOOOK AT THIS!!1oneone ^_^
    {
        local *STDERR;
        open STDERR, '>', \my $crap;
        $feed = XMLin( $response->content );
    }

    my @ratings;
    for my $item ( @{ $feed->{item} || [] } ) {
        my ( $rating, $comment ) = $item->{description}
        =~ /Rating: \s* ([\d.]+) \s* stars \s* (.+)/sx;

        $rating = 'N/A'
            unless defined $rating;

        $comment = $item->{description}
            unless defined $comment;

        push @ratings, {
            creator     => $item->{'dc:creator'},
            link        => $item->{link},
            dist        => $item->{title},
            comment     => $comment,
            rating      => $rating,
        };
    }

    return $self->ratings( \@ratings );
}

sub fetch_unique {
    my ( $self, $file ) = @_;

    $self->ratings_unique(undef);

    unless ( defined $file ) {
        $file = 'cpan_ratings.rss.storable';
    }

    my $old_ratings_ref;
    eval {
        $old_ratings_ref = lock_retrieve( $file );
    };

    $old_ratings_ref ||= [];

    my $ratings_ref = $self->fetch
        or return; # error will be set by fetch();

    my %existing = map { $_->{link} => 1 } @$old_ratings_ref;

    my @new_ratings;
    for ( reverse @$ratings_ref ) {
        next if exists $existing{ $_->{link} };
        unshift @new_ratings, {%$_};
    };

    unshift @$old_ratings_ref, @new_ratings;
    @$old_ratings_ref = splice @$old_ratings_ref, 0, 60;

    eval {
        lock_store($old_ratings_ref, $file);
    };
    if ( $@ ) {
        $self->error("Error with file [$file] [$@]");
        return;
    }

    return $self->ratings_unique( \@new_ratings );
}

1;
__END__