File Coverage

lib/CPAN/Testers/WWW/Reports/Query/Report.pm
Criterion Covered Total %
statement 56 66 84.8
branch 15 18 83.3
condition 14 24 58.3
subroutine 9 10 90.0
pod 4 4 100.0
total 98 122 80.3


line stmt bran cond sub pod time code
1             package CPAN::Testers::WWW::Reports::Query::Report;
2              
3 6     6   109165 use strict;
  6         8  
  6         134  
4 6     6   18 use warnings;
  6         7  
  6         239  
5              
6             our $VERSION = '0.05';
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 6     6   1910 use CPAN::Testers::Report;
  6         155453  
  6         153  
65 6     6   2999 use JSON::XS;
  6         12866  
  6         335  
66 6     6   4331 use WWW::Mechanize;
  6         600353  
  6         2391  
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 15     15 1 16462 my($class, %hash) = @_;
82 15         36 my $self = {};
83            
84 15   100     96 $self->{as_json} = $hash{as_json} || 0;
85 15   100     75 $self->{as_hash} = $hash{as_hash} || 0;
86 15   66     96 $self->{host} = $hash{host} || $HOST;
87              
88 15         38 bless $self, $class;
89              
90 15         40 return $self;
91             }
92              
93             sub report {
94 14     14 1 3709 my $self = shift;
95 14         52 my %hash = @_;
96            
97 14         41 $self->{error} = '';
98              
99 14         82 my $url = sprintf $PATH, $self->{host}, $hash{report};
100 14         18 eval { $mech->get( $url ); };
  14         61  
101 14 50 33     1030601 if($@ || !$mech->success()) {
102 0         0 $self->{error} = "No response from server: $@";
103 0         0 return;
104             }
105              
106 14         322 $self->{content} = $mech->content;
107 14 50       283 unless($self->{content}) {
108 0         0 $self->{error} = 'no data returned by the server';
109 0         0 return;
110             }
111              
112 14         29 my $data;
113 14         30 eval {
114 14         1041 $data = decode_json($self->{content});
115             };
116              
117 14 50 33     83 if($@ || !$data) {
118 0   0     0 $self->{error} = "JSON decoding error: " . ($@ || 'no data returned');
119 0         0 return;
120             }
121              
122 14 100       54 unless($data->{success}) {
123 1         3 $self->{error} = "no report found";
124 1         38 return;
125             }
126              
127 13 100 66     114 my $as = ($hash{as_json} || (!defined $hash{as_json} && $self->{as_json})) ? 'json' : '';
128 13 100 66     78 $as ||= ($hash{as_hash} || (!defined $hash{as_hash} && $self->{as_hash})) ? 'hash' : 'fact';
      66        
129              
130 13 100       466 return encode_json($data->{result}) if($as eq 'json');
131 6 100       30 return $data->{result} if($as eq 'hash');
132              
133 3         19 return $self->_parse($data->{result});
134             }
135              
136             sub _parse {
137 4     4   209 my ($self,$data) = @_;
138 4         4 my $hash;
139              
140 4 100       12 if(!$data) {
141 1         3 $self->{error} = 'no data returned';
142 1         2 return;
143             }
144              
145 3         3 for my $content (@{ $data->{content} }) {
  3         9  
146 6         172 $content->{content} = encode_json($content->{content});
147             }
148 3         146 $data->{content} = encode_json($data->{content});
149              
150 3         54 my $fact = CPAN::Testers::Report->from_struct( $data ) ;
151 3         10572 return $fact;
152              
153 0         0 $self->{hash} = $data;
154 0         0 return $data;
155             }
156              
157             sub content {
158 0     0 1 0 my $self = shift;
159 0         0 return $self->{content};
160             }
161              
162             sub error {
163 16     16 1 13746 my $self = shift;
164 16         61 return $self->{error};
165             }
166              
167             q("With thanks to the 2014 QA Hackathon");
168              
169             __END__