File Coverage

blib/lib/WebService/Xero/Agent.pm
Criterion Covered Total %
statement 76 106 71.7
branch 10 24 41.6
condition 16 36 44.4
subroutine 21 25 84.0
pod 8 8 100.0
total 131 199 65.8


line stmt bran cond sub pod time code
1             package WebService::Xero::Agent;
2              
3              
4 3     3   60623 use 5.006;
  3         10  
5 3     3   13 use strict;
  3         4  
  3         52  
6 3     3   10 use warnings;
  3         3  
  3         59  
7 3     3   10 use Carp;
  3         4  
  3         182  
8              
9 3     3   2096 use LWP::UserAgent;
  3         110168  
  3         104  
10 3     3   74 use HTTP::Request;
  3         5  
  3         77  
11 3     3   1374 use Mozilla::CA;
  3         627  
  3         81  
12 3     3   488 use Config::Tiny;
  3         856  
  3         67  
13 3     3   2063 use JSON;
  3         30472  
  3         16  
14 3     3   2909 use XML::Simple;
  3         22305  
  3         22  
15 3     3   258 use Digest::MD5 qw( md5_base64 );
  3         6  
  3         171  
16 3     3   531 use URI::Encode qw(uri_encode uri_decode );
  3         10364  
  3         195  
17 3     3   1658 use Data::Random qw( rand_chars );
  3         30665  
  3         277  
18 3     3   1616 use Net::OAuth 0.20;
  3         1861  
  3         132  
19             $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A;
20              
21 3     3   1393 use WebService::Xero::Organisation;
  3         6  
  3         2630  
22              
23              
24             =head1 NAME
25              
26             WebService::Xero::Agent - Base Class for API Connections
27              
28             =head1 VERSION
29              
30             Version 0.11
31              
32             =cut
33              
34             our $VERSION = '0.11';
35              
36              
37             =head1 SYNOPSIS
38              
39             This is the base class for the Xero API agents that integrate with the Xero Web Application APIs.
40              
41             You should not need to use this directly but should use one of the derived classes.
42              
43             see the following for usage examples:
44              
45             perldoc WebService::Xero::Agent::PrivateApplication
46             perldoc WebService::Xero::Agent::PublicApplication
47              
48              
49              
50             =head1 METHODS
51              
52             =head2 new()
53              
54             default base constructor - includes properties used by child classes.
55              
56             =cut
57              
58             sub new
59             {
60 2     2 1 403 my ( $class, %params ) = @_;
61              
62             my $self = bless
63             {
64             NAME => $params{NAME} || 'Unnamed Application',
65             CONSUMER_KEY => $params{CONSUMER_KEY} || '',
66             CONSUMER_SECRET => $params{CONSUMER_SECRET} || "",
67             PRIVATE_KEY => $params{PRIVATE_KEY} || '',
68             keystring => $params{keystring} || undef,
69             internal_consumer_key => $params{internal_consumer_key} || "",
70             internal_token => $params{internal_token} || "",
71             internal_token_secret => $params{internal_token_secret} || "",
72             pko => $params{pko} || undef,
73 2   50     62 ua => LWP::UserAgent->new(ssl_opts => { verify_hostname => 1 },),
      100        
      100        
      100        
      50        
      50        
      50        
      50        
      50        
74             _status => undef,
75             }, $class;
76 2         2624 return $self->_validate_agent(); ## derived classes to validate required properties
77             }
78              
79              
80             =head2 _validate_agent()
81              
82             To be implemented in derived classes to validate the configuration of the agent.
83              
84             =cut
85              
86             sub _validate_agent
87             {
88 0     0   0 my ( $self ) = @_;
89 0         0 return $self->_error('base class not meant for instantiation');
90             }
91              
92              
93              
94             =head2 get_all_xero_products_from_xero()
95              
96             Experimental: a shortcut to do_xero_api_call
97              
98             =cut
99             #####################################
100             sub get_all_xero_products_from_xero
101             {
102 1     1 1 2 my ( $self ) = @_;
103             #my $data = $self->_do_xero_get( q{https://api.xero.com/api.xro/2.0/Items} );
104 1   50     5 my $data = $self->do_xero_api_call( q{https://api.xero.com/api.xro/2.0/Items} ) || return $self->_error('get_all_xero_products_from_xero() failed');
105 0         0 return $data;
106             }
107             #####################################
108              
109              
110             =head2 get_all_customer_invoices_from_xero()
111              
112             Experimental: a shortcut to do_xero_api_call
113              
114             =cut
115              
116             #####################################
117             sub get_all_customer_invoices_from_xero
118             {
119 0     0 1 0 my ( $self, $xero_cref ) = @_;
120 0         0 my $ret = [];
121 0         0 my $ext = uri_encode(qq{Contact.ContactID = Guid("$xero_cref")});
122 0         0 my $page = 1; my $page_count=100;
  0         0  
123 0   0     0 while ( $page_count >= 100 and my $data = $self->do_xero_api_call( qq{https://api.xero.com/api.xro/2.0/Invoices?where=$ext&page=$page} ) ) ## continue querying until we have a non-full page ( ie $page_count < 100 )
124             {
125 0         0 foreach my $inv ( @{ $data->{Invoices}{Invoice}} )
  0         0  
126             {
127 0         0 push @$ret, $inv;
128 0         0 $page_count--;
129             }
130 0 0       0 if ($page_count == 0)
131             {
132 0         0 $page_count=100; $page++;
  0         0  
133             }
134             }
135 0         0 $self->{status} = 'OK get_all_customer_invoices_from_xero()';
136 0         0 return $ret;
137             }
138             #####################################
139              
140              
141              
142             =head2 do_xero_api_call()
143              
144             INPUT PARAMETERS AS A LIST ( NOT NAMED )
145              
146             * $uri (required) - the API endpoint URI ( eg 'https://api.xero.com/api.xro/2.0/Contacts/')
147             * $method (optional) - 'POST' or 'GET' .. PUT not currently supported
148             * $xml (optional) - the payload for POST updates as XML
149              
150             RETURNS
151              
152             The response is requested in JSON format which is then processed into a Perl structure that
153             is returned to the caller.
154              
155              
156             =cut
157              
158             sub do_xero_api_call
159             {
160 1     1 1 2 my ( $self, $uri, $method, $xml ) = @_;
161 1 50       3 $method = 'GET' unless $method;
162              
163 1         2 my $data = undef;
164 1         1 my $encryption = 'RSA-SHA1';
165 1 50 33     4 $encryption = 'HMAC-SHA1' if (defined $self->{TOKEN} and $self->{TOKEN} ne $self->{CONSUMER_KEY} );
166 1 50       3 $self->{TOKEN} = $self->{CONSUMER_KEY} unless $self->{TOKEN};
167 1 50       3 $self->{TOKEN_SECRET} = $self->{CONSUMER_SECRET} unless $self->{TOKEN_SECRET};
168              
169             my %opts = (
170             consumer_key => $self->{CONSUMER_KEY},
171             consumer_secret => $self->{CONSUMER_SECRET},
172             token => $self->{TOKEN},
173             token_secret => $self->{TOKEN_SECRET},
174 1         6 request_url => $uri,
175             request_method => $method,
176             signature_method => $encryption,
177             timestamp => time,
178             nonce => 'ccp' . md5_base64( join('', rand_chars(size => 8, set => 'alphanumeric')) . time ),
179             );
180 1 50       216 $opts{verifier} = $self->{verifier} if defined $self->{verifier};
181 1 50 33     3 $opts{extra_params} = { xml => $xml} if ( $method eq 'POST' and defined $xml );
182              
183              
184 1         5 my $access = Net::OAuth->request("protected resource")->new( %opts );
185            
186 1 50       10010 if ( $self->{TOKEN} eq $self->{CONSUMER_KEY} )
187             {
188 1         6 $access->sign( $self->{pko} );
189             }
190             else
191             {
192 0         0 $access->sign(); ## HMAC-SHA1 is self signed
193             }
194 1         11720 my $req = HTTP::Request->new( $method, $uri );
195            
196 1 50       128 if ( $method eq 'POST' )
    50          
197             {
198 0         0 $req->header( 'Content-Type' => 'application/x-www-form-urlencoded; charset=utf-8');
199 0         0 $req->header( 'Accept' => 'application/json');
200 0 0       0 $req->content( $access->to_post_body ) if defined $xml;
201             }
202             elsif ( $method eq 'GET' )
203             {
204 1         8 $req->header(Authorization => $access->to_authorization_header);
205 1         739 $req->header( 'Accept' => 'application/json');
206             }
207             else
208             {
209 0         0 return $self->_error('ONLY POST AND GET CURRENT SUPPORTED BY WebService::Xero Library');
210             }
211 1         38 my $res = $self->{ua}->request($req);
212 1 50       1387 if ($res->is_success)
213             {
214 0         0 $self->{status} = 'GOT RESPONSE FROM XERO API CALL';
215 0   0     0 $data = from_json($res->content) || return $self->api_error( $res->content );
216             }
217             else
218             {
219 1         13 return $self->api_error($res->content);
220             }
221 0         0 return $data;
222             }
223              
224              
225             =head2 api_error
226              
227             Experimental: place to catch known API errors - TODO
228              
229             =cut
230             sub api_error
231             {
232 1     1 1 27 my ( $self, $msg ) = @_;
233             #return $self->_error("SERVER ERROR: CONSUMER_KEY was not recognised - check your credentials") if ( $msg eq 'oauth_problem=consumer_key_unknown&oauth_problem_advice=Consumer%20key%20was%20not%20recognised');
234 1         6 return $self->_error("UNRECOGNISED API ERROR '$msg'");
235             }
236              
237              
238              
239             =head2 api_account_organisation()
240            
241             Experimental: a shortcut to dp_xero_api_call that returns
242             a WebService::Xero::Organisation object describing the organisation that provides the API.
243              
244             =cut
245              
246             sub api_account_organisation
247             {
248 0     0 1 0 my ( $self ) = @_;
249 0   0     0 return WebService::Xero::Organisation->new_from_api_data( $self->do_xero_api_call( 'https://api.xero.com/api.xro/2.0/organisation' ) ) || $self->_error('FAILED TO CREATE ORGANISATION OBJECT FROM AGENT');
250             }
251              
252              
253             sub _error
254             {
255 3     3   7 my ( $self, $msg ) = @_;
256 3         445 carp( $self->{_status} = $msg);
257 3         312 return $self->{_ERROR_VAL}; ##undef
258             }
259              
260              
261             =head2 as_text
262              
263             just a quick debugging method.
264              
265             =cut
266              
267             sub as_text
268             {
269 0     0 1 0 my ( $self ) = @_;
270 0         0 return qq{ NAME => $self->{NAME}\nCONSUMER_KEY => $self->{CONSUMER_KEY}\nCONSUMER_SECRET => $self->{CONSUMER_SECRET} \n};
271             }
272              
273             =head2 get_status
274              
275             return a text description of the last communication with the Xero API
276              
277             =cut
278              
279             sub get_status
280             {
281 1     1 1 2 my ( $self ) = @_;
282 1   50     12 return $self->{_status} || 'STATUS NOT SET';
283             }
284              
285              
286              
287              
288              
289             =head1 AUTHOR
290              
291             Peter Scott, C<< >>
292              
293             =head1 BUGS
294              
295             Please report any bugs or feature requests to C, or through
296             the web interface at L. I will be notified, and then you'll
297             automatically be notified of progress on your bug as I make changes.
298              
299              
300              
301              
302             =head1 SUPPORT
303              
304             You can find documentation for this module with the perldoc command.
305              
306             perldoc WebService::Xero
307              
308              
309             You can also look for information at:
310              
311             =over 4
312              
313             =item * RT: CPAN's request tracker (report bugs here)
314              
315             L
316              
317             =item * AnnoCPAN: Annotated CPAN documentation
318              
319             L
320              
321             =item * CPAN Ratings
322              
323             L
324              
325             =item * Search CPAN
326              
327             L
328              
329             =back
330              
331              
332             =head1 ACKNOWLEDGEMENTS
333              
334              
335             =head1 LICENSE AND COPYRIGHT
336              
337             Copyright 2016 Peter Scott.
338              
339             This program is free software; you can redistribute it and/or modify it
340             under the terms of the the Artistic License (2.0). You may obtain a
341             copy of the full license at:
342              
343             L
344              
345             Any use, modification, and distribution of the Standard or Modified
346             Versions is governed by this Artistic License. By using, modifying or
347             distributing the Package, you accept this license. Do not use, modify,
348             or distribute the Package, if you do not accept this license.
349              
350             If your Modified Version has been derived from a Modified Version made
351             by someone other than you, you are nevertheless required to ensure that
352             your Modified Version complies with the requirements of this license.
353              
354             This license does not grant you the right to use any trademark, service
355             mark, tradename, or logo of the Copyright Holder.
356              
357             This license includes the non-exclusive, worldwide, free-of-charge
358             patent license to make, have made, use, offer to sell, sell, import and
359             otherwise transfer the Package with respect to any patent claims
360             licensable by the Copyright Holder that are necessarily infringed by the
361             Package. If you institute patent litigation (including a cross-claim or
362             counterclaim) against any party alleging that the Package constitutes
363             direct or contributory patent infringement, then this Artistic License
364             to you shall terminate on the date that such litigation is filed.
365              
366             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
367             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
368             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
369             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
370             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
371             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
372             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
373             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
374              
375              
376             =cut
377              
378             1; # End of WebService::Xero