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


line stmt bran cond sub pod time code
1             package CPAN::Testers::WWW::Reports::Query::Reports;
2              
3 7     7   121402 use strict;
  7         14  
  7         254  
4 7     7   30 use warnings;
  7         11  
  7         384  
5              
6             our $VERSION = '0.10';
7            
8             #----------------------------------------------------------------------------
9              
10             =head1 NAME
11              
12             CPAN::Testers::WWW::Reports::Query::Reports - Retrieve CPAN Testers metadata direct from the CPAN Testers website.
13              
14             =head1 DESCRIPTION
15            
16             This module queries the CPAN Testers website and retrieves a data set. For a
17             date request, the data set returned relates to the ids that can be retrieved
18             for that date. A range request will return the records for the requested IDs.
19            
20             =head1 SYNOPSIS
21              
22             # establish the object
23             my $query = CPAN::Testers::WWW::Reports::Query::Reports->new;
24              
25             # get list of ids for a particular date
26             my $result = $query->date(
27             '2012-02-08' # must be YYYY-MM-DD format
28             );
29              
30             # $query is a hash ref
31             print "From: $result->{from}, To: $result->{to}, Range: $result->{range}\n";
32              
33             # $result->{list} is an array of the actual ids posted for the given date.
34             # note that this list may not include all ids within $result->{range}.
35             print "List: " . join(', ',@{$result->{list}}) . "\n";
36              
37              
38             # get metabase for a range of ids
39             my $result = $query->range(
40             '20080300-20120330'
41              
42             # '20120330' # just get
43             # '20120330-' # from until the latest [see caveat]
44             # '-20120330' # previous reports up to [see caveat]
45             # '-' # the latest reports [see caveat]
46             );
47              
48             # $result is a hash ref, with the reports ids as the top level keys
49             my @ids = sort keys %$result;
50             my $id = $ids[0];
51             print "id = $id, dist = '$result->{$id}{dist}', version = '$result->{$id}{version}'\n";
52              
53              
54             # get the raw data for all results, or a specific version if supplied
55             my $data = $query->raw;
56              
57              
58             # get the last error
59             my $error = $query->error;
60              
61             =head2 Caveat
62              
63             Note that when using the range parameter, at most only 2500 records will be
64             returned. This is to avoid accidental requests for all records!
65              
66             This value may change in the future.
67              
68             =cut
69            
70             #----------------------------------------------------------------------------
71             # Library Modules
72              
73 7     7   5295 use WWW::Mechanize;
  7         960507  
  7         275  
74 7     7   4625 use JSON::XS;
  7         28210  
  7         3134  
75              
76             #----------------------------------------------------------------------------
77             # Variables
78              
79             my $URL = 'http://www.cpantesters.org/cgi-bin/reports-metadata.cgi';
80             #$URL = 'http://reports/cgi-bin/reports-metadata.cgi'; # local test version
81              
82             my $mech = WWW::Mechanize->new();
83             $mech->agent_alias( 'Linux Mozilla' );
84              
85             # -------------------------------------
86             # Program
87              
88             sub new {
89 2     2 1 136 my($class, %hash) = @_;
90 2         4 my $self = {};
91 2         5 bless $self, $class;
92              
93 2         4 return $self;
94             }
95              
96             sub raw {
97 6     6 1 11 my $self = shift;
98 6         26 return $self->{content};
99             }
100            
101             sub date {
102 4     4 1 12372 my $self = shift;
103 4   100     17 my $date = shift || return;
104              
105 3 100       25 return unless($date =~ /^\d{4}\-\d{2}\-\d{2}$/);
106            
107 2 100       24 return unless($self->_request( "date=$date" ));
108              
109 1         7 return $self->_parse();
110             }
111              
112             sub range {
113 10     10 1 42958 my $self = shift;
114 10   100     39 my $range = shift || return;
115              
116 9 100 100     91 return unless($range =~ /^(\d+)?\-(\d+)?$/ || $range =~ /^(\d+)$/);
117              
118 8 50       33 return unless($self->_request( "range=$range" ));
119              
120 8         236 return $self->_parse();
121             }
122              
123             sub _request {
124 10     10   15 my $self = shift;
125 10         13 my $param = shift;
126 10         27 $self->{error} = '';
127              
128 10         27 my $url = join( '?', $URL, $param );
129             #print STDERR "# URL: $url\n";
130 10         17 eval { $mech->get( $url ); };
  10         40  
131 10 100 66     181455682 if($@ || !$mech->success()) {
132             #print STDERR "# ERROR: $@, ".$mech->success."\n";
133 1         6 $self->{error} = $@;
134 1         9 return;
135             }
136              
137             #print STDERR "# CONTENT=".$mech->content."\n";
138 9         129 $self->{content} = $mech->content;
139             }
140              
141             sub _parse {
142 9     9   12 my $self = shift;
143 9         13 my $data;
144 9         10 eval { $data = decode_json($self->{content}) };
  9         24970  
145 9 50 33     87 return $data unless($@ || !$data);
146              
147 0   0     0 $self->{error} = $@ || 'no data returned';
148 0         0 return;
149             }
150              
151             sub error {
152 19     19 1 961 my $self = shift;
153 19         82 return $self->{error};
154             }
155              
156             q("With thanks to the 2012 QA Hackathon");
157              
158             __END__