File Coverage

blib/lib/WebService/Linode/Base.pm
Criterion Covered Total %
statement 18 102 17.6
branch 0 30 0.0
condition 0 19 0.0
subroutine 6 20 30.0
pod 9 9 100.0
total 33 180 18.3


line stmt bran cond sub pod time code
1             package WebService::Linode::Base;
2              
3 1     1   69424 use warnings;
  1         3  
  1         35  
4 1     1   6 use strict;
  1         3  
  1         21  
5              
6 1     1   5 use Carp;
  1         2  
  1         68  
7 1     1   779 use JSON;
  1         12689  
  1         7  
8 1     1   837 use LWP::UserAgent;
  1         48642  
  1         43  
9              
10 1     1   763 use Data::Dumper;
  1         7060  
  1         1184  
11              
12             =head1 NAME
13              
14             WebService::Linode::Base - Perl Interface to the Linode.com API.
15              
16             =cut
17              
18             our $VERSION = '0.29';
19             our $err;
20             our $errstr;
21              
22             sub new {
23 0     0 1   my ($package, %args) = @_;
24 0           my $self;
25              
26 0 0         $self->{_apikey} = $args{apikey} if $args{apikey};
27              
28 0   0       $self->{_nocache} = $args{nocache} || 0;
29 0   0       $self->{_debug} = $args{debug} || 0;
30 0   0       $self->{_fatal} = $args{fatal} || 0;
31 0   0       $self->{_nowarn} = $args{nowarn} || 0;
32 0   0       $self->{_apiurl} = $args{apiurl} || 'https://api.linode.com/api/';
33              
34             # env api url supercedes all
35 0 0         $self->{_apiurl} = $ENV{LINODE_API_URL} if $ENV{LINODE_API_URL};
36              
37 0           $self->{_ua} = LWP::UserAgent->new;
38 0           $self->{_ua}->agent("WebService::Linode::Base/$WebService::Linode::Base::VERSION ");
39 0 0         $self->{_ua}->agent($args{useragent}) if $args{useragent};
40              
41             # set up storage for queued requests
42 0           $self->{_batch_queue} = [];
43              
44 0           bless $self, $package;
45 0           return $self;
46             }
47              
48             sub apikey {
49 0     0 1   my $self = shift;
50 0 0         $self->{_apikey} = shift if @_ == 1;
51 0           return $self->{_apikey};
52             }
53              
54             sub do_request {
55 0     0 1   my ($self, %args) = @_;
56              
57 0           my $response = $self->send_request(%args);
58 0           return $self->parse_response($response);
59             }
60              
61             sub send_request {
62 0     0 1   my ($self, %args) = @_;
63              
64             {
65 0     0     local $SIG{__WARN__} = sub {};
  0            
66 0           $self->_debug(10, "About to send request: " . join(' ' , %args));
67             }
68              
69 0 0         $args{api_key} = $self->{_apikey} if $self->{_apikey};
70              
71 0           return $self->{_ua}->post( $self->{_apiurl}, content => { %args } );
72             }
73              
74             sub queue_request {
75 0     0 1   my ($self, %args) = @_;
76 0           my $queue = $self->{_batch_queue};
77              
78 0           $self->_debug(10, "Queueing request for batch: " . join(' ' , %args));
79 0           push @$queue, \%args;
80              
81             # return current number of items in the queue
82 0           return scalar @$queue;
83             }
84              
85             sub list_queue {
86 0     0 1   my $self = shift;
87 0           my $queue = $self->{_batch_queue};
88 0           return @$queue;
89             }
90              
91             sub clear_queue {
92 0     0 1   my $self = shift;
93 0           my $queue = $self->{_batch_queue};
94 0           @$queue = ();
95 0           return @$queue;
96             }
97              
98             sub process_queue {
99 0     0 1   my ($self,$maxitems) = @_;
100 0           my $queue = $self->{_batch_queue};
101             # Default to processing the entire queue, cap at queue length
102 0 0 0       $maxitems = @$queue if not defined $maxitems or $maxitems > @$queue;
103              
104 0           my @todo = splice @$queue, 0, $maxitems;
105 0           my $batch_json = to_json( \@todo );
106              
107 0           return $self->do_request( api_action=>'batch', api_requestArray=>$batch_json );
108             }
109              
110             sub parse_response {
111 0     0 1   my $self = shift;
112 0           my $response = shift;
113              
114 0 0         if ( $response->content =~ m|ERRORARRAY|i ) {
    0          
115 0           $self->_debug(10, "Received response: " . $response->content );
116 0           my $json = from_json( $response->content );
117 0 0         if ( ref $json eq 'ARRAY' ) {
118 0           return map { $self->_parse_api_response_data( $_ ) } @$json;
  0            
119             }
120             else {
121 0           return $self->_parse_api_response_data( $json );
122             }
123             }
124             elsif ( $response->status_line ) {
125 0           $self->_error( -1, $response->status_line );
126 0           return;
127             }
128             else {
129 0           $self->_error( -1, 'No JSON found' );
130 0           return;
131             }
132             }
133              
134             sub _parse_api_response_data {
135 0     0     my $self = shift;
136 0           my $rdata = shift;
137              
138 0           my $errors = $rdata->{ERRORARRAY};
139 0 0 0       if ( not $errors or ref $errors ne 'ARRAY' ) {
140 0           $self->_error( -1, 'Invalid response: ERRORARRAY missing or invalid' );
141 0           return;
142             }
143              
144 0 0         return $rdata->{DATA} if @$errors == 0;
145 0 0 0       return $rdata->{DATA} if @$errors == 1 and $errors->[0]{ERRORCODE} == 0;
146              
147             # If we've reached here, there's an error to report
148             # TODO this only returns the first error from the API
149 0           my $error = $rdata->{ERRORARRAY}->[0];
150 0           my $msg = "API Error $error->{ERRORCODE}: $error->{ERRORMESSAGE}";
151 0           $self->_error( $error->{ERRORCODE}, $msg );
152 0           return;
153             }
154              
155             sub _lc_keys {
156 0     0     my ($self, $hashref) = @_;
157              
158 0           return { map { lc($_) => $hashref->{$_} } keys (%$hashref) };
  0            
159             }
160              
161             sub _error {
162 0     0     my $self = shift;
163 0           my $code = shift;
164 0           my $msg = shift;
165              
166 0           $err = $code;
167 0           $errstr = $msg;
168              
169 0 0         croak $msg if $self->{_fatal};
170 0 0         carp $msg unless $self->{_nowarn};
171             }
172              
173             sub _debug {
174 0     0     my $self = shift;
175 0           my $level = shift;
176 0           my $msg = shift;
177              
178 0 0         print STDERR $msg, "\n" if $self->{_debug} >= $level;
179             }
180              
181             =head1 SYNOPSIS
182              
183             This module provides a simple OOish interface to the Linode.com API.
184              
185             Example usage:
186              
187             use WebService::Linode::Base;
188              
189             my $api = WebService::Linode::Base->new(apikey => 'mmmcake');
190             my $data = $api->do_request( api_action => 'domains.list' );
191              
192             =head1 METHODS
193              
194             =head2 new
195              
196             All methods take the same parameters as the Linode API itself does. Field
197             names should be lower cased. All caps fields from the Linode API will be
198             lower cased before returning the data.
199              
200             Accepts a hash as an argument. apikey is the only required parameter
201             specifying your Linode API key.
202              
203             Errors mirror the perl DBI error handling method.
204             $WebService::Linode::Base::err and ::errstr will be populated with the last error
205             number and string that occurred. All errors generated within the module
206             are currently error code -1. By default, will warn on errors as well, pass
207             a true value for fatal to die instead, or nowarn to prevent the warnings.
208              
209             verbose is 0-10 with 10 being the most and 0 being none
210              
211             useragent if passed gets passed on to the LWP::UserAgent agent method to set
212             a custom user agent header on HTTP requests.
213              
214             apiurl if passed overides the default URL for API requests. You may also use
215             the environment variable LINODE_API_URL. If set, the environment variable
216             supersedes any apiurl argument supplied to the constructor, useful for testing.
217              
218             =head2 send_request
219              
220             Sends a request to the API, takes a hash of name=>value pairs. Returns an
221             HTTP::Response object.
222              
223             =head2 parse_response
224              
225             Takes an HTTP::Response object and parses the API
226             response returning just the DATA section.
227              
228             =head2 do_request
229              
230             Executes the send_request method, parses the response with the parse_response
231             method and returns the data.
232              
233             =head2 queue_request
234              
235             Takes same arguments as send_request, but queues the request to be handled by
236             a single batch request later.
237              
238             =head2 list_queue
239              
240             Returns list of queued requests.
241              
242             =head2 clear_queue
243              
244             Clears batch request queue.
245              
246             =head2 process_queue
247              
248             Sends queued items in a batch request. Takes an optional number of items to
249             send in the batch request, defaulting to all queued requests. Returns an api
250             reponse for each batch item.
251              
252             =head2 apikey
253              
254             Takes one optional argument, an apikey that if passed replaces the key
255             currently in use. Returns the current (or new) apikey.
256              
257             Returns the apikey
258              
259             =head1 AUTHOR
260              
261             Michael Greb, C<< >>
262              
263             =head1 BUGS
264              
265             This module does not yet support the Linode API batch method, patches welcome.
266              
267             Please report any bugs or feature requests to C
268             at rt.cpan.org>, or through the web interface at
269             L. I will
270             be notified, and then you'll automatically be notified of progress on your
271             bug as I make changes.
272              
273             =head1 SUPPORT
274              
275             You can find documentation for this module with the perldoc command.
276              
277             perldoc WebService::Linode::Base
278              
279              
280             You can also look for information at:
281              
282             =over 4
283              
284             =item * Module Repo
285              
286             L
287              
288             =item * RT: CPAN's request tracker
289              
290             L
291              
292             =item * AnnoCPAN: Annotated CPAN documentation
293              
294             L
295              
296             =item * CPAN Ratings
297              
298             L
299              
300             =item * Search CPAN
301              
302             L
303              
304             =back
305              
306              
307             =head1 ACKNOWLEDGEMENTS
308              
309              
310             =head1 COPYRIGHT & LICENSE
311              
312             Copyright 2008-2014 Michael Greb, all rights reserved.
313              
314             This program is free software; you can redistribute it and/or modify it
315             under the same terms as Perl itself.
316              
317             =cut
318              
319             'urmom';