line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Business::Shipping::Shipment::UPS; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=head1 NAME |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
Business::Shipping::Shipment::UPS |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head1 VERSION |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
$Rev: 280 $ |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=head1 METHODS |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=cut |
14
|
|
|
|
|
|
|
|
15
|
2
|
|
|
2
|
|
2579
|
use Any::Moose; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
13
|
|
16
|
2
|
|
|
2
|
|
1084
|
use Business::Shipping::Logging; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
234
|
|
17
|
2
|
|
|
2
|
|
11
|
use Business::Shipping::Config; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
145
|
|
18
|
2
|
|
|
2
|
|
18
|
use version; our $VERSION = qv('400'); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
12
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head2 to_residential() |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
Defaults to true. |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=cut |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
extends 'Business::Shipping::Shipment'; |
27
|
|
|
|
|
|
|
has 'to_residential' => (is => 'rw', default => 1); |
28
|
|
|
|
|
|
|
has '_service' => (is => 'rw'); |
29
|
|
|
|
|
|
|
has 'service_code' => (is => 'rw'); |
30
|
|
|
|
|
|
|
has 'service_nick' => (is => 'rw'); |
31
|
|
|
|
|
|
|
has 'service_name' => (is => 'rw'); |
32
|
|
|
|
|
|
|
has 'service_nick2' => (is => 'rw'); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# We need this offline boolean to know if from_state is required. |
35
|
|
|
|
|
|
|
has 'offline' => (is => 'rw'); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
#type => 'Business::Shipping::Package |
38
|
|
|
|
|
|
|
#has 'packages' => (is => 'rw', isa => 'ArrayRef'); |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
__PACKAGE__->meta()->make_immutable(); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=head2 packaging() |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
=head2 weight() |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# Uses the standard Shipment::weight(). |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=head2 signature_type() |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head2 insured_currency_type() |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=head2 insured_value() |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=cut |
55
|
|
|
|
|
|
|
|
56
|
0
|
|
|
0
|
1
|
0
|
sub packaging { shift->package0->packaging(@_) } |
57
|
0
|
|
|
0
|
1
|
0
|
sub signature_type { shift->package0->signature_type(@_) } |
58
|
0
|
|
|
0
|
1
|
0
|
sub insured_currency_type { shift->package0->insured_currency_type(@_) } |
59
|
0
|
|
|
0
|
1
|
0
|
sub insured_value { shift->package0->insured_value(@_) } |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=head2 massage_values() |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
Assign a package type (if none given) based on the service. Set weight to 0.01 |
64
|
|
|
|
|
|
|
minimum. Remove "+4" from ZIP+4. |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=cut |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub massage_values { |
69
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
# Check each package for a package type and assign one if none given. |
72
|
0
|
|
|
|
|
0
|
my %services_default_packaging_codes = ( |
73
|
|
|
|
|
|
|
qw/ |
74
|
|
|
|
|
|
|
1DM 02 |
75
|
|
|
|
|
|
|
1DML 01 |
76
|
|
|
|
|
|
|
1DA 02 |
77
|
|
|
|
|
|
|
1DAL 01 |
78
|
|
|
|
|
|
|
1DP 02 |
79
|
|
|
|
|
|
|
2DM 02 |
80
|
|
|
|
|
|
|
2DA 02 |
81
|
|
|
|
|
|
|
2DML 01 |
82
|
|
|
|
|
|
|
2DAL 01 |
83
|
|
|
|
|
|
|
3DS 02 |
84
|
|
|
|
|
|
|
GNDCOM 02 |
85
|
|
|
|
|
|
|
GNDRES 02 |
86
|
|
|
|
|
|
|
XPR 02 |
87
|
|
|
|
|
|
|
UPSSTD 02 |
88
|
|
|
|
|
|
|
XDM 02 |
89
|
|
|
|
|
|
|
XPRL 01 |
90
|
|
|
|
|
|
|
XDML 01 |
91
|
|
|
|
|
|
|
XPD 02 |
92
|
|
|
|
|
|
|
/ |
93
|
|
|
|
|
|
|
); |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
#use Data::Dumper; die "packages = " . Dumper($self->packages()); |
96
|
|
|
|
|
|
|
# Set default packaging code based on the service. |
97
|
|
|
|
|
|
|
|
98
|
0
|
|
|
|
|
0
|
foreach my $package ($self->packages()) { |
99
|
0
|
0
|
|
|
|
0
|
next if $package->packaging(); |
100
|
|
|
|
|
|
|
|
101
|
0
|
|
|
|
|
0
|
my $dflt_pkg_code_for_svc; |
102
|
0
|
0
|
|
|
|
0
|
if (my $service_nick = $self->service_nick()) { |
103
|
0
|
|
|
|
|
0
|
$dflt_pkg_code_for_svc |
104
|
|
|
|
|
|
|
= $services_default_packaging_codes{$service_nick}; |
105
|
|
|
|
|
|
|
} |
106
|
0
|
0
|
|
|
|
0
|
if ($dflt_pkg_code_for_svc) { |
107
|
0
|
|
|
|
|
0
|
$package->packaging($dflt_pkg_code_for_svc); |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
else { |
110
|
0
|
|
|
|
|
0
|
$package->packaging('02'); |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
# UPS requires weight is at least 0.1 pounds. |
115
|
0
|
|
|
|
|
0
|
foreach my $package ($self->packages) { |
116
|
0
|
0
|
0
|
|
|
0
|
$package->weight(0.1) |
117
|
|
|
|
|
|
|
if (not $package->weight() or $package->weight() < 0.1); |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# In the U.S., UPS only wants the 5-digit base ZIP code, not ZIP+4 |
121
|
0
|
0
|
|
|
|
0
|
$self->to_country('US') if not $self->to_country(); |
122
|
0
|
0
|
|
|
|
0
|
if ($self->to_zip()) { |
123
|
0
|
0
|
|
|
|
0
|
$self->to_zip() =~ /^(\d{5})/ and $self->to_zip($1); |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
#info('to_country currently = ' . $self->to_country()); |
127
|
|
|
|
|
|
|
# UPS prefers 'GB' instead of 'UK' |
128
|
0
|
0
|
|
|
|
0
|
$self->to_country('GB') if $self->to_country() eq 'UK'; |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=head2 Required() |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
from_state only required for Offline international orders. |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=cut |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
sub Required { |
139
|
0
|
0
|
0
|
0
|
1
|
0
|
return 'service, from_state' if $_[0]->to_canada and $_[0]->offline; |
140
|
0
|
0
|
0
|
|
|
0
|
return 'service, from_zip, from_state' if $_[0]->intl and $_[0]->offline; |
141
|
0
|
|
|
|
|
0
|
return 'service, from_zip'; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=head2 from_state_abbrev() |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
Returns the abbreviated form of 'from_state'. |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=cut |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
sub from_state_abbrev { |
151
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
152
|
|
|
|
|
|
|
|
153
|
0
|
|
|
|
|
0
|
my $state_abbrevs |
154
|
|
|
|
|
|
|
= config_to_hash(cfg()->{ups_information}->{state_to_abbrev}); |
155
|
|
|
|
|
|
|
|
156
|
0
|
|
0
|
|
|
0
|
return $state_abbrevs->{ $self->from_state } || $self->from_state; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=head2 from_ak_or_hi() |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
Alaska and Hawaii are treated differently by many shippers. |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=cut |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub from_ak_or_hi { |
166
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
167
|
0
|
0
|
|
|
|
0
|
return unless $self->from_state(); |
168
|
0
|
0
|
|
|
|
0
|
return 1 if $self->from_state() =~ /^(AK|HI)$/i; |
169
|
0
|
|
|
|
|
0
|
return 0; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=head2 service |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
Stores the name as the user entered it, and updates the sibling methods. |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=head2 service_code |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
The correct UPS code (e.g. 03). |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=head2 service_nick |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
The semi-official UPS nickname (e.g. 'GNDRES'). |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=head2 service_name |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
The official UPS name (e.g. 'Ground Residential'). |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=head2 service_nick2 |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
The other nickname for that service (e.g. 'Ground'), used in offline UPS |
191
|
|
|
|
|
|
|
data files. |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
=cut |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
sub service { |
196
|
2
|
|
|
2
|
1
|
13
|
my ($self, $service) = @_; |
197
|
|
|
|
|
|
|
|
198
|
2
|
100
|
|
|
|
8
|
if (defined $service) { |
199
|
1
|
|
|
|
|
19
|
$self->_service($service); |
200
|
|
|
|
|
|
|
|
201
|
1
|
|
|
|
|
10
|
my $service_map = $self->service_info($service, 'get_map'); |
202
|
|
|
|
|
|
|
|
203
|
1
|
50
|
|
|
|
11
|
if ($service_map) { |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
# Record whatever the user passed in. If we need a certain format, |
206
|
|
|
|
|
|
|
# we can always use the sibling methods. |
207
|
1
|
|
|
|
|
4
|
$self->_service($service); |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# Setup the sibling method data |
210
|
1
|
|
|
|
|
8
|
$self->service_code($service_map->{code}); |
211
|
1
|
|
|
|
|
7
|
$self->service_nick($service_map->{nick}); |
212
|
1
|
|
|
|
|
7
|
$self->service_name($service_map->{name}); |
213
|
1
|
|
|
|
|
8
|
$self->service_nick2($service_map->{nick2}); |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
else { |
216
|
0
|
|
|
|
|
0
|
$self->user_error( |
217
|
|
|
|
|
|
|
"The service '$service' is not a valid service type"); |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
# Default values for residential addresses. |
221
|
|
|
|
|
|
|
|
222
|
1
|
50
|
|
|
|
11
|
if (not $self->to_residential) { |
223
|
0
|
0
|
|
|
|
0
|
if ($self->service_name eq 'Ground Residential') { |
|
|
0
|
|
|
|
|
|
224
|
0
|
|
|
|
|
0
|
$self->to_residential(1); |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
elsif ($self->service_name eq 'Ground Commercial') { |
227
|
0
|
|
|
|
|
0
|
$self->to_residential(0); |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
2
|
|
|
|
|
10
|
return $self->_service(); |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=head2 service_code_to_nick |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=head2 service_code_to_name |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=cut |
241
|
|
|
|
|
|
|
|
242
|
0
|
|
|
0
|
1
|
0
|
sub service_code_to_nick { return $_[0]->service_info($_[1], 'nick'); } |
243
|
0
|
|
|
0
|
1
|
0
|
sub service_code_to_name { return $_[0]->service_info($_[1], 'name'); } |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=head2 service_info |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
Provides implementation details for service() and friends. |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
=cut |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
sub service_info { |
252
|
1
|
|
|
1
|
1
|
3
|
my ($self, $service, $type) = @_; |
253
|
|
|
|
|
|
|
|
254
|
1
|
50
|
33
|
|
|
10
|
return unless $service and $type; |
255
|
|
|
|
|
|
|
|
256
|
1
|
50
|
33
|
|
|
7
|
return { name => 'Shop', code => 999, nick => 'SHOP', nick2 => 'Shop' } |
257
|
|
|
|
|
|
|
if $service eq 'shop' and $type eq 'get_map'; |
258
|
|
|
|
|
|
|
|
259
|
1
|
|
|
|
|
8
|
my $service_info_cfg = cfg()->{ups_service_info}; |
260
|
1
|
|
|
|
|
48
|
my $service_info; |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
# Reset counter for 'each' |
263
|
1
|
|
|
|
|
3
|
keys %$service_info_cfg; |
264
|
|
|
|
|
|
|
|
265
|
1
|
|
|
|
|
7
|
while (my ($name, $other_values) = each %$service_info_cfg) { |
266
|
14
|
|
|
|
|
780
|
my ($nick, $code, $nick2) = split("\t", $other_values); |
267
|
14
|
|
|
|
|
63
|
my $service_info_hash = { |
268
|
|
|
|
|
|
|
name => $name, |
269
|
|
|
|
|
|
|
nick => $nick, |
270
|
|
|
|
|
|
|
code => $code, |
271
|
|
|
|
|
|
|
nick2 => $nick2, |
272
|
|
|
|
|
|
|
}; |
273
|
14
|
|
|
|
|
70
|
push @$service_info, $service_info_hash; |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
|
276
|
1
|
|
|
|
|
27
|
my $matching_map; |
277
|
|
|
|
|
|
|
my $match; |
278
|
1
|
|
|
|
|
3
|
foreach my $service_map (@$service_info) { |
279
|
|
|
|
|
|
|
|
280
|
1
|
50
|
|
|
|
5
|
if ($type eq 'get_map') { |
281
|
1
|
50
|
|
|
|
7
|
if ($service eq $service_map->{code}) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
282
|
0
|
|
|
|
|
0
|
$match = 1; |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
elsif (lc $service eq lc $service_map->{nick}) { |
285
|
1
|
|
|
|
|
3
|
$match = 1; |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
elsif (lc $service eq lc $service_map->{name}) { |
288
|
0
|
|
|
|
|
0
|
$match = 1; |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
1
|
50
|
|
|
|
3
|
if ($match) { |
292
|
1
|
|
|
|
|
14
|
return $service_map; |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
else { |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
# Individual type |
298
|
0
|
0
|
|
|
|
|
if ($service_map->{code} eq $service) { |
299
|
0
|
|
|
|
|
|
return $service_map->{$type}; |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
# TODO: check to see if none matched, then throw user_error |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
|
306
|
0
|
|
|
|
|
|
return; |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
1; |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
__END__ |