File Coverage

blib/lib/Business/Shipping/Shipment/UPS.pm
Criterion Covered Total %
statement 41 82 50.0
branch 10 50 20.0
condition 2 18 11.1
subroutine 6 16 37.5
pod 12 12 100.0
total 71 178 39.8


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__