File Coverage

blib/lib/Net/Async/Webservice/UPS/Package.pm
Criterion Covered Total %
statement 40 62 64.5
branch 19 36 52.7
condition 9 29 31.0
subroutine 8 10 80.0
pod 3 3 100.0
total 79 140 56.4


line stmt bran cond sub pod time code
1             package Net::Async::Webservice::UPS::Package;
2             $Net::Async::Webservice::UPS::Package::VERSION = '1.1.2';
3             {
4             $Net::Async::Webservice::UPS::Package::DIST = 'Net-Async-Webservice-UPS';
5             }
6 4     4   313646 use Moo;
  4         48170  
  4         20  
7 4     4   6762 use Type::Params qw(compile);
  4         261003  
  4         35  
8 4     4   828 use Types::Standard qw(Str Object);
  4         7  
  4         15  
9 4     4   3792 use Net::Async::Webservice::UPS::Types ':types';
  4         14  
  4         47  
10 4     4   18234 use Net::Async::Webservice::UPS::Exception;
  4         13  
  4         152  
11 4     4   31 use namespace::autoclean;
  4         5  
  4         31  
12 4     4   385 use 5.010;
  4         20  
  4         3384  
13              
14             # ABSTRACT: a package for UPS
15              
16              
17             has packaging_type => (
18             is => 'ro',
19             isa => PackagingType,
20             default => sub { 'PACKAGE' },
21             );
22              
23              
24             has linear_unit => (
25             is => 'ro',
26             isa => SizeMeasurementUnit,
27             required => 1,
28             );
29              
30              
31             has weight_unit => (
32             is => 'ro',
33             isa => WeightMeasurementUnit,
34             required => 1,
35             );
36              
37              
38             around BUILDARGS => sub {
39             my ($orig,$self,@etc) = @_;
40              
41             my $args = $self->$orig(@etc);
42             if (defined (my $ms = $args->{measurement_system})) {
43             if ($ms eq 'english') {
44             $args->{linear_unit} ||= 'IN';
45             $args->{weight_unit} ||= 'LBS';
46             }
47             elsif ($ms eq 'metric') {
48             $args->{linear_unit} ||= 'CM';
49             $args->{weight_unit} ||= 'KGS';
50             }
51             else {
52             require Carp;
53             Carp::croak qq{Bad value "$ms" for measurement_system};
54             }
55             };
56             return $args;
57             };
58              
59              
60             has length => (
61             is => 'ro',
62             isa => Measure,
63             );
64              
65              
66             has width => (
67             is => 'ro',
68             isa => Measure,
69             );
70              
71              
72             has height => (
73             is => 'ro',
74             isa => Measure,
75             );
76              
77              
78             has weight => (
79             is => 'ro',
80             isa => Measure,
81             );
82              
83              
84             has id => (
85             is => 'rw',
86             isa => Str,
87             );
88              
89              
90             has description => (
91             is => 'rw',
92             isa => Str,
93             );
94              
95             my %code_for_packaging_type = (
96             LETTER => '01',
97             PACKAGE => '02',
98             TUBE => '03',
99             UPS_PAK => '04',
100             UPS_EXPRESS_BOX => '21',
101             UPS_25KG_BOX => '24',
102             UPS_10KG_BOX => '25'
103             );
104              
105              
106             sub as_hash {
107 0     0 1 0 state $argcheck = compile(Object);
108 0         0 my ($self) = $argcheck->(@_);
109              
110 0         0 my %data = (
111             PackagingType => {
112             Code => $code_for_packaging_type{$self->packaging_type},
113             },
114             );
115              
116 0 0       0 if ($self->description) {
117 0         0 $data{Description} = $self->description;
118             }
119              
120 0 0 0     0 if ( $self->length || $self->width || $self->height ) {
      0        
121 0         0 $data{Dimensions} = {
122             UnitOfMeasurement => {
123             Code => $self->linear_unit,
124             }
125             };
126              
127 0 0       0 if ( $self->length ) {
128 0         0 $data{Dimensions}->{Length}= $self->length;
129             }
130 0 0       0 if ( $self->width ) {
131 0         0 $data{Dimensions}->{Width} = $self->width;
132             }
133 0 0       0 if ( $self->height ) {
134 0         0 $data{Dimensions}->{Height} = $self->height;
135             }
136             }
137              
138 0 0       0 if ( $self->weight ) {
139 0         0 $data{PackageWeight} = {
140             UnitOfMeasurement => {
141             Code => $self->weight_unit,
142             },
143             Weight => $self->weight,
144             };
145             }
146              
147 0 0       0 if (my $oversized = $self->is_oversized ) {
148 0         0 $data{OversizePackage} = $oversized;
149             }
150              
151 0         0 return \%data;
152             }
153              
154              
155             sub is_oversized {
156 33     33 1 3347 state $argcheck = compile(Object);
157 33         942 my ($self) = $argcheck->(@_);
158              
159 33 50 33     494 unless ( $self->width && $self->height && $self->length && $self->weight) {
      33        
      33        
160 0         0 return 0;
161             }
162              
163 33         94 my @sides = sort { $a <=> $b } ($self->length, $self->width, $self->height);
  93         102  
164 33         38 my $len = pop(@sides); # Get longest side
165 33         49 my $girth = ((2 * $sides[0]) + (2 * $sides[1]));
166 33         26 my $size = $len + $girth;
167              
168 33 100       82 my ($max_len,$max_size,
169             $min_size,
170             $os1_size,
171             $os2_size,
172             $os3_size,) =
173             $self->linear_unit eq 'IN' ?
174             ( 108, 165,
175             84,
176             108,
177             130,
178             165, ) :
179             ( 270, 419,
180             210,
181             270,
182             330,
183             419, );
184              
185 33 100       81 my ($max_weight,
186             $os1_weight,
187             $os2_weight,
188             $os3_weight) =
189             $self->weight_unit eq 'LBS' ?
190             ( 150,
191             30,
192             70,
193             90, ) :
194             ( 70,
195             10,
196             32,
197             40, );
198              
199 33 100 100     145 if ($len > $max_len or $self->weight > $max_weight or $size > $max_size) {
      100        
200 9         74 Net::Async::Webservice::UPS::Exception::BadPackage->throw({package=>$self});
201             }
202              
203 24 50       32 return 0 if ( $size <= $min_size ); # Below OS1
204 24 100       38 if ($size <= $os1_size) { # OS1 pgk is billed for 30lbs
205 12 100       64 return (($self->weight < $os1_weight) ? 1 : 0); # Not OS1 if weight > 30lbs
206             }
207 12 100       51 if ($size <= $os2_size) { # OS2 pgk is billed for 70lbs
208 6 100       36 return (($self->weight < $os2_weight) ? 2 : 0); # Not OS2 if weight > 70lbs
209             }
210 6 50       15 if ($size <= $os3_size) { # OS3 pgk is billed for 90lbs
211 6 100       35 return (($self->weight < $os3_weight) ? 3 : 0); # Not OS3 if weight > 90lbs
212             }
213             }
214              
215              
216             sub cache_id {
217 0     0 1   state $argcheck = compile(Object);
218 0           my ($self) = $argcheck->(@_);
219              
220 0   0       return join ':',
      0        
      0        
      0        
221             $self->packaging_type,$self->linear_unit,$self->weight_unit,
222             $self->length||0, $self->width||0, $self->height||0,
223             $self->weight||0,;
224             }
225              
226             1;
227              
228             __END__
229              
230             =pod
231              
232             =encoding UTF-8
233              
234             =head1 NAME
235              
236             Net::Async::Webservice::UPS::Package - a package for UPS
237              
238             =head1 VERSION
239              
240             version 1.1.2
241              
242             =head1 ATTRIBUTES
243              
244             =head2 C<packaging_type>
245              
246             Type of packaging (see
247             L<Net::Async::Webservice::UPS::Types/PackagingType>), defaults to
248             C<PACKAGE>.
249              
250             =head2 C<linear_unit>
251              
252             Either C<CM> or C<IN>, required.
253              
254             You can either pass this attribute directly, or use the
255             C<measurement_system> shortcut constructor parameter: if you pass C<<
256             measurement_system => 'english' >>, C<linear_unit> will be assumed to
257             be C<IN>; if you pass C<< measurement_system => 'metric' >>, it will
258             be assumed to be C<CM>.
259              
260             =head2 C<length>
261              
262             Length of the package, in centimeters or inches depending on
263             L</linear_unit>.
264              
265             =head2 C<width>
266              
267             Width of the package, in centimeters or inches depending on
268             L</linear_unit>.
269              
270             =head2 C<height>
271              
272             Height of the package, in centimeters or inches depending on
273             L</linear_unit>.
274              
275             =head2 C<weight>
276              
277             Weight of the package, in kilograms or pounds depending on
278             L</weight_unit>.
279              
280             =head2 C<id>
281              
282             Optional string, may be used to link package-level response parts to
283             the packages in a request.
284              
285             =head2 C<description>
286              
287             Optional string, description of the package; required when the package
288             is used in a return shipment.
289              
290             =head1 METHODS
291              
292             =head2 C<weight_unit>
293              
294             Either C<KGS> or C<LBS>, required.
295              
296             You can either pass this attribute directly, or use the
297             C<measurement_system> shortcut constructor parameter: if you pass C<<
298             measurement_system => 'english' >>, C<weight_unit> will be assumed to
299             be C<LBS>; if you pass C<< measurement_system => 'metric' >>, it will
300             be assumed to be C<KGS>.
301              
302             =head2 C<as_hash>
303              
304             Returns a hashref that, when passed through L<XML::Simple>, will
305             produce the XML fragment needed in UPS requests to represent this
306             package.
307              
308             =head2 C<is_oversized>
309              
310             Returns an I<integer> indicating whether this package is to be
311             considered "oversized", and if so, in which oversize class it fits.
312              
313             Mostly used internally by L</as_hash>.
314              
315             =head2 C<cache_id>
316              
317             Returns a string identifying this package.
318              
319             =for Pod::Coverage BUILDARGS
320              
321             =head1 AUTHORS
322              
323             =over 4
324              
325             =item *
326              
327             Gianni Ceccarelli <gianni.ceccarelli@net-a-porter.com>
328              
329             =item *
330              
331             Sherzod B. Ruzmetov <sherzodr@cpan.org>
332              
333             =back
334              
335             =head1 COPYRIGHT AND LICENSE
336              
337             This software is copyright (c) 2014 by Gianni Ceccarelli <gianni.ceccarelli@net-a-porter.com>.
338              
339             This is free software; you can redistribute it and/or modify it under
340             the same terms as the Perl 5 programming language system itself.
341              
342             =cut