1package Net::UPS::Package;
2$Net::UPS::Package::VERSION = '0.16';
3{
4  $Net::UPS::Package::DIST = 'Net-UPS';
5}
6use strict;
7use warnings;
8use Carp ( 'croak' );
9use XML::Simple;
10use Class::Struct 0.58;
11
12=head1 NAME
13
14Net::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
28Net::UPS::Package represents a single UPS package. In addition to the above attributes, I<id> attribute will be set once package is submitted for a rate quote. I<id> 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
32In addition to all the aforementioned attributes, following method(s) are supported
33
34=over 4
35
36=cut
37
38struct(
39    id                  => '$',
40    packaging_type      => '$',
41    measurement_system  => '$',
42    length              => '$',
43    width               => '$',
44    height              => '$',
45    weight              => '$'
46);
47
48
49sub 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
61sub _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
81sub 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
136Convenience 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###
166sub 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
200sub 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
210sub 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
220sub rate {
221    my $self = shift;
222    my $ups = Net::UPS->instance();
223    return $ups->rate( $_[0], $_[1], $self, $_[2]);
224}
225
226
2271;
228
229__END__
230
231
232=back
233
234=head1 AUTHOR AND LICENSING
235
236For support and licensing information refer to L<Net::UPS|Net::UPS/"AUTHOR">
237
238=cut
239
240