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 |