File Coverage

blib/lib/Net/UPS.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;
2             $Net::UPS::VERSION = '0.14';
3             {
4             $Net::UPS::DIST = 'Net-UPS';
5             }
6 3     3   59318 use strict;
  3         7  
  3         121  
7 3     3   12 use warnings;
  3         5  
  3         101  
8 3     3   16 use Carp ('croak');
  3         10  
  3         211  
9 3     3   3016 use XML::Simple;
  0            
  0            
10             use Encode;
11             use LWP::UserAgent;
12             use Net::UPS::ErrorHandler;
13             use Net::UPS::Rate;
14             use Net::UPS::Service;
15             use Net::UPS::Address;
16             use Net::UPS::Package;
17             use Scalar::Util 'weaken';
18              
19             @Net::UPS::ISA = ( "Net::UPS::ErrorHandler" );
20             $Net::UPS::LIVE = 0;
21              
22             sub RATE_TEST_PROXY () { 'https://wwwcie.ups.com/ups.app/xml/Rate' }
23             sub RATE_LIVE_PROXY () { 'https://onlinetools.ups.com/ups.app/xml/Rate' }
24             sub AV_TEST_PROXY () { 'https://wwwcie.ups.com/ups.app/xml/AV' }
25             sub AV_LIVE_PROXY () { 'https://onlinetools.ups.com/ups.app/xml/AV' }
26             sub XAV_TEST_PROXY () { 'https://wwwcie.ups.com/ups.app/xml/XAV' }
27             sub XAV_LIVE_PROXY () { 'https://onlinetools.ups.com/ups.app/xml/XAV' }
28              
29             sub PICKUP_TYPES () {
30             return {
31             DAILY_PICKUP => '01',
32             DAILY => '01',
33             CUSTOMER_COUNTER => '03',
34             ONE_TIME_PICKUP => '06',
35             ONE_TIME => '06',
36             ON_CALL_AIR => '07',
37             SUGGESTED_RETAIL => '11',
38             SUGGESTED_RETAIL_RATES => '11',
39             LETTER_CENTER => '19',
40             AIR_SERVICE_CENTER => '20'
41             };
42             }
43              
44             sub CUSTOMER_CLASSIFICATION () {
45             return {
46             WHOLESALE => '01',
47             OCCASIONAL => '03',
48             RETAIL => '04'
49             };
50             }
51              
52              
53             sub import {
54             my $class = shift;
55             @_ or return;
56             if ( @_ % 2 ) {
57             croak "import(): argument list has tobe in key=>value format";
58             }
59             my $args = { @_ };
60             $Net::UPS::LIVE = $args->{live} || 0;
61             }
62              
63              
64             sub live {
65             my $class = shift;
66             unless ( @_ ) {
67             croak "$class->live(): usage error";
68             }
69             $Net::UPS::LIVE = shift;
70             }
71              
72              
73              
74             my $ups = undef;
75             sub new {
76             my $class = shift;
77             croak "new(): usage error" if ref($class);
78              
79             unless ( (@_ >= 1) || (@_ <= 4) ) {
80             croak "new(): invalid number of arguments";
81             }
82             $ups = bless({
83             __userid => $_[0] || undef,
84             __password => $_[1] || undef,
85             __access_key => $_[2] || undef,
86             __args => $_[3] || {},
87             __last_service=> undef
88             }, $class);
89              
90             if ( @_ < 3 ) {
91             $ups->_read_args_from_file(@_) or return undef;
92             }
93              
94             unless ( $ups->userid && $ups->password && $ups->access_key ) {
95             croak "new(): usage error. Required arguments missing";
96             }
97             if ( my $cache_life = $ups->{__args}->{cache_life} ) {
98             eval "require Cache::File";
99             if (my $errstr = $@ ) {
100             croak "'cache_life' requires Cache::File module";
101             }
102             unless ( $ups->{__args}->{cache_root} ) {
103             require File::Spec;
104             $ups->{__args}->{cache_root} = File::Spec->catdir(File::Spec->tmpdir, 'net_ups');
105             }
106             $ups->{__cache} = Cache::File->new( cache_root => $ups->{__args}->{cache_root},
107             default_expires => "$cache_life m",
108             cache_depth => 5,
109             lock_level => Cache::File::LOCK_LOCAL()
110             );
111             }
112             $ups->init();
113             return $ups;
114             }
115              
116              
117              
118              
119              
120             sub instance {
121             return $ups if defined($ups);
122             croak "instance(): no object instance found";
123             }
124              
125              
126              
127              
128             sub _read_args_from_file {
129             my $self = shift;
130             my ($path, $args) = @_;
131             $args ||= {};
132              
133             unless ( defined $path ) {
134             croak "_read_args_from_file(): required arguments are missing";
135             }
136              
137             require IO::File;
138             my $fh = IO::File->new($path, '<') or return $self->set_error("couldn't open $path: $!");
139             my %config = ();
140             while (local $_ = $fh->getline) {
141             next if /^\s*\#/;
142             next if /^\n/;
143             next unless /^UPS/;
144             chomp();
145             my ($key, $value) = m/^\s*UPS(\w+)\s+(\S+)$/;
146             $config{ $key } = $value;
147             }
148             unless ( $config{UserID} && $config{Password} && $config{AccessKey} ) {
149             return $self->set_error( "_read_args_from_file(): required arguments are missing" );
150             }
151             $self->{__userid} = $config{UserID};
152             $self->{__password} = $config{Password};
153             $self->{__access_key} = $config{AccessKey};
154              
155              
156             $self->{__args}->{customer_classification} = $args->{customer_classification} || $config{CustomerClassification};
157             $self->{__args}->{ups_account_number} = $args->{ups_account_number} || $config{AccountNumber};
158             $self->{__args}->{rate_proxy} = $args->{rate_proxy} || $config{RateProxy};
159             $self->{__args}->{av_proxy} = $args->{av_proxy} || $config{AVProxy};
160             $self->cache_life( $args->{cache_life} || $config{CacheLife} );
161             $self->cache_root( $args->{cache_root} || $config{CacheRoot} );
162              
163             return $self;
164             }
165              
166             sub init { }
167             sub rate_proxy { return $_[0]->{__args}->{rate_proxy} || ($Net::UPS::LIVE ? RATE_LIVE_PROXY : RATE_TEST_PROXY) }
168             sub av_proxy { return $_[0]->{__args}->{av_proxy} || ($Net::UPS::LIVE ? AV_LIVE_PROXY : AV_TEST_PROXY) }
169             sub xav_proxy { return $_[0]->{__args}->{xav_proxy} || ($Net::UPS::LIVE ? XAV_LIVE_PROXY : XAV_TEST_PROXY) }
170              
171             sub cache_life { return $_[0]->{__args}->{cache_life} = $_[1] }
172             sub cache_root { return $_[0]->{__args}->{cache_root} = $_[1] }
173             sub userid { return $_[0]->{__userid} }
174             sub password { return $_[0]->{__password} }
175             sub access_key { return $_[0]->{__access_key} }
176             sub account_number{return $_[0]->{__args}->{ups_account_number} }
177             sub customer_classification { return $_[0]->{__args}->{customer_classification} }
178             sub dump { return Dumper($_[0]) }
179              
180             sub ssl_options {
181             my ($self) = @_;
182              
183             unless ($self->{__args}{ssl_options}) {
184             require IO::Socket::SSL;
185             require IO::Socket::SSL::Utils;
186             my $cert = IO::Socket::SSL::Utils::PEM_string2cert(<<'PEM');
187             -----BEGIN CERTIFICATE-----
188             MIICPDCCAaUCEHC65B0Q2Sk0tjjKewPMur8wDQYJKoZIhvcNAQECBQAwXzELMAkGA1UEBhMCVVMx
189             FzAVBgNVBAoTDlZlcmlTaWduLCBJbmMuMTcwNQYDVQQLEy5DbGFzcyAzIFB1YmxpYyBQcmltYXJ5
190             IENlcnRpZmljYXRpb24gQXV0aG9yaXR5MB4XDTk2MDEyOTAwMDAwMFoXDTI4MDgwMTIzNTk1OVow
191             XzELMAkGA1UEBhMCVVMxFzAVBgNVBAoTDlZlcmlTaWduLCBJbmMuMTcwNQYDVQQLEy5DbGFzcyAz
192             IFB1YmxpYyBQcmltYXJ5IENlcnRpZmljYXRpb24gQXV0aG9yaXR5MIGfMA0GCSqGSIb3DQEBAQUA
193             A4GNADCBiQKBgQDJXFme8huKARS0EN8EQNvjV69qRUCPhAwL0TPZ2RHP7gJYHyX3KqhEBarsAx94
194             f56TuZoAqiN91qyFomNFx3InzPRMxnVx0jnvT0Lwdd8KkMaOIG+YD/isI19wKTakyYbnsZogy1Ol
195             hec9vn2a/iRFM9x2Fe0PonFkTGUugWhFpwIDAQABMA0GCSqGSIb3DQEBAgUAA4GBALtMEivPLCYA
196             TxQT3ab7/AoRhIzzKBxnki98tsX63/Dolbwdj2wsqFHMc9ikwFPwTtYmwHYBV4GSXiHx0bH/59Ah
197             WM1pF+NEHJwZRDmJXNycAA9WjQKZ7aKQRUzkuxCkPfAyAw7xzvjoyVGM5mKf5p/AfbdynMk2Omuf
198             Tqj/ZA1k
199             -----END CERTIFICATE-----
200             PEM
201             require Mozilla::CA;
202             $self->{__args}{ssl_options} = {
203             SSL_verify_mode => 1,
204             SSL_verifycn_scheme => 'www',
205             SSL_ca => [ $cert ],
206             SSL_ca_file => Mozilla::CA::SSL_ca_file(),
207             };
208             }
209             return $self->{__args}{ssl_options};
210             }
211              
212              
213             sub user_agent {
214             my ($self) = @_;
215              
216             unless ($self->{__args}{user_agent}) {
217             my $user_agent = LWP::UserAgent->new(
218             ssl_opts => $self->ssl_options,
219             );
220             $user_agent->env_proxy;
221             $self->{__args}{user_agent} = $user_agent;
222             }
223             return $self->{__args}{user_agent}
224             }
225              
226             sub access_as_xml {
227             my $self = shift;
228             return XMLout({
229             AccessRequest => {
230             AccessLicenseNumber => $self->access_key,
231             Password => $self->password,
232             UserId => $self->userid
233             }
234             }, NoAttr=>1, KeepRoot=>1, XMLDecl=>1);
235             }
236              
237             sub transaction_reference {
238             return {
239             CustomerContext => "Net::UPS",
240             XpciVersion => '1.0001'
241             };
242             }
243              
244             sub rate {
245             my $self = shift;
246             my ($from, $to, $packages, $args) = @_;
247             croak "rate(): usage error" unless ($from && $to && $packages);
248              
249             unless ( ref $from ) {
250             $from = Net::UPS::Address->new(postal_code=>$from);
251             }
252             unless ( ref $to ) {
253             $to = Net::UPS::Address->new(postal_code=>$to);
254             }
255             unless ( ref $packages eq 'ARRAY' ) {
256             $packages = [$packages];
257             }
258             $args ||= {};
259             $args->{mode} = "rate";
260             $args->{service} ||= "GROUND";
261              
262             my $services = $self->request_rate($from, $to, $packages, $args);
263             return if !defined $services;
264              
265             # we need to replace the rate->service ref with a non-weak one,
266             # but we also need to avoid the circular reference problem. Hence
267             # all this mess
268              
269             my $service = $services->[0];
270             my @rates = @{$service->rates()};
271             $service->rates([]); # now the service no longer references the rates
272             $_->service($service) for @rates; # and each rate has a non-weak service ref
273              
274             if ( @$packages == 1 ) {
275             return $rates[0];
276             }
277              
278             return \@rates;
279             }
280              
281              
282             sub shop_for_rates {
283             my $self = shift;
284             my ($from, $to, $packages, $args) = @_;
285              
286             unless ( $from && $to && $packages ) {
287             croak "shop_for_rates(): usage error";
288             }
289             unless ( ref $from ) {
290             $from = Net::UPS::Address->new(postal_code=>$from);
291             }
292             unless ( ref $to ) {
293             $to = Net::UPS::Address->new(postal_code=>$to);
294             }
295             unless ( ref $packages eq 'ARRAY' ) {
296             $packages = [$packages];
297             }
298             $args ||= {};
299             $args->{mode} = "shop";
300             $args->{service}||= "GROUND";
301              
302             # Scoob correction Aug 19th 2006 / cpan@pickledbrain.com
303             # There was a Perl run time error when no rates were found
304             # (empty package list, bad zip code etc...)
305             # request_rate() can now return undef in case of errors.
306             ####
307             my $services_aref = $self->request_rate($from, $to, $packages, $args);
308             if (defined $services_aref) {
309             return [sort {$a->total_charges <=>$b->total_charges} @$services_aref];
310             } else {
311             return undef; # No services were
312             }
313             }
314              
315             sub request_rate {
316             my $self = shift;
317             my ($from, $to, $packages, $args) = @_;
318              
319             croak "request_rate(): usage error" unless ($from && $to && $packages && $args);
320             unless (ref($from) && $from->isa("Net::UPS::Address")&&
321             ref($to) && $to->isa("Net::UPS::Address") &&
322             ref($packages) && (ref $packages eq 'ARRAY') &&
323             ref($args) && (ref $args eq 'HASH')) {
324             croak "request_rate(): usage error";
325             }
326             if ( defined($args->{limit_to}) ) {
327             unless ( ref($args->{limit_to}) && ref($args->{limit_to}) eq 'ARRAY' ) {
328             croak "request_rate(): usage error. 'limit_to' should be of type ARRAY";
329             }
330             }
331             if ( defined $args->{exclude} ) {
332             unless ( ref($args->{exclude}) && ref($args->{exclude}) eq 'ARRAY' ) {
333             croak "request_rate(): usage error. 'exclude' has to be of type 'ARRAY'";
334             }
335             }
336             if ( $args->{exclude} && $args->{limit_to} ) {
337             croak "request_rate(): usage error. You cannot use both 'limit_to' and 'exclude' at the same time";
338             }
339             unless (scalar(@$packages)) {
340             return $self->set_error( "request_rate() was given an empty list of packages!" );
341             }
342              
343             for (my $i=0; $i < @$packages; $i++ ) {
344             $packages->[$i]->id( $i + 1 );
345             }
346             my $cache_key = undef;
347             my $cache = undef;
348             if ( defined($cache = $self->{__cache}) ) {
349             $cache_key = $self->generate_cache_key($from, $to, $packages, $args);
350             if ( my $services = $cache->thaw($cache_key) ) {
351             return $services;
352             }
353             }
354             my %data = (
355             RatingServiceSelectionRequest => {
356             Request => {
357             RequestAction => 'Rate',
358             RequestOption => $args->{mode},
359             TransactionReference => $self->transaction_reference,
360             },
361             PickupType => {
362             Code => PICKUP_TYPES->{$self->{__args}->{pickup_type}||"ONE_TIME"}
363             },
364             Shipment => {
365             Service => { Code => Net::UPS::Service->new_from_label( $args->{service} )->code },
366             Package => [map { $_->as_hash()->{Package} } @$packages],
367             Shipper => $from->as_hash('AV'),
368             ShipTo => $to->as_hash('AV')
369             }
370             });
371             if ( my $shipper_number = $self->{__args}->{ups_account_number} ) {
372             $data{RatingServiceSelectionRequest}->{Shipment}->{Shipper}->{ShipperNumber} = $shipper_number;
373             }
374             if (my $classification_code = $self->{__args}->{customer_classification} ) {
375             $data{RatingServiceSelectionRequest}->{CustomerClassification}->{Code} = CUSTOMER_CLASSIFICATION->{$classification_code};
376             }
377             my $xml = $self->access_as_xml . XMLout(\%data, KeepRoot=>1, NoAttr=>1, KeyAttr=>[], XMLDecl=>1);
378             my $response = XMLin( $self->post( $self->rate_proxy, $xml ),
379             KeepRoot => 0,
380             NoAttr => 1,
381             KeyAttr => [],
382             ForceArray => ['RatedPackage', 'RatedShipment']);
383              
384             ##############################################################################
385             # Scoob correction Jan 2nd 2007 / cpan AT pickledbrain.com
386             #
387             # Changes to handle latest UPS xml service. See this document for details:
388             #
389             # This new release of the document:
390             # "UPS online tools
391             # Rates and Service Selection - XML Programming Invormation
392             # version 1.0, Volume 7, number 1 rev date Dec 17th 2006"
393             #
394             # Get it at: http://www.ups.com/onlinetools (registration required)
395             #
396             # UPS just introduced two new errors codes (warning level):
397             # ErrorCode: 110971
398             # ErrorSeverity: Warning
399             # ErrorDescription: 'Your invoice may vary from the displayed reference rates'
400             # AND
401             # ErrorCode: 110920
402             # ErrorSeverity: Warning
403             # ErrorDescription: 'Ship To address has been changed from (residential/commercial)
404             # to (commercial/residential)'
405             #
406             # The original code here did not handle any "warning" level
407             # (there were no other cases of warning level errors prior to this)
408             # and simply returned an error w/o the shipping rates.
409             #
410             # The code change below simply ignore those two warnings as they are
411             # essentially legal cover-your-ass and not all that useful here.
412             #
413             #####
414             # Ignore "Warning" level error
415             if ( my $error = $response->{Response}->{Error} ) {
416             unless ($error->{'ErrorSeverity'} eq 'Warning') {
417             return $self->set_error( $error->{ErrorDescription} );
418             }
419             }
420              
421             my @services;
422             for (my $i=0; $i < @{$response->{RatedShipment}}; $i++ ) {
423             my $ref = $response->{RatedShipment}->[$i] or die;
424             my $service = Net::UPS::Service->new_from_code($ref->{Service}->{Code});
425             $service->total_charges( $ref->{TotalCharges}->{MonetaryValue} );
426             $service->guaranteed_days(ref($ref->{GuaranteedDaysToDelivery}) ?
427             undef : $ref->{GuaranteedDaysToDelivery});
428             $service->rated_packages( $packages );
429             my @rates = ();
430             for (my $j=0; $j < @{$ref->{RatedPackage}}; $j++ ) {
431             push @rates, Net::UPS::Rate->new(
432             billing_weight => $ref->{RatedPackage}->[$j]->{BillingWeight}->{Weight},
433             total_charges => $ref->{RatedPackage}->[$j]->{TotalCharges}->{MonetaryValue},
434             rated_package => $packages->[$j],
435             service => $service,
436             from => $from,
437             to => $to
438             );
439             # bad hack! we have to do it this way because:
440             #
441             # 1) Class::Struct has no support for weak references
442             #
443             # 2) weakening the result of the accessor would not change
444             # the actual value inside the object
445             #
446             # 3) the objects created by Class::Struct by default are
447             # array-based
448             #
449             # we are clearly breaking encapsulation, and this may stop
450             # working if the internals of Class::Struct change. I
451             # can't see any better way, though.
452             weaken($rates[-1]->[3]);
453             }
454             $service->rates(\@rates);
455             if ( (lc($args->{mode}) eq 'shop') && defined($cache) ) {
456             local ($args->{mode}, $args->{service});
457             $args->{mode} = 'rate';
458             $args->{service} = $service->label;
459             my $cache_key = $self->generate_cache_key($from, $to, $packages, $args);
460             $cache->freeze($cache_key, [$service]);
461             }
462             if ( $args->{limit_to} ) {
463             my $limit_ok = 0;
464             for ( @{$args->{limit_to}} ) {
465             ($_ eq $service->label) && $limit_ok++;
466             }
467             $limit_ok or next;
468             }
469             if ( $args->{exclude} ) {
470             my $exclude_ok = 0;
471             for ( @{$args->{exclude}} ) {
472             ($_ eq $service->label) && $exclude_ok++;
473             }
474             $exclude_ok and next;
475             }
476             push @services, $service;
477             $self->{__last_service} = $service;
478              
479             }
480             if ( defined $cache ) {
481             $cache->freeze($cache_key, \@services);
482             }
483             return \@services;
484             }
485              
486              
487              
488              
489             sub service {
490             return $_[0]->{__last_service};
491             }
492              
493              
494             sub post {
495             my $self = shift;
496             my ($url, $content) = @_;
497              
498             unless ( $url && $content ) {
499             croak "post(): usage error";
500             }
501              
502             my $request = HTTP::Request->new('POST', $url);
503             $request->content( encode('utf-8',$content) );
504             my $response = $self->user_agent->request( $request );
505             if ( $response->is_error ) {
506             die $response->status_line();
507             }
508             return $response->content;
509             }
510              
511              
512              
513              
514             sub validate_address {
515             my $self = shift;
516             my ($address, $args) = @_;
517              
518             croak "verify_address(): usage error" unless defined($address);
519              
520             unless ( ref $address ) {
521             $address = {postal_code => $address};
522             }
523             if ( ref $address eq 'HASH' ) {
524             $address = Net::UPS::Address->new(%$address);
525             }
526             $args ||= {};
527             unless ( defined $args->{tolerance} ) {
528             $args->{tolerance} = 0.05;
529             }
530             unless ( ($args->{tolerance} >= 0) && ($args->{tolerance} <= 1) ) {
531             croak "validate_address(): invalid tolerance threshold";
532             }
533             my %data = (
534             AddressValidationRequest => {
535             Request => {
536             RequestAction => "AV",
537             TransactionReference => $self->transaction_reference(),
538             },
539             %{$address->as_hash('AV')},
540             }
541             );
542              
543             my $xml = $self->access_as_xml . XMLout(\%data, KeepRoot=>1, NoAttr=>1, KeyAttr=>[], XMLDecl=>1);
544             my $response = XMLin($self->post($self->av_proxy, $xml),
545             KeepRoot=>0, NoAttr=>1,
546             KeyAttr=>[], ForceArray=>["AddressValidationResult"]);
547              
548             if ( my $error = $response->{Response}->{Error} ) {
549             unless ($error->{'ErrorSeverity'} eq 'Warning') {
550             return $self->set_error( $error->{ErrorDescription} );
551             }
552             }
553             my @addresses = ();
554             for (my $i=0; $i < @{$response->{AddressValidationResult}}; $i++ ) {
555             my $ref = $response->{AddressValidationResult}->[$i];
556             next if $ref->{Quality} < (1 - $args->{tolerance});
557             while ( $ref->{PostalCodeLowEnd} <= $ref->{PostalCodeHighEnd} ) {
558             my $address = Net::UPS::Address->new(
559             quality => $ref->{Quality},
560             postal_code => $ref->{PostalCodeLowEnd},
561             city => $ref->{Address}->{City},
562             state => $ref->{Address}->{StateProvinceCode},
563             country_code => "US"
564             );
565             push @addresses, $address;
566             $ref->{PostalCodeLowEnd}++;
567             }
568             }
569             return \@addresses;
570             }
571              
572             sub validate_street_address {
573             my $self = shift;
574             my ($address, $args) = @_;
575              
576             croak "validate_street_address(): usage error" unless defined($address);
577              
578             unless ( ref $address ) {
579             $address = {postal_code => $address};
580             }
581             if ( ref $address eq 'HASH' ) {
582             $address = Net::UPS::StreetAddress->new(%$address);
583             }
584             $args ||= {};
585              
586             my %data = (
587             AddressValidationRequest => {
588             Request => {
589             RequestAction => "XAV",
590             RequestOption => "3",
591             TransactionReference => $self->transaction_reference(),
592             },
593             %{$address->as_hash('XAV')},
594             },
595             );
596              
597             my $xml = $self->access_as_xml . XMLout(\%data, KeepRoot=>1, NoAttr=>1, KeyAttr=>[], XMLDecl=>1);
598             my $response = XMLin($self->post($self->xav_proxy, $xml),
599             KeepRoot=>0, NoAttr=>1,
600             KeyAttr=>[], ForceArray=>["AddressValidationResponse", "AddressLine"]);
601              
602             if ( my $error = $response->{Response}->{Error} ) {
603             unless ($error->{'ErrorSeverity'} eq 'Warning') {
604             return $self->set_error( $error->{ErrorDescription} );
605             }
606             }
607             if ( $response->{NoCandidatesIndicator} )
608             {
609             return $self->set_error("The Address Matching System is not able to match an address from any other one in the database.");
610             }
611             my $quality = 0;
612             if ( $response->{AmbiguousAddressIndicator} )
613             {
614             $self->set_error("The Address Matching System is not able to explicitly differentiate an address from any other one in the database.");
615             }
616             elsif ( $response->{ValidAddressIndicator} )
617             {
618             $quality = 1;
619             }
620              
621             my $response_address;
622             if ($response->{AddressKeyFormat}) {
623             my $akf = $response->{AddressKeyFormat};
624             if (ref($akf) eq 'ARRAY') {
625             $akf = $akf->[0];
626             }
627             $response_address = Net::UPS::Address->new(
628             quality => $quality,
629             building_name => $akf->{BuildingName},
630             address => $akf->{AddressLine}->[0],
631             address2 => $akf->{AddressLine}->[1],
632             address3 => $akf->{AddressLine}->[2],
633             postal_code => $akf->{PostcodePrimaryLow},
634             postal_code_extended => $akf->{PostcodeExtendedLow},
635             city => $akf->{PoliticalDivision2},
636             state => $akf->{PoliticalDivision1},
637             country_code => $akf->{CountryCode},
638             is_commercial => ( $response->{AddressClassification}->{Code} eq "1" ) ? 1 : 0,
639             is_residential => ( $response->{AddressClassification}->{Code} eq "2" ) ? 1 : 0,
640             );
641             }
642              
643             return $response_address;
644             }
645              
646             sub generate_cache_key {
647             my $self = shift;
648             my ($from, $to, $packages, $args) = @_;
649             unless ( $from && $to && $packages && ref($from) && ref($to) && ref($packages) ) {
650             croak "generate_cache_key(): usage error";
651             }
652             my @keys = ($from->cache_id, $to->cache_id);
653             for my $package ( @$packages ) {
654             push @keys, $package->cache_id;
655             }
656             for my $key ( sort keys %{$self->{__args}} ) {
657             push @keys, sprintf("%s:%s", lc $key, lc $self->{__args}->{$key} );
658             }
659             for my $key (sort keys %$args ) {
660             next if $key eq 'limit_to';
661             next if $key eq 'exclude';
662             push @keys, sprintf("%s:%s", lc $key, lc $args->{$key});
663             }
664             return join(":", @keys);
665             }
666              
667              
668              
669              
670             1;
671             __END__