File Coverage

lib/CPAN/Testers/WWW/Reports/Query/Report.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


line stmt bran cond sub pod time code
1             package CPAN::Testers::WWW::Reports::Query::Report;
2              
3 4     4   89019 use strict;
  4         9  
  4         154  
4 4     4   18 use warnings;
  4         7  
  4         248  
5              
6             our $VERSION = '0.04';
7            
8             #----------------------------------------------------------------------------
9              
10             =head1 NAME
11              
12             CPAN::Testers::WWW::Reports::Query::Report - Retrieve CPAN Testers report direct from the CPAN Testers website.
13              
14             =head1 DESCRIPTION
15            
16             This module queries the CPAN Testers website and retrieves a specific report.
17            
18             =head1 SYNOPSIS
19              
20             # default options
21             my %options = (
22             as_json => 0, # the default
23             as_hash => 0, # the default
24             host => 'http://cpantesters.org' # the default
25             );
26              
27             # establish the object
28             my $query = CPAN::Testers::WWW::Reports::Query::Report->new( %options );
29              
30             The default is to return a Metabase::Fact, as a CPAN::Testers::Report object.
31             If you wish to manipulate this differently, use the as_json or as_hash to
32             return more simplified forms.
33              
34             # get by id
35             my $result = $query->report( report => 40000000 );
36              
37             # get by GUID
38             $result = $query->report( report => '0b3fd09a-7e50-11e3-9609-5744ee331862' );
39              
40             # force return as JSON
41             my $result = $query->report( report => 40000000, as_json => 1 );
42              
43             # force return as a hash
44             my $result = $query->report( report => 40000000, as_hash => 1 );
45              
46             The as_json and as_hash options here will override the general options
47             supplied in the object constructor. If you've specified as_json or as_hash in
48             the object constructor, to override simply set 'as_json => 0' and/or
49             'as_hash => 0' in the method call.
50              
51             # get the last error
52             my $error = $query->error;
53              
54             If the result is returned as undef, either no report was found or the JSON
55             return is malformed. This could be due to network connection, or corrupt data
56             in the report. If the latter please notify the CPAN Testers discussion list,
57             so we can investigate and correct as appropriate.
58              
59             =cut
60            
61             #----------------------------------------------------------------------------
62             # Library Modules
63              
64 4     4   3802 use CPAN::Testers::Report;
  0            
  0            
65             use JSON::XS;
66             use WWW::Mechanize;
67              
68             #----------------------------------------------------------------------------
69             # Variables
70              
71             my $HOST = 'http://www.cpantesters.org';
72             my $PATH = '%s/cpan/report/%s?json=1';
73              
74             my $mech = WWW::Mechanize->new();
75             $mech->agent_alias( 'Linux Mozilla' );
76              
77             # -------------------------------------
78             # Program
79              
80             sub new {
81             my($class, %hash) = @_;
82             my $self = {};
83            
84             $self->{as_json} = $hash{as_json} || 0;
85             $self->{as_hash} = $hash{as_hash} || 0;
86             $self->{host} = $hash{host} || $HOST;
87              
88             bless $self, $class;
89              
90             return $self;
91             }
92              
93             sub report {
94             my $self = shift;
95             my %hash = @_;
96            
97             $self->{error} = '';
98              
99             my $url = sprintf $PATH, $self->{host}, $hash{report};
100             eval { $mech->get( $url ); };
101             if($@ || !$mech->success()) {
102             $self->{error} = "No response from server: $@";
103             return;
104             }
105              
106             $self->{content} = $mech->content;
107              
108             my $data;
109             eval {
110             $data = decode_json($self->{content});
111             };
112              
113             if($@ || !$data) {
114             $self->{error} = "JSON decoding error: " . ($@ || 'no data returned');
115             return;
116             }
117              
118             unless($data->{success}) {
119             $self->{error} = "no report found";
120             return;
121             }
122              
123             my $as = ($hash{as_json} || (!defined $hash{as_json} && $self->{as_json})) ? 'json' : '';
124             $as ||= ($hash{as_hash} || (!defined $hash{as_hash} && $self->{as_hash})) ? 'hash' : 'fact';
125              
126             return encode_json($data->{result}) if($as eq 'json');
127             return $data->{result} if($as eq 'hash');
128              
129             return $self->_parse($data->{result});
130             }
131              
132             sub _parse {
133             my ($self,$data) = @_;
134             my $hash;
135              
136             if(!$data) {
137             $self->{error} = 'no data returned';
138             return;
139             }
140              
141             for my $content (@{ $data->{content} }) {
142             $content->{content} = encode_json($content->{content});
143             }
144             $data->{content} = encode_json($data->{content});
145              
146             my $fact = CPAN::Testers::Report->from_struct( $data ) ;
147             return $fact;
148              
149             $self->{hash} = $data;
150             return $data;
151             }
152              
153             sub error {
154             my $self = shift;
155             return $self->{error};
156             }
157              
158             q("With thanks to the 2014 QA Hackathon");
159              
160             __END__