File Coverage

lib/CPAN/Testers/WWW/Reports/Query/Reports.pm

Criterion	Covered	Total	%
statement	45	47	95.7
branch	10	12	83.3
condition	10	15	66.6
subroutine	11	11	100.0
pod	5	5	100.0
total	81	90	90.0

package CPAN::Testers::WWW::Reports::Query::Reports;

use strict;
use warnings;

our $VERSION = '0.09';

#----------------------------------------------------------------------------

=head1 NAME

CPAN::Testers::WWW::Reports::Query::Reports - Retrieve CPAN Testers metadata direct from the CPAN Testers website.

=head1 DESCRIPTION

This module queries the CPAN Testers website and retrieves a data set. For a
date request, the data set returned relates to the ids that can be retrieved
for that date. A range request will return the records for the requested IDs.

=head1 SYNOPSIS

    # establish the object
    my $query = CPAN::Testers::WWW::Reports::Query::Reports->new;

    # get list of ids for a particular date
    my $result = $query->date(
        '2012-02-08' # must be YYYY-MM-DD format
    );

    # $query is a hash ref
    print "From: $result->{from}, To: $result->{to}, Range: $result->{range}\n";

    # $result->{list} is an array of the actual ids posted for the given date.
    # note that this list may not include all ids within $result->{range}.
    print "List: " . join(', ',@{$result->{list}}) . "\n";


    # get metabase for a range of ids
    my $result = $query->range(
        '20080300-20120330'

        # '20120330'  # just get
        # '20120330-' # from  until the latest [see caveat]
        # '-20120330' # previous  reports up to  [see caveat]
        # '-'         # the latest  reports [see caveat]
    );

    # $result is a hash ref, with the reports ids as the top level keys
    my @ids = sort keys %$result;
    my $id  = $ids[0];
    print "id = $id, dist = '$result->{$id}{dist}', version = '$result->{$id}{version}'\n";


    # get the raw data for all results, or a specific version if supplied
    my $data = $query->raw;


    # get the last error
    my $error = $query->error;

=head2 Caveat

Note that when using the range parameter, at most only 2500 records will be
returned. This is to avoid accidental requests for all records!

This value may change in the future.

=cut

#----------------------------------------------------------------------------
# Library Modules

use WWW::Mechanize;
use JSON::XS;

#----------------------------------------------------------------------------
# Variables

my $URL = 'http://www.cpantesters.org/cgi-bin/reports-metadata.cgi';
#$URL = 'http://reports/cgi-bin/reports-metadata.cgi';    # local test version

my $mech = WWW::Mechanize->new();
$mech->agent_alias( 'Linux Mozilla' );

# -------------------------------------
# Program

sub new {
    my($class, %hash) = @_;
    my $self = {};
    bless $self, $class;

    return $self;
}

sub raw {
    my $self    = shift;
    return $self->{content};
}

sub date {
    my $self    = shift;
    my $date    = shift || return;

    return unless($date =~ /^\d{4}\-\d{2}\-\d{2}$/);

    return unless($self->_request( "date=$date" ));

    return $self->_parse();
}

sub range {
    my $self    = shift;
    my $range   = shift || return;

    return unless($range =~ /^(\d+)?\-(\d+)?$/ || $range =~ /^(\d+)$/);

    return unless($self->_request( "range=$range" ));

    return $self->_parse();
}

sub _request {
    my $self    = shift;
    my $param   = shift;
    $self->{error} = '';

    my $url = join( '?', $URL, $param );
#print STDERR "# URL: $url\n";
	eval { $mech->get( $url ); };
    if($@ || !$mech->success()) {
#print STDERR "# ERROR: $@, ".$mech->success."\n";
        $self->{error} = $@;
        return;
    }

#print STDERR "# CONTENT=".$mech->content."\n";
    $self->{content} = $mech->content;
}

sub _parse {
    my $self    = shift;
    my $data;
    eval { $data = decode_json($self->{content}) };
    return $data    unless($@ || !$data);

    $self->{error} = $@ || 'no data returned';
    return;
}

sub error {
    my $self    = shift;
    return $self->{error};
}

q("With thanks to the 2012 QA Hackathon");

__END__