File Coverage

lib/WebService/GeoPost/Shipping/API.pm
Criterion Covered Total %
statement 104 150 79.3
branch 18 54 33.3
condition 10 57 35.0
subroutine 22 34 100.0
pod 19 21 90.4
total 173 316 66.4


line stmt bran cond sub pod time code
1             package WebService::GeoPost::Shipping::API;
2 1     1   14902 use strict;
  1         1  
  1         32  
3 1     1   3 use warnings;
  1         1  
  1         22  
4 1     1   4 use Carp;
  1         4  
  1         67  
5 1     1   552 use Moo;
  1         10476  
  1         4  
6 1     1   1814 use LWP::UserAgent;
  1         33819  
  1         33  
7 1     1   463 use HTTP::Request::Common;
  1         1524  
  1         69  
8 1     1   5 use URI::Escape;
  1         1  
  1         40  
9 1     1   525 use Data::Dumper;
  1         5128  
  1         52  
10 1     1   581 use JSON;
  1         8405  
  1         4  
11 1     1   505 use MIME::Base64;
  1         465  
  1         48  
12 1     1   373 use namespace::clean;
  1         8666  
  1         4  
13              
14             # ABSTRACT: communicates with GeoPost API
15              
16             our $VERSION = 'v0.0006';
17              
18            
19             =head1 NAME
20              
21             WebService::GeoPost::Shipping::API
22              
23             =head1 SYNOPSIS
24              
25              
26             $geopost = WebService::GeoPost::Shipping::API->new(
27             username => $username,
28             password => $password,
29             geoClient => "account/$customer_id",
30             );
31             =cut
32              
33             =head1 DESCRIPTION
34              
35             This module provides a simple wrapper around GeoPost delivery service API. This is a work in progress and contains incomplete test code, methods are likely to be refactored, you have been warned.
36              
37              
38             =head1 METHODS
39              
40             =cut
41              
42              
43             has username => (
44             is => 'ro',
45             required => 1,
46             );
47              
48             has password => (
49             is => 'ro',
50             required => 1,
51             );
52              
53             has url => ( is => 'ro',
54             default => sub {'https://api.dpd.co.uk'}
55             );
56              
57             has host => ( is => 'ro',
58             lazy => 1,
59             default => sub {
60             my $self=shift;
61             my $url = $self->url;
62             $url =~ s/^https{0,1}.:\/\///;
63             return $url; },
64             );
65              
66             has ua => (
67             is => 'rw',
68             );
69              
70             has geoSession => (
71             is => 'rw',
72             );
73              
74             has geoClient => (
75             is => 'ro',
76             default => sub {'thirdparty/pryanet'},
77             );
78              
79             has debug => (
80             is => 'rw',
81             default => 0,
82             );
83              
84             has errstr => (
85             is => 'rw',
86             default => sub {''},
87             );
88              
89             sub BUILD
90             {
91 1     1 0 6 my $self = shift;
92 1         8 $self->ua( LWP::UserAgent->new );
93 1         1930 $self->ua->agent("Perl_WebService::GeoPost::Shipping::API/$VERSION");
94 1         45 $self->ua->cookie_jar({});
95             }
96              
97              
98              
99              
100             =head2 login
101              
102             Authenticates and establishes api session used by following methods
103              
104             $geopost->login;
105              
106             =cut
107             sub login
108             {
109 1     1 1 1 my $self = shift;
110 1         20 my $result = $self->send_request( {
111             path => '/user/?action=login',
112             type => 'POST',
113             header => {
114             Authorization => 'Basic ' . encode_base64($self->username . ':' . $self->password, ''),
115             },
116             } );
117 1         11 $self->geoSession( $result->{geoSession} );
118 1         509 return $result;
119             }
120              
121             =head2 get_country( $code )
122              
123             Retrieves the country details for a provided country code and can be used to determine if a country requires a postcode or if liability is allowed etc.
124              
125             $country = $geopost->get_country( 'GB' );
126            
127             =cut
128             sub get_country
129             {
130 1     1 1 4 my ( $self, $code ) = @_;
131 1 50 0     4 $self->errstr( "No country code" ) and return unless $code;
132 1         9 return $self->send_request ( {
133             path => '/shipping/country/' . $code,
134             } );
135             }
136              
137             =head2 get_services( \%shipping_information )
138              
139             Retrieves list of services available for provided shipping information.
140              
141             my $address = {
142             countryCode => 'GB',
143             county => 'West Midlands',
144             locality => 'Birmingham',
145             organisation => 'GeoPost',
146             postcode => 'B661BY',
147             property => 'GeoPost UK',
148             street => 'Roebuck Ln',
149             town => 'Smethwick',
150             };
151              
152             my $shipping = {
153             collectionDetails => {
154             address => $address,
155             },
156             deliveryDetails => {
157             address => $address,
158             },
159             deliveryDirection => 1, # 1 for outbound 2 for inbound
160             numberOfParcels => 1,
161             totalWeight => 5,
162             shipmentType => 0, # 1 or 2 if a collection on delivery or swap it service is required
163             };
164              
165             my $services = $geopost->get_services( $shipping );
166              
167              
168             =cut
169             sub get_services
170             {
171 1     1 1 802 my ( $self, $shipping ) = @_;
172 1 50 0     7 $self->errstr( "No shipping information" ) and return unless $shipping;
173 1         6 return $self->send_request ( {
174             path => '/shipping/network/?' . $self->_to_query_params($shipping),
175             } );
176             }
177              
178             =head2 get_service( geoServiceCode )
179              
180             Retrieves the supported countries for a geoServiceCode
181              
182             $service = $geopost->get_service(812);
183              
184             =cut
185             sub get_service
186             {
187 1     1 1 598 my ( $self, $geoServiceCode ) = @_;
188 1 50 0     6 $self->errstr( "No geoServiceCode" ) and return unless $geoServiceCode;
189 1         8 return $self->send_request ( {
190             path => "/shipping/network/$geoServiceCode/",
191             } );
192             }
193              
194             =head2 create_shipment( \%data )
195              
196             Creates a shipment object
197              
198             my $shipment_data = {
199             jobId => 'null',
200             collectionOnDelivery => "false",
201             invoice => "null",
202             collectionDate => $date,
203             consolidate => "false",
204             consignment => [
205             {
206             collectionDetails => {
207             contactDetails => {
208             contactName => "Mr David Smith",
209             telephone => "0121 500 2500"
210             },
211             address => $address,
212             },
213             deliveryDetails => {
214             contactDetails => {
215             contactName => "Mr David Smith",
216             telephone => "0121 500 2500"
217             },
218             notificationDetails => {
219             mobile => "07921 123456",
220             email => 'david.smith@acme.com',
221             },
222             address => {
223             organisation => "ACME Ltd",
224             property => "Miles Industrial Estate",
225             street => "42 Bridge Road",
226             locality => "",
227             town => "Birmingham",
228             county => "West Midlands",
229             postcode => "B1 1AA",
230             countryCode => "GB",
231             }
232             },
233             networkCode => "1^12",
234             numberOfParcels => '1',
235             totalWeight => '5',
236             shippingRef1 => "Catalogue Batch 1",
237             shippingRef2 => "Invoice 231",
238             shippingRef3 => "",
239             customsValue => '0',
240             deliveryInstructions => "Please deliver to industrial gate A",
241             parcelDescription => "",
242             liabilityValue => '0',
243             liability => "false",
244             parcels => [],
245             consignmentNumber => "null",
246             consignmentRef => "null",
247             }
248             ]
249             };
250              
251              
252             $shipment = $geopost->create_shipment( $shipment_data_example );
253              
254             =cut
255             sub create_shipment
256             {
257 1     1 1 938 my ( $self, $data ) = @_;
258 1 50 0     5 $self->errstr( "No data" ) and return unless $data;
259 1         8 return $self->send_request ( {
260             type => 'POST',
261             path => "/shipping/shipment",
262             data => $data,
263             } );
264             }
265              
266             =head2 list_countries
267              
268             Provides a full list of available shipping countries
269              
270             $countries = $geopost->list_countries;
271              
272             =cut
273              
274             sub list_countries
275             {
276 1     1 1 640 my $self = shift;
277 1         7 return $self->send_request ( {
278             path => '/shipping/country',
279             } );
280             }
281              
282             =head2 get_labels( $shipment_id, $format )
283              
284             Get label for given shipment id, available in multiple formats
285              
286             $label = $geopost->get_labels( $shipment_id, 'application/pdf' );
287              
288             =cut
289             sub get_labels
290             {
291 1     1 1 649 my ( $self, $id, $format ) = @_;
292 1 50 0     11 $self->errstr( "No shipment ID/format provided" ) and return unless ( $id and $format );
      33        
293 1         14 return $self->send_request ( {
294             path => "/shipping/shipment/$id/label/",
295             header => {
296             Accept => $format,
297             },
298             raw_result => 1,
299             } );
300              
301             }
302              
303              
304             =head1 FUTURE METHODS
305              
306             These methods are implemented as documented in the GeoPost API specification. Although at the time of writing their functionality has not been publicly implemented within the API.
307              
308             =cut
309              
310              
311             =head2 request_job_id
312              
313             Get a job id to group shipments
314              
315             $job_id = $geopost->request_jobid;
316              
317             =cut
318             sub request_jobid
319             {
320             # uncoverable subroutine
321 0     0 0 0 my ( $self ) = @_; # uncoverable statement
322 0         0 return $self->send_request( {
323             type => 'GET',
324             path => '/shipping/job/',
325             header => {
326             Accept => 'application/json',
327             }
328             } ); # uncoverable statement
329             }
330              
331             =head2 get_labels_for_job( $id, $format )
332              
333             Retrieves all labels for a given job id
334              
335             $labels = $geopost->get_labels_for_job( $id, $format );
336              
337             =cut
338             sub get_labels_for_job
339             {
340             # uncoverable subroutine
341 0     0 1 0 my ( $self, $id, $format ) = @_; # uncoverable statement
342 0 0 0     0 $self->errstr( "No id provided" ) and return unless $id; # uncoverable condition
343 0 0 0     0 $self->errstr( "No format provided" ) and return unless $format; # uncoverable condition
344 0         0 return $self->send_request( {
345             path => "/shipping/job/$id/label",
346             header => {
347             Accept => $format,
348             }
349             } ); # uncoverable statement
350             }
351              
352              
353             =head2 get_shipments( \%search_params )
354              
355             Retrieves a full list of shipments meeting the search criteria and/or collection date. If no URL parameters are set the default settings brings back the first 100 shipments found.
356              
357             $shipments = $self->get_shipments( {
358             collectionDate => $date,
359             searchCriterea => 'foo',
360             searchPage => 1,
361             searchPageSize => 20,
362             useTemplate => false,
363             });
364             =cut
365             sub get_shipments
366             {
367             # uncoverable subroutine
368 0     0 1 0 my ( $self, $params ) = @_; # uncoverable statement
369 0         0 my $path = '/shipping/shipment/'; # uncoverable statement
370 0 0       0 $path .= '?' . $self->_to_query_params($params) if $params; # uncoverable statement
371 0         0 return $self->send_request( {
372             path => $path,
373             } ); # uncoverable condition
374              
375             }
376              
377             =head2 get_shipment( $id )
378              
379             Retrieves all shipment information associated with a shipment id
380              
381             $shipment = $geopost->get_shipment( $id );
382              
383             =cut
384             sub get_shipment
385             {
386             # uncoverable subroutine
387 0     0 1 0 my ( $self, $id ) = @_; # uncoverable statement
388 0 0 0     0 $self->errstr( "No id provided" ) and return unless $id; # uncoverable condition
389 0         0 return $self->send_request( {
390             path => "/shipping/shipment/$id/",
391             } ); # uncoverable statement
392             }
393              
394             =head2 get_international_invoice( $shipment_id )
395              
396             Creates and returns an international invoice associated with the given shipment id.
397              
398             $invoice = $geopost->get_international_invoice( $shipment_id );
399              
400             =cut
401             sub get_international_invoice
402             {
403             # uncoverable subroutine
404 0     0 1 0 my ( $self, $id ) = @_; # uncoverable statement
405 0 0 0     0 $self->errstr( "No shipment ID provided" ) and return unless $id; # uncoverable condition
406 0         0 return $self->send_request( {
407             path => "/shipping/shipment/$id/invoice/",
408             header => {
409             Accept => 'text/html',
410             },
411             raw_result => 1,
412             } ); # uncoverable statement
413             }
414              
415             =head2 get_unprinted_labels( $date, $format )
416              
417             Retrieves all labels that have not already been printed for a particular collection date.
418              
419             $labels = $geopost->get_unprinted_labels( $date, $format );
420              
421             =cut
422             sub get_unprinted_labels
423             {
424             # uncoverable subroutine
425 0     0 1 0 my ( $self, $date, $format ) = @_; # uncoverable statement
426 0 0 0     0 $self->errstr( "No date" ) and return unless $date; # uncoverable condition
427 0         0 return $self->send_request( {
428             path => "/shipping/shipment/_/label/?collectionDate=$date",
429             header => {
430             Accept => $format,
431             }
432             } ); # uncoverable statement
433             }
434              
435             =head2 delete_shipment( $id )
436              
437             Delete a shipment
438              
439             $geopost->delete_shipment( $id );
440              
441             =cut
442             sub delete_shipment
443             {
444             # uncoverable subroutine
445 0     0 1 0 my ( $self, $id ) = @_; # uncoverable statement
446 0 0 0     0 $self->errstr( "No id provided" ) and return unless $id; # uncoverable condition
447 0         0 return $self->send_request( {
448             type => 'DELETE',
449             path => "/shipping/shipment/$id/",
450             } ); # uncoverable statement
451             }
452              
453             =head2 change_collection_date( $id, $date )
454              
455             Update collection date for a shipment
456              
457             $geopost->change_collection_date( $id, $date );
458              
459             =cut
460             sub change_collection_date
461             {
462             # uncoverable subroutine
463 0     0 1 0 my ( $self, $id, $date ) = @_; # uncoverable statement
464 0 0 0     0 $self->errstr( "No id provided" ) and return unless $id; # uncoverable condition
465 0 0 0     0 $self->errstr( "No date provided" ) and return unless $date; # uncoverable condition
466 0         0 return $self->send_request( {
467             type => 'PUT',
468             path => "/shipping/shipment/$id/?action=ChangeCollectionDate",
469             data => {
470             collectionDate => $date,
471             }
472             } ); # uncoverable statement
473             }
474              
475             =head2 void_shipment
476              
477             Update status of shipment to void.
478              
479             $geopost->void_shipment( $id );
480              
481             =cut
482             sub void_shipment
483             {
484             # uncoverable subroutine
485 0     0 1 0 my ( $self, $id ) = @_; # uncoverable statement
486 0 0 0     0 $self->errstr( "No id provided" ) and return unless $id; # uncoverable condition
487 0         0 return $self->send_request( {
488             type => 'PUT',
489             path => "/shipping/shipment/$id/?action=Void",
490             data => {
491             isVoided => 'true',
492             },
493             } ); # uncoverable statement
494             }
495              
496             =head2 create_manifest
497              
498             Tag all non manifested shipments for a collection date with a new generated manifest id.
499              
500             $manifest = $geopost->create_manifest( $date );
501              
502             =cut
503             sub create_manifest
504             {
505             # uncoverable subroutine
506 0     0 1 0 my ( $self, $date ) = @_; # uncoverable statement
507 0 0 0     0 $self->errstr( "No date provided" ) and return unless $date; # uncoverable statement
508 0         0 return $self->send_request( {
509             type => 'POST',
510             path => '/shipping/manifest/',
511             data => {
512             collectionDate => $date,
513             },
514             } ); # uncoverable statement
515             }
516              
517             =head2 get_manifest_by_date( $date )
518              
519             Retrieves all the manifests and the core manifest information for a particular collection date.
520            
521             $manifests = $geopost->get_manifest_by_date( $date );
522              
523             =cut
524             sub get_manifest_by_date
525             {
526             # uncoverable subroutine
527 0     0 1 0 my ( $self, $date ) = @_; # uncoverable statement
528 0         0 return $self->send_request( {
529             path => "/shipping/manifest/?collectionDate=$date",
530             } ); # uncoverable statement
531             }
532              
533             =head2 get_manifest_by_id( $id )
534              
535             Get printable manifest by its associated manifest id
536              
537             $manifest = get_manifest_by_id( $id );
538             =cut
539             sub get_manifest_by_id
540             {
541             # uncoverable subroutine
542 0     0 1 0 my ( $self, $id ) = @_; # uncoverable statement
543 0 0 0     0 $self->errstr( "No id provided" ) and return unless $id; # uncoverable condition
544 0         0 return $self->send_request( {
545             path => "/shipping/manifest/$id",
546             header => {
547             Accept => 'text/html',
548             },
549             } ); # uncoverable statement
550             }
551              
552              
553             =head1 INTERNAL METHODS
554              
555             =cut
556              
557             =head2 _to_query_params
558              
559             Recursively converts hash of hashes into query string for http request
560              
561             =cut
562             sub _to_query_params
563             {
564 1     1   3 my ( $self, $data ) = @_;
565 1         2 my @params;
566             my $sub;
567             $sub = sub {
568 5     5   8 my ( $name, $data ) = @_;
569 5         18 for ( keys %$data )
570             {
571 24 100       42 if ( ref $data->{$_} eq 'HASH' )
572             {
573 4         18 $sub->( "$name.$_", $data->{$_} );
574             }
575             else
576             {
577 20         74 push @params, { key => "$name.$_", value => $data->{$_} };
578             }
579             }
580 1         10 };
581 1         4 $sub->( '', $data);
582 1         2 my $query;
583 1         3 for ( @params )
584             {
585 20         277 $_->{key} =~ s/^\.//;
586 20         57 $query .= $_->{key} . '='. uri_escape( $_->{value} ) . '&';
587             }
588 1         14 $query =~ s/&$//;
589 1         10 return $query;
590             }
591              
592             =head2 send_request( \%args )
593              
594             Constructs and sends authenticated HTTP API request
595              
596             $result = $geopost->send_request( {
597             type => 'POST', # HTTP request type defaults to GET
598             path => "/path/to/service", # Path to service
599             data => { # hashref of data for POST/PUT requests, converted to JSON for sending
600             key1 => 'value1',
601             key2 => 'value2',
602             },
603             content_type => 'appilcation/json', # defaults to application/json
604             header => { # hashref of additional headers
605             Accept => $format,
606             }
607              
608             } );
609              
610             =cut
611             sub send_request
612             {
613 7     7 1 17 my ( $self, $args ) = @_;
614 7   100     45 my $type = $args->{type} || 'GET';
615 7         91 my $req = HTTP::Request->new($type => $self->url . $args->{path} );
616             #Required headers
617 7         7576 $req->header( Host => $self->host );
618 7         416 $req->protocol('HTTP/1.1');
619 7         87 $req->header( GEOClient => $self->geoClient );
620 7 100       338 $req->header( GEOSession => $self->geoSession ) if $self->geoSession;
621            
622             #Per request overridable
623 7   50     342 $req->content_type( $args->{content_type} || 'application/json' );
624 7   100     150 $req->header( Accept => $args->{header}->{Accept} || 'application/json' );
625              
626             #Custom headers
627 7         223 for ( keys %{ $args->{header} } )
  7         44  
628             {
629 2         6 $req->header( $_ => $args->{header}->{$_} );
630             }
631              
632 7 100 66     93 if ( $args->{data} and $type =~ /^(POST|PUT)$/ )
633             {
634 1         7 my $content = to_json( $args->{data} );
635             #hacky translation to correct representation of null and boolean values
636 1         109 $content =~ s/"null"/null/gi;
637 1         47 $content =~ s/"false"/false/gi;
638 1         43 $content =~ s/"true"/true/gi;
639 1         8 $req->content( $content );
640             }
641              
642             #Send request
643 7 50       49 warn $req->as_string if $self->debug;
644 7         34 my $response = $self->ua->request($req);
645 7 50       2263171 warn $response->as_string if $self->debug;
646 7 50       25 if ( $response->code == 200 )
647             {
648 7         68 my $result;
649             #FIXME assumes JSON
650 7         14 eval{ $result = JSON->new->utf8->decode($response->content) };
  7         128  
651 7 50 0     2232 $self->errstr("Server response was invalid\n") and return if $@ and ! $args->{raw_result};
      66        
652 7 50       29 if ( $result->{error} )
653             {
654 0 0       0 my $error = ref $result->{error} eq 'ARRAY' ? $result->{error}->[0] : $result->{error};
655 0   0     0 my $error_type = $error->{errorType} || '';
656 0   0     0 my $error_obj = $error->{obj} || '';
657 0   0     0 my $error_code = $error->{errorCode} || '';
658 0   0     0 my $error_message = $error->{errorMessage} || '';
659 0         0 $self->errstr( "$error_type error : $error_obj : $error_code : $error_message\n" );
660 0         0 return;
661             }
662 7         17 $result->{response} = $response;
663 7 100       25 if ( $args->{raw_result} )
664             {
665 1         5 $result->{data} = $response->content;
666             }
667 7         223 return $result->{data};
668             }
669             else
670             {
671 0           $self->errstr('API communication error: ' . $args->{path} . ': ' . $response->status_line . "\n\n\n\n");
672 0           return;
673             }
674             }
675              
676             1;
677              
678             =head1 SOURCE CODE
679              
680             The source code for this module is held in a public git repository on Github : https://github.com/pryanet/WebService-GeoPost-Shipping-API
681              
682             =head1 LICENSE AND COPYRIGHT
683            
684             Copyright (c) 2014 Richard Newsham, Pryanet Ltd
685            
686             This library is free software; you can redistribute it and/or
687             modify it under the same terms as Perl itself.
688            
689             =head1 BUGS AND LIMITATIONS
690            
691             See rt.cpan.org for current bugs, if any.
692            
693             =head1 INCOMPATIBILITIES
694            
695             None known.
696            
697             =head1 DEPENDENCIES
698              
699             Carp
700             Moo
701             LWP::UserAgent
702             LWP::Protocol::https
703             HTTP::Request::Common
704             URI::Escape
705             Data::Dumper
706             JSON
707             MIME::Base64
708             namespace::clean
709              
710             =cut