File Coverage

blib/lib/WebService/Geograph/Request.pm
Criterion Covered Total %
statement 34 89 38.2
branch 3 70 4.2
condition 0 48 0.0
subroutine 8 13 61.5
pod 1 4 25.0
total 46 224 20.5


line stmt bran cond sub pod time code
1             package WebService::Geograph::Request;
2              
3 2     2   15 use warnings ;
  2         5  
  2         56  
4 2     2   10 use strict ;
  2         3  
  2         53  
5 2     2   1908 use HTTP::Request ;
  2         56806  
  2         71  
6 2     2   19 use URI;
  2         4  
  2         41  
7 2     2   2175 use Date::Simple () ;
  2         16848  
  2         48  
8              
9 2     2   2236 use Data::Dumper ;
  2         24723  
  2         2477  
10              
11             our @ISA = qw (HTTP::Request) ;
12             our $VERSION = '0.05' ;
13              
14             =head1 NAME
15              
16             WebService::Geograph::Request - A request object to the Geograph API
17              
18             =head1 SYNOPSIS
19              
20             use WebService::Geograph::API;
21            
22             my $api = new WebService::Geograph::API ( { 'key' => 'your_api_key_here'} ) ;
23              
24             my $rv = $api->lookup ( 'csv', { 'i' => 12345,
25             'll' => 1,
26             'thumb' => 1,
27             }) ;
28              
29             my $data = $rd->{results} ;
30              
31             =head1 DESCRIPTION
32              
33             This object encapsulates a single request and its parameters
34             the user specified to the Geograph API sevice.
35              
36             The C object is essentially a subclass of C so you can
37             actually edit its usual parameters as much as you want.
38              
39             =cut
40              
41             =head1 AUTHOR
42              
43             Spiros Denaxas
44             CPAN ID: SDEN
45             Lokku Ltd ( http://www.nestoria.co.uk )
46             s [dot] denaxas [@] gmail [dot]com
47              
48             =head1 COPYRIGHT
49              
50             This program is free software; you can redistribute
51             it and/or modify it under the same terms as Perl itself.
52              
53             The full text of the license can be found in the
54             LICENSE file included with this module.
55              
56             =cut
57              
58             =head1 SEE ALSO
59              
60             L, L, L, L
61              
62             =cut
63              
64             sub new {
65 1     1 1 3 my $class = shift ;
66 1         21 my $self = new HTTP::Request ;
67 1         58 my $mode = shift ;
68 1         2 my $rh_args = shift ;
69            
70 1         3 $self->{mode} = $mode ;
71 1         3 $self->{args} = $rh_args ;
72            
73 1         8 bless $self, $class ;
74            
75 1         10 $self->method('POST') ;
76 1         15 my $uri = &_get_uri_for_mode($mode) ;
77            
78 1 50       4 if (not defined $uri) {
79 1         53 warn "Invalid/Unsupported mode selected: $mode\nPlease look at the documentation for supported modes.\n" ;
80 1         17 return undef ;
81             }
82            
83 0         0 $self->{uri} = $uri;
84            
85 0         0 return $self ;
86            
87             }
88              
89             sub encode_args {
90 0     0 0 0 my $self = shift ;
91            
92 0         0 my $args = $self->{args} ;
93 0         0 my $url = URI->new( $self->{uri}, 'http' ) ;
94            
95 0         0 &validate_request_args($self->{mode}, $args) ;
96            
97            
98 0         0 $url->query_form( %$args ) ;
99 0         0 return $url ;
100              
101              
102             } ;
103              
104              
105             sub validate_request_args {
106 0     0 0 0 my ($mode, $rh_args) = (@_) ;
107            
108             # make an initial check for missing values for any arguments.
109 0         0 foreach (keys %$rh_args) {
110 0 0       0 &error_and_exit("Missing value for argument: $_.\n")
111             unless (defined $rh_args->{$_}) ;
112             }
113            
114             # fire up mode-specific validation.
115 0 0       0 if ($mode eq 'csv') {
    0          
116 0 0       0 return 1 if (&_validate_csv_args($rh_args)) ;
117             } elsif ($mode eq 'search') {
118 0 0       0 return 1 if (&_validate_search_args($rh_args)) ;
119             }
120              
121             }
122              
123             sub _validate_search_args {
124 0     0   0 my $rh_args = shift ;
125            
126 0 0       0 unless (exists $rh_args->{q}) {
127 0         0 &error_and_exit("You must specify a search value using the q variable") ;
128             }
129 0         0 return 1 ;
130             }
131              
132              
133             sub _validate_csv_args {
134 0     0   0 my $rh_args = shift ;
135            
136 0 0       0 if (exists $rh_args->{i}) {
137 0 0 0     0 &error_and_exit("Invalid i value set.\nThe limit must be a numeric value.\n")
138             unless (($rh_args->{i} =~ m/\d/) and ($rh_args->{i} !~ m/[a-zA-z]/)) ;
139 0 0 0     0 &error_and_exit("The i switch cannot be combined with any other switches.\n")
      0        
      0        
140             if ( (exists $rh_args->{since}) or (exists $rh_args->{limit}) or (exists $rh_args->{ri})
141             or (exists $rh_args->{'last'}) ) ;
142             } # end of i validation.
143            
144 0 0       0 if (exists $rh_args->{count}) {
145 0 0       0 &error_and_exit("The count switch cannot be used unless the i switch is used.\n")
146             unless (exists $rh_args->{i}) ;
147 0 0 0     0 &error_and_exit("Invalid count value, must be numeric.\n")
148             unless (($rh_args->{count} =~ m/\d/) and ($rh_args->{count} !~ m/[a-zA-z]/)) ;
149             } # end of count valiation.
150            
151 0 0       0 if (exists $rh_args->{page}) {
152 0 0       0 &error_and_exit("The count switch cannot be used unless the i switch is used.\n")
153             unless (exists $rh_args->{i}) ;
154 0 0 0     0 &error_and_exit("Invalid page value, must be numeric.\n")
155             unless (($rh_args->{page} =~ m/\d/) and ($rh_args->{page} !~ m/[a-zA-z]/)) ;
156             } # end of page valiation.
157            
158            
159 0 0       0 if (exists $rh_args->{since}) {
160 0         0 my $date = $rh_args->{since} ;
161 0 0       0 &error_and_exit("Invalid date supplied.\nDates must be supplied in YYYY-MM-DD format.\n")
162             unless (defined (Date::Simple->new($date))) ;
163             } # end of date validation.
164            
165 0 0       0 if (exists $rh_args->{limit}) {
166 0 0 0     0 &error_and_exit("Invalid limit set.\nThe limit must be a numeric value.\n")
167             unless (($rh_args->{limit} =~ m/\d/) and ($rh_args->{limit} !~ m/[a-zA-z]/)) ;
168             } # end of limit validation
169            
170 0 0       0 if (exists $rh_args->{ri}) {
171 0 0 0     0 &error_and_exit("Invalid National Grid value supplied.\nCan either be 1 (GB) or 2 (IE).\n")
172             unless (($rh_args->{ri} == 1) or ($rh_args->{ri} == 2)) ;
173             } # end of national gril validation
174            
175 0 0       0 if (exists $rh_args->{'last'}) {
176            
177 0         0 my $rh_valid_intervals = {
178             'MINUTE' => 1,
179             'HOUR' => 1,
180             'DAY' => 1,
181             'YEAR' => 1,
182             'MONTH' => 1,
183             'WEEK' => 1,
184             };
185            
186 0         0 my ($number, $interval) = split /\+/, $rh_args->{last} ;
187            
188 0 0 0     0 &error_and_exit("Invalid formatting for last switch.\n")
      0        
      0        
      0        
189             unless ( (($number) and ($interval)) and
190             (($number =~ m/\d/) and ($number !~ m/[a-zA-Z]/)) and
191             ( exists $rh_valid_intervals->{$interval})
192             ) ;
193             } # end of last validation
194            
195 0 0       0 if (exists $rh_args->{thumb}) {
196 0 0 0     0 &error_and_exit("Invalid thumb value.\nCan either be 1 or 0.\n")
197             unless (($rh_args->{thumb} == 1) or ($rh_args->{thumb} == 1) ) ;
198             } # end of thumb validation
199            
200 0 0       0 if (exists $rh_args->{en}) {
201 0 0 0     0 &error_and_exit("Invalid en value.\nCan either be 1 or 0.\n")
202             unless (($rh_args->{en} == 1) or ($rh_args->{en} == 1) ) ;
203 0 0       0 &error_and_exit("The en switch cannot be combined with the ll switch.\n")
204             if ( exists $rh_args->{ll}) ;
205             } # end of en validation.
206            
207 0 0       0 if (exists $rh_args->{ll}) {
208 0 0 0     0 &error_and_exit("Invalid ll value.\nCan either be 1 or 0.\n")
209             unless (($rh_args->{ll} == 1) or ($rh_args->{ll} == 0) ) ;
210 0 0       0 &error_and_exit("The ll switch cannot be combined with the en switch.\n")
211             if ( exists $rh_args->{en}) ;
212             } # end of ll validation.
213            
214 0         0 return 1 ;
215             }
216              
217             sub error_and_exit {
218 0     0 0 0 my $message = shift ;
219 0         0 warn $message ;
220 0         0 exit(0) ;
221             }
222              
223             sub _get_uri_for_mode {
224 1     1   2 my $mode = shift ;
225 1 50       9 return unless defined $mode ;
226            
227 1         4 my $rh_valid_modes = {
228             'csv' => 'CSV Export',
229             'search' => 'Search Query Building'
230             } ;
231            
232 1 50       10 return unless exists $rh_valid_modes->{$mode} ;
233            
234 0           my $rh_mode_uri_map = {
235             'csv' => 'http://www.geograph.org.uk/export.csv.php',
236             'search' => 'http://www.geograph.org.uk/search.php'
237             } ;
238            
239 0 0 0       return unless (exists $rh_mode_uri_map->{$mode}) && (defined $rh_mode_uri_map->{$mode}) ;
240            
241 0           my $uri = $rh_mode_uri_map->{$mode} ;
242 0           return $uri ;
243            
244             }