view release on metacpan or  search on metacpan

lib/CPAN/WWW/Top100/Retrieve.pm  view on Meta::CPAN

#
# This file is part of CPAN-WWW-Top100-Retrieve
#
# This software is copyright (c) 2014 by Apocalypse.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
use strict; use warnings;
# Declare our package
package CPAN::WWW::Top100::Retrieve;
# git description: f223abe
$CPAN::WWW::Top100::Retrieve::VERSION = '1.001';
our $AUTHORITY = 'cpan:APOCAL';

# ABSTRACT: Retrieves the CPAN Top100 data from http://ali.as/top100

# import the Moose stuff
use Moose;
use MooseX::StrictConstructor 0.08;
use Moose::Util::TypeConstraints;
use Params::Coerce;
use namespace::autoclean;

# get some utility stuff
use LWP::UserAgent;
use URI;
use HTML::TableExtract;

use CPAN::WWW::Top100::Retrieve::Dist;
use CPAN::WWW::Top100::Retrieve::Utils qw( default_top100_uri dbids type2dbid dbid2type );

has 'debug' => (
	isa		=> 'Bool',
	is		=> 'rw',
	default		=> sub { 0 },
);

has 'ua' => (
	isa		=> 'LWP::UserAgent',
	is		=> 'rw',
	required	=> 0,
	lazy		=> 1,
	default		=> sub {
		LWP::UserAgent->new;
	},
);

has 'error' => (
	isa		=> 'Str',
	is		=> 'ro',
	writer		=> '_error',
);

# Taken from Moose::Cookbook::Basics::Recipe5
subtype 'My::Types::URI' => as class_type('URI');

coerce 'My::Types::URI'
	=> from 'Object'
		=> via {
			$_->isa('URI') ? $_ : Params::Coerce::coerce( 'URI', $_ );
		}
	=> from 'Str'
		=> via {
			URI->new( $_, 'http' )
		};

has 'uri' => (
	isa		=> 'My::Types::URI',
	is		=> 'rw',
	required	=> 0,
	lazy		=> 1,
	default		=> sub {
		default_top100_uri();
	},
	coerce		=> 1,
);

has '_data' => (
	isa		=> 'HashRef',
	is		=> 'ro',
	default		=> sub { {} },
);

sub _retrieve {
	my $self = shift;

	# Do we already have data?
	if ( keys %{ $self->_data } > 0 ) {
		warn "Using cached data" if $self->debug;
		return 1;
	} else {
		warn "Starting retrieve run" if $self->debug;
	}

	# Okay, get the data via LWP
	warn "LWP->get( " . $self->uri . " )" if $self->debug;
	my $response = $self->ua->get( $self->uri );
	if ( $response->is_error ) {
		my $errstr = "LWP Error: " . $response->status_line . "\n" . $response->content;
		$self->_error( $errstr );
		warn $errstr if $self->debug;
		return 0;
	}

	# Parse it!
	return $self->_parse( $response->content );
}

sub _parse {
	my $self = shift;
	my $content = shift;

	# Get the tables!
	foreach my $dbid ( sort { $a <=> $b } @{ dbids() } ) {