File Coverage

blib/lib/Net/UPS/Package.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package Net::UPS::Package;
2             $Net::UPS::Package::VERSION = '0.15';
3             {
4             $Net::UPS::Package::DIST = 'Net-UPS';
5             }
6 4     4   209263 use strict;
  4         7  
  4         131  
7 4     4   20 use warnings;
  4         5  
  4         108  
8 4     4   17 use Carp ( 'croak' );
  4         4  
  4         242  
9 4     4   3863 use XML::Simple;
  0            
  0            
10             use Class::Struct 0.58;
11              
12             =head1 NAME
13              
14             Net::UPS::Package - Class representing a UPS Package
15              
16             =head1 SYNOPSIS
17              
18             $pkg = Net::UPS::Package->new();
19             $pkg->packaging_type('PACKAGE');
20             $pkg->measurement_system('metric');
21             $pkg->length(40);
22             $pkg->width(30);
23             $pkg->height(2);
24             $pkg->weight(10);
25              
26             =head1 DESCRIPTION
27              
28             Net::UPS::Package represents a single UPS package. In addition to the above attributes, I attribute will be set once package is submitted for a rate quote. I starts at I<1>, and will be incremented by one for each subsequent package submitted at single request. The purpose of this attribute is still not clear. Comments are welcome.
29              
30             =head1 METHODS
31              
32             In addition to all the aforementioned attributes, following method(s) are supported
33              
34             =over 4
35              
36             =cut
37              
38             struct(
39             id => '$',
40             packaging_type => '$',
41             measurement_system => '$',
42             length => '$',
43             width => '$',
44             height => '$',
45             weight => '$'
46             );
47              
48              
49             sub PACKAGE_CODES() {
50             return {
51             LETTER => '01',
52             PACKAGE => '02',
53             TUBE => '03',
54             UPS_PAK => '04',
55             UPS_EXPRESS_BOX => '21',
56             UPS_25KG_BOX => '24',
57             UPS_10KG_BOX => '25'
58             };
59             }
60              
61             sub _packaging2code {
62             my $self = shift;
63             my $label = shift;
64              
65             unless ( defined $label ) {
66             croak "_packaging2code(): usage error";
67             }
68             $label =~ s/\s+/_/g;
69             $label =~ s/\W+//g;
70             my $code = PACKAGE_CODES->{$label};
71             unless ( defined $code ) {
72             croak "Nothing known about package type '$label'";
73             }
74             return $code;
75             }
76              
77              
78              
79              
80              
81             sub as_hash {
82             my $self = shift;
83              
84             my $measurement_system = $self->measurement_system || 'english';
85              
86             my $weight_measure = ($measurement_system eq 'metric') ? 'KGS' : 'LBS';
87             my $length_measure = ($measurement_system eq 'metric') ? 'CM' : 'IN';
88             my %data = (
89             Package => {
90             PackagingType => {
91             Code => $self->packaging_type ? sprintf("%02d", $self->_packaging2code($self->packaging_type)) : '02',
92             },
93             DimensionalWeight => {
94             UnitOfMeasurement => {
95             Code => $weight_measure
96             }
97             },
98             PackageWeight => {
99             UnitOfMeasurement => {
100             Code => $weight_measure
101             }
102             }
103             }
104             );
105              
106             if ( $self->length || $self->width || $self->height ) {
107             $data{Package}->{Dimensions} = {
108             UnitOfMeasurement => {
109             Code => $length_measure
110             }
111             };
112              
113             if ( $self->length ) {
114             $data{Package}->{Dimensions}->{Length}= $self->length;
115             }
116             if ( $self->width ) {
117             $data{Package}->{Dimensions}->{Width} = $self->width;
118             }
119             if ( $self->height ) {
120             $data{Package}->{Dimensions}->{Height} = $self->height;
121             }
122             }
123              
124             if ( $self->weight ) {
125             $data{Package}->{PackageWeight}->{Weight} = $self->weight;
126             }
127             if (my $oversized = $self->is_oversized ) {
128             $data{Package}->{OversizePackage} = $oversized;
129             }
130             return \%data;
131             }
132              
133              
134             =item is_oversized
135              
136             Convenience method. Return value indicates if the package is oversized, and if so, its oversize level. Possible return values are I<0>, I<1>, I<2> and I<3>. I<0> means not oversized.
137              
138             =cut
139              
140             # Scoob correction Feb 26th 2006 / cpan@pickledbrain.com
141             #
142             # Definitions of oversize categories:
143             # http://www.ups.com/content/us/en/resources/prepare/oversize.html
144             #
145             # Length and Girth: Length + 2x Width + 2x Height
146             # Where Length is the longuest side of pkg rounded to nearest inch.
147             # And Girth is: 2x Width + 2x Height) (round width & height to nearest inch)
148             #
149             # Also as described in:
150             # http://www.ups.com/content/us/en/resources/prepare/guidelines/index.html
151             # - Packages can be up to 150 lbs (70 kg)
152             # - Packages can be up to 165 inches (419 cm) in length and girth combined
153             # - Packages can be up to 108 inches (270 cm) in length
154             # - Packages that weigh more than 70 lbs (31.5 kg, 25 kg within the EU) require a special heavy-package label
155             # - Oversize packages and packages with a large size-to-weight ratio require special pricing
156             # and dimensional weight calculations
157             #
158             # Understand that "Oversize" OS[123] package is a rating to compensate for
159             # a package that is very large but weights very little. UPS charges for
160             # a "billing weight" that is larger than the actual weight for OS packages.
161             # So for a package to be OS1 is must be 84 < size < 108 *AND* weight < 30lbs
162             # If a package is size 104" and has weight: 33lbs, is is NOT OS1 (because it is
163             # heavy enough that UPS will be fairly compensated by charging for weight only.
164             #
165             ###
166             sub is_oversized {
167             my $self = shift;
168              
169             unless ( $self->width && $self->height && $self->length && $self->weight) {
170             return 0;
171             }
172              
173             my @sides = sort { $a <=> $b } ($self->length, $self->width, $self->height);
174             my $len = pop(@sides); # Get longest side
175             my $girth = ((2 * $sides[0]) + (2 * $sides[1]));
176             my $size = $len + $girth;
177              
178             if (($len > 108) || ($self->weight > 150) || ($size > 165)) {
179             croak "Such package size/weight is not supported";
180             }
181              
182             return 0 if ( $size <= 84 ); # Below OS1
183             if ($size <= 108) { # OS1 pgk is billed for 30lbs
184             return (($self->weight < 30) ? 1 : 0); # Not OS1 if weight > 30lbs
185             }
186             if ($size <= 130) { # OS2 pgk is billed for 70lbs
187             return (($self->weight < 70) ? 2 : 0); # Not OS2 if weight > 70lbs
188             }
189             if ($size <= 165) { # OS3 pgk is billed for 90lbs
190             return (($self->weight < 90) ? 3 : 0); # Not OS3 if weight > 90lbs
191             return 3;
192             }
193              
194             }
195              
196              
197              
198              
199              
200             sub as_XML {
201             my $self = shift;
202             return XMLout( $self->as_hash, NoAttr=>1, KeepRoot=>1, SuppressEmpty=>1 )
203             }
204              
205              
206              
207              
208              
209              
210             sub cache_id {
211             my $self = shift;
212             my $packaging_type = $self->packaging_type || 'PACKAGE';
213             return $packaging_type . ':' . $self->length . ':' . $self->width .':'. $self->height .
214             ':'. $self->weight;
215             }
216              
217              
218              
219              
220             sub rate {
221             my $self = shift;
222             my $ups = Net::UPS->instance();
223             return $ups->rate( $_[0], $_[1], $self, $_[2]);
224             }
225              
226              
227             1;
228              
229             __END__