File Coverage

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

Criterion	Covered	Total	%
statement	51	59	86.4
branch	12	16	75.0
condition	14	24	58.3
subroutine	9	9	100.0
pod	3	3	100.0
total	89	111	80.1

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

use strict;
use warnings;

our $VERSION = '0.03';

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

=head1 NAME

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

=head1 DESCRIPTION

This module queries the CPAN Testers website and retrieves a specific report.

=head1 SYNOPSIS

    # default options
    my %options = (
        as_json => 0,                       # the default
        as_hash => 0,                       # the default
        host    => 'http://cpantesters.org' # the default
    );

    # establish the object
    my $query = CPAN::Testers::WWW::Reports::Query::Report->new( %options );

The default is to return a Metabase::Fact, as a CPAN::Testers::Report object.
If you wish to manipulate this differently, use the as_json or as_hash to
return more simplified forms.

    # get by id
    my $result = $query->report( report => 40000000 );

    # get by GUID
    $result = $query->report( report => '0b3fd09a-7e50-11e3-9609-5744ee331862' );

    # force return as JSON
    my $result = $query->report( report => 40000000, as_json => 1 );

    # force return as a hash
    my $result = $query->report( report => 40000000, as_hash => 1 );

The as_json and as_hash options here will override the general options
supplied in the object constructor. If you've specified as_json or as_hash in
the object constructor, to override simply set 'as_json => 0' and/or
'as_hash => 0' in the method call.

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

If the result is returned as undef, either no report was found or the JSON
return is malformed. This could be due to network connection, or corrupt data
in the report. If the latter please notify the CPAN Testers discussion list,
so we can investigate and correct as appropriate.

=cut

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

use CPAN::Testers::Report;
use JSON::XS;
use WWW::Mechanize;

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

my $HOST = 'http://www.cpantesters.org';
my $PATH = '%s/cpan/report/%s?json=1';

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

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

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

    $self->{as_json} = $hash{as_json}   || 0;
    $self->{as_hash} = $hash{as_hash}   || 0;
    $self->{host}    = $hash{host}      || $HOST;

    bless $self, $class;

    return $self;
}

sub report {
    my $self    = shift;
    my %hash    = @_;

    $self->{error} = '';

    my $url = sprintf $PATH, $self->{host}, $hash{report};
	eval { $mech->get( $url ); };
    if($@ || !$mech->success()) {
        $self->{error} = "No response from server: $@";
        return;
    }

    $self->{content} = $mech->content;

    my $data;
    eval {
        $data = decode_json($self->{content});
    };

    if($@ || !$data) {
        $self->{error} = "JSON decoding error: " . ($@ || 'no data returned');
        return;
    }

    return unless($data->{success});

    my $as = ($hash{as_json} || (!defined $hash{as_json} && $self->{as_json})) ? 'json' : '';
    $as  ||= ($hash{as_hash} || (!defined $hash{as_hash} && $self->{as_hash})) ? 'hash' : 'fact';

    return encode_json($data->{result}) if($as eq 'json');
    return $data->{result}              if($as eq 'hash');

    return $self->_parse($data->{result});
}

sub _parse {
    my ($self,$data) = @_;
    my $hash;

    if(!$data) {
        $self->{error} = 'no data returned';
        return;
    }

    for my $content (@{ $data->{content} }) {
        $content->{content} = encode_json($content->{content});
    }
    $data->{content} = encode_json($data->{content});

    my $fact = CPAN::Testers::Report->from_struct( $data ) ;
    return $fact;

    $self->{hash} = $data;
    return $data;
}

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

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

__END__