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