use
constant
UPS_ONLINE_DISABLED
=>
'1'
;
$VERSION
=
do
{
my
$r
=
q$Rev: 240 $
;
$r
=~ /\d+/; $&; };
use
base (
'Business::Shipping::RateRequest::Online'
);
use
POSIX (
'strftime'
);
[
new
=> [
qw/ -hash new /
],
scalar
=> [
'access_key'
],
scalar
=> [ {
-static
=> 1,
-default
=>
'access_key'
},
'Required'
],
scalar
=> [ {
-static
=> 1,
-default
=>
'test_server, no_ssl, to_city'
},
'Optional'
],
scalar
=> [ {
-type
=>
'Business::Shipping::UPS_Online::Shipment'
,
-default_ctor
=>
'new'
,
-forward
=> [
'from_city'
,
'to_city'
,
'from_country'
,
'from_country_abbrev'
,
'to_country'
,
'to_country_abbrev'
,
'to_ak_or_hi'
,
'from_zip'
,
'to_zip'
,
'packages'
,
'weight'
,
'shipper'
,
'domestic'
,
'intl'
,
'domestic_or_ca'
,
'from_canada'
,
'to_canada'
,
'from_ak_or_hi'
,
'packaging'
,
'to_residential'
,
'cod'
,
'cod_funds_code'
,
'cod_value'
,
],
},
'shipment'
],
scalar
=> [ {
-static
=> 1,
-default
=>
"shipment=>Business::Shipping::UPS_Online::Shipment"
},
'Has_a'
],
];
sub
from_state {}
sub
pickup_type
{
my
(
$self
) =
@_
;
$self
->{
'pickup_type'
} =
shift
if
@_
;
my
$alpha
= 1
if
(
$self
->{
'pickup_type'
} =~ /\w+/ );
if
(
$alpha
) {
my
%pickup_type_map
= (
'daily pickup'
=>
'01'
,
'customer counter'
=>
'03'
,
'one time pickup'
=>
'06'
,
'on call air'
=>
'07'
,
'letter center'
=>
'19'
,
'air service center'
=>
'20'
,
);
$self
->{
'pickup_type'
} =
$pickup_type_map
{
$self
->{
'pickup_type'
} }
if
$pickup_type_map
{
$self
->{
'pickup_type'
} }
or
$pickup_type_map
{
lc
(
$self
->{
'pickup_type'
} ) };
}
return
$self
->{
'pickup_type'
};
}
sub
_massage_values
{
trace(
'called'
);
my
(
$self
) =
@_
;
$self
->shipment->massage_values;
return
;
}
sub
_gen_request_xml
{
debug(
'called'
);
my
(
$self
) =
shift
;
logdie
"No packages defined internally."
unless
ref
$self
->shipment->packages();
foreach
my
$package
( @{
$self
->shipment->packages()} ) {
}
my
$access_tree
= {
'AccessRequest'
=> [
{
'xml:lang'
=>
'en-US'
,
'AccessLicenseNumber'
=> [
$self
->access_key() ],
'UserId'
=> [
$self
->user_id() ],
'Password'
=> [
$self
->password() ],
}
]
};
my
%shipment_tree
= (
'Shipper'
=> [ {
'Address'
=> [ {
'CountryCode'
=> [
$self
->from_country_abbrev() ],
'PostalCode'
=> [
$self
->from_zip() ],
} ],
} ],
'ShipTo'
=> [ {
'Address'
=> [ {
'ResidentialAddress'
=> [
$self
->to_residential() ],
'CountryCode'
=> [
$self
->to_country_abbrev() ],
'PostalCode'
=> [
$self
->to_zip() ],
'City'
=> [
$self
->to_city() ],
} ],
} ],
'Service'
=> [ {
'Code'
=> [
$self
->service_code ],
} ],
'ShipmentServiceSelfOptions'
=> { },
);
my
$shipment
=
$self
->shipment;
my
@packages
;
foreach
my
$package
(
$shipment
->packages() ) {
my
%package_service_options
;
if
(
$shipment
->cod ) {
%package_service_options
= (
'PackageServiceOptions'
=> [ {
'COD'
=> [ {
'CODFundsCode'
=> [
$shipment
->cod_funds_code ],
'CODCode'
=> [ 3 ],
'CODAmount'
=> [ {
'CurrencyCode'
=> [
'USD'
],
'MonetaryValue'
=> [
$shipment
->cod_value() ],
} ],
}],
} ],
);
}
push
(
@packages
, {
'PackagingType'
=> [ {
'Code'
=> [
$package
->packaging() ],
'Description'
=> [
'Package'
],
} ],
'Description'
=> [
'Rate Lookup'
],
'PackageWeight'
=> [ {
'Weight'
=> [
$package
->weight() ],
} ],
%package_service_options
}, );
}
$shipment_tree
{Package} = \
@packages
if
(
@packages
> 0 );
my
$req_option
=
ucfirst
$shipment
->service
if
ucfirst
$shipment
->service eq
'Shop'
;
my
$request_tree
= {
'RatingServiceSelectionRequest'
=> [ {
'Request'
=> [ {
'TransactionReference'
=> [ {
'CustomerContext'
=> [
'Rating and Service'
],
'XpciVersion'
=> [ 1.0001 ],
} ],
'RequestAction'
=> [
'Rate'
],
'RequestOption'
=> [
$req_option
],
} ],
'PickupType'
=> [ {
'Code'
=> [
'01'
]
} ],
'Shipment'
=> [ {
%shipment_tree
} ]
} ]
};
my
$access_xml
=
'<?xml version="1.0"?>'
.
"\n"
. XML::Simple::XMLout(
$access_tree
,
KeepRoot
=> 1 );
my
$request_xml
=
$access_xml
.
"\n"
.
'<?xml version="1.0"?>'
.
"\n"
. XML::Simple::XMLout(
$request_tree
,
KeepRoot
=> 1 );
debug3(
$request_xml
);
return
(
$request_xml
);
}
sub
get_total_charges
{
my
(
$self
) =
shift
;
return
$self
->{
'total_charges'
}
if
$self
->{
'total_charges'
};
return
0;
}
sub
_handle_response
{
my
(
$self
) =
@_
;
debug3(
"response = "
.
$self
->response()->content() );
my
$response_tree
= XML::Simple::XMLin(
$self
->response()->content(),
ForceArray
=> 0,
KeepRoot
=> 0,
);
my
$status_code
=
$response_tree
->{Response}->{ResponseStatusCode};
my
$status_description
=
$response_tree
->{Response}->{ResponseStatusDescription};
if
(
exists
(
$response_tree
->{Response}->{Error}) )
{
my
$errors
= (
ref
(
$response_tree
->{Response}->{Error} ) eq
'ARRAY'
)
?
$response_tree
->{Response}->{Error}
: [
$response_tree
->{Response}->{Error} ];
my
(
@errorDetails
,
$errorMsg
);
foreach
my
$errorHash
(
@$errors
)
{
my
$severity
=
$errorHash
->{ErrorSeverity};
my
$code
=
$errorHash
->{ErrorCode};
my
$error
=
$errorHash
->{ErrorDescription};
my
$retry_secs
=
$errorHash
->{MinimumRetrySeconds};
my
@err_locations
= ();
my
@err_contents
= ();
my
$err_location
=
''
;
if
(
exists
(
$errorHash
->{ErrorLocation}) )
{
my
$locations
= (
ref
$errorHash
->{ErrorLocation} eq
'ARRAY'
)
?
$errorHash
->{ErrorLocation}
: [
$errorHash
->{ErrorLocation} ];
foreach
my
$location
(
@$locations
)
{
my
(
$elem
,
$attrib
) = (
$location
->{ErrorLocationElementName},
$location
->{ErrorLocationAttributeName},);
$err_location
=
$elem
if
( !
defined
(
$err_location
) ||
$err_location
eq
''
);
push
(
@err_locations
, {
element
=>
$elem
,
attribute
=>
$attrib
} );
}
}
if
(
exists
(
$errorHash
->{ErrorDigest}) )
{
my
$digests
= (
ref
$errorHash
->{ErrorDigest} eq
'ARRAY'
)
?
$errorHash
->{ErrorDigest}
: [
$errorHash
->{ErrorDigest} ];
foreach
my
$digest
(
@$digests
)
{
push
(
@err_contents
,
$digest
);
}
}
push
(
@errorDetails
, {
error_code
=>
$code
,
error_msg
=>
$error
,
error_severity
=>
$severity
,
minimum_retry_seconds
=>
$retry_secs
,
locations
=> \
@err_locations
,
error_data
=> \
@err_contents
} );
if
( !
defined
(
$errorMsg
) &&
$error
and
$error
!~ /Success/ )
{
my
$combined_error_msg
=
"$status_description ($status_code): $error @ $err_location"
;
$combined_error_msg
=~ s/\s{3, }/ /g;
$errorMsg
=
$combined_error_msg
;
}
}
$self
->user_error(
$errorMsg
);
$self
->error_details(
@errorDetails
);
return
$self
->is_success(0)
if
( !
$status_code
);
}
my
@services_results
;
my
$ups_results
;
if
(
$self
->service_name and
$self
->service_name eq
'Shop'
) {
if
(
ref
$response_tree
->{ RatedShipment } ne
'ARRAY'
) {
$self
->user_error(
"UPS did not return shopped services"
);
return
$self
->clear_is_success();
}
$ups_results
=
$response_tree
->{ RatedShipment };
}
else
{
$ups_results
= [
$response_tree
->{ RatedShipment } ];
}
debug
"ups_results = "
. Dumper(
$ups_results
);
foreach
my
$ups_rate_info
(
@$ups_results
) {
my
$service_code
=
$ups_rate_info
->{ Service }->{ Code };
my
$charges
=
$ups_rate_info
->{ TotalCharges }->{ MonetaryValue };
my
$deliv_days
=
$ups_rate_info
->{ GuaranteedDaysToDelivery };
$deliv_days
=
undef
if
ref
$deliv_days
eq
'HASH'
;
my
$deliv_date
;
my
$deliv_date_formatted
;
if
(
$deliv_days
) {
my
@deliv_date
=
localtime
(
time
+ (
$deliv_days
* 86400 ) );
$deliv_date
= strftime
"%Y-%m-%d"
,
@deliv_date
;
$deliv_date_formatted
= strftime
"%a, %b %e"
,
@deliv_date
;
}
my
$service_hash
= {
code
=>
$service_code
,
nick
=>
$self
->shipment->service_code_to_nick(
$service_code
),
name
=>
$self
->shipment->service_code_to_name(
$service_code
),
deliv_days
=>
$deliv_days
,
deliv_date
=>
$deliv_date
,
charges
=>
$charges
,
charges_formatted
=> Business::Shipping::Util::currency( {},
$charges
),
deliv_date_formatted
=>
$deliv_date_formatted
,
};
push
@services_results
,
$service_hash
;
}
return
$self
->clear_is_success()
unless
(
@services_results
);
for
(
'shipper'
,
'service'
) {
if
( !
$self
->shipment->
$_
() ) {
$self
->shipment->
$_
(
'Unknown'
);
}
}
my
$results
= [
{
name
=>
$self
->shipper(),
rates
=> \
@services_results
,
}
];
debug3
'results = '
. uneval(
$results
);
$self
->results(
$results
);
if
( UPS_ONLINE_DISABLED ) {
die
"Support for UPS_Online has been disabled, see doc/UPS_Online_disabled.txt"
;
}
return
$self
->is_success( 1 );
}
no
warnings
'redefine'
;
sub
to_country_abbrev
{
my
(
$self
) =
@_
;
return
unless
$self
->to_country;
my
$online_ups_country_to_abbrev
= cfg()->{ ups_information }->{ online_ups_country_to_abbrev };
my
$countries
= config_to_hash(
$online_ups_country_to_abbrev
);
my
$to_country_abbrev
=
$countries
->{
$self
->to_country } ||
$self
->SUPER::to_country_abbrev();
return
$to_country_abbrev
||
$self
->to_country;
}
1;