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