Merge branch 'master' into WebGUI8
This commit is contained in:
Graham Knop
commit
2400f19099
797 changed files with 33894 additions and 27196 deletions
533
lib/WebGUI/Shop/ShipDriver/UPS.pm
Normal file
533
lib/WebGUI/Shop/ShipDriver/UPS.pm
Normal file
|
|
@ -0,0 +1,533 @@
|
|||
package WebGUI::Shop::ShipDriver::UPS;
|
||||
|
||||
use strict;
|
||||
use base qw/WebGUI::Shop::ShipDriver/;
|
||||
use WebGUI::Exception;
|
||||
use WebGUI::Exception::Shop;
|
||||
use XML::Simple;
|
||||
use LWP;
|
||||
use Tie::IxHash;
|
||||
use Locales;
|
||||
use Class::InsideOut qw/ :std /;
|
||||
use Data::Dumper;
|
||||
|
||||
public testMode => my %testMode;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Package WebGUI::Shop::ShipDriver::UPS
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Shipping driver for the United Parcel Service, for US Domestic shipping only.
|
||||
|
||||
The UPS XML interface will only do a lookup for one destination at a time. However,
|
||||
each destination may have multiple packages. This means that if a cart holds packages
|
||||
with multiple destinations, that multiple requests must be sent to the UPS server.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
See the master class, WebGUI::Shop::ShipDriver for information about
|
||||
base methods. These methods are customized in this class:
|
||||
|
||||
=cut
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 buildXML ( $cart, @packages )
|
||||
|
||||
Returns XML for submitting to the UPS servers
|
||||
|
||||
=head3 $cart
|
||||
|
||||
A WebGUI::Shop::Cart object. This allows us access to the user's
|
||||
address book
|
||||
|
||||
=head3 $packages
|
||||
|
||||
An array reference. Each array element is 1 set of items. The
|
||||
quantity of items will vary in each set. All packages in the set must
|
||||
go to the same zipcode.
|
||||
|
||||
=cut
|
||||
|
||||
sub buildXML {
|
||||
my ($self, $cart, $packages) = @_;
|
||||
#tie my %xmlHash, 'Tie::IxHash';
|
||||
my %xmlHash = (
|
||||
AccessRequest => {},
|
||||
);
|
||||
my $xmlAcc = $xmlHash{AccessRequest};
|
||||
$xmlAcc->{'xml:lang'} = 'en-US';
|
||||
$xmlAcc->{AccessLicenseNumber} = [ $self->get('licenseNo') ];
|
||||
$xmlAcc->{UserId} = [ $self->get('userId') ];
|
||||
$xmlAcc->{Password} = [ $self->get('password') ];
|
||||
my $localizedCountry = Locales->new('en');
|
||||
my $xml = XMLout(\%xmlHash,
|
||||
KeepRoot => 1,
|
||||
NoSort => 1,
|
||||
SuppressEmpty => 0,
|
||||
XMLDecl => 1,
|
||||
);
|
||||
my $destination = $packages->[0]->[0]->getShippingAddress;
|
||||
%xmlHash = (
|
||||
RatingServiceSelectionRequest => {},
|
||||
);
|
||||
my $xmlRate = $xmlHash{RatingServiceSelectionRequest };
|
||||
$xmlRate->{'xml:lang'} = 'en-US';
|
||||
$xmlRate->{Request} = {
|
||||
# Shown in example request, but optional
|
||||
# TransactionReference => {
|
||||
# CustomerContext => [ 'Rating and Service' ],
|
||||
# XpciVersion => [ 1.0001 ],
|
||||
# },
|
||||
RequestAction => [ 'Rate' ],
|
||||
# RequestOption => [ 'shop' ],
|
||||
};
|
||||
$xmlRate->{PickupType} = {
|
||||
Code => [ $self->get('pickupType') ],
|
||||
};
|
||||
$xmlRate->{CustomerClassification} = {
|
||||
Code => [ $self->get('customerClassification') ],
|
||||
};
|
||||
$xmlRate->{Shipment} = {
|
||||
Shipper => {
|
||||
Address => [ {
|
||||
PostalCode => [ $self->get('sourceZip') ],
|
||||
CountryCode => [ $localizedCountry->get_code_from_territory($self->get('sourceCountry')) ],
|
||||
}, ],
|
||||
},
|
||||
ShipTo => {
|
||||
Address => [ {
|
||||
PostalCode => [ $destination->get('code') ],
|
||||
CountryCode => [ $localizedCountry->get_code_from_territory($destination->get('country')) ],
|
||||
} ],
|
||||
},
|
||||
Service => {
|
||||
Code => [ $self->get('shipService') ],
|
||||
},
|
||||
Package => [],
|
||||
};
|
||||
if ($self->get('residentialIndicator') eq 'residential') {
|
||||
$xmlRate->{Shipment}->{ShipTo}->{Address}->[0]->{ResidentialAddressIndicator} = [''];
|
||||
}
|
||||
my $packHash = $xmlRate->{Shipment}->{Package};
|
||||
PACKAGE: foreach my $package (@{ $packages }) {
|
||||
my $weight = 0;
|
||||
ITEM: foreach my $item (@{ $package }) {
|
||||
my $sku = $item->getSku();
|
||||
next ITEM unless $sku->isShippingRequired;
|
||||
##If shipsSeparately is set, the item was placed N times in the shippingBundles,
|
||||
##where N is the quantity. This means that the quantity is wrong for
|
||||
##any item where that option is set.
|
||||
my $skuWeight = $sku->getWeight;
|
||||
if (! $sku->shipsSeparately() ) {
|
||||
$skuWeight *= $item->get('quantity');
|
||||
}
|
||||
$weight += $skuWeight;
|
||||
}
|
||||
next PACKAGE unless $weight;
|
||||
$weight = sprintf "%.1f", $weight;
|
||||
$weight = '0.1' if $weight == 0;
|
||||
my $options = {
|
||||
PackagingType => [ {
|
||||
Code => [ '02' ],
|
||||
} ],
|
||||
PackageWeight => [ {
|
||||
Weight => [ $weight ], ##Required formatting from spec
|
||||
} ],
|
||||
};
|
||||
push @{ $packHash }, $options;
|
||||
}
|
||||
return '' unless scalar @{ $packHash }; ##Nothing to calculate shipping for.
|
||||
$xml .= XMLout(\%xmlHash,
|
||||
KeepRoot => 1,
|
||||
NoSort => 1,
|
||||
SuppressEmpty => '',
|
||||
XMLDecl => 1,
|
||||
);
|
||||
|
||||
return $xml;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 calculate ( $cart )
|
||||
|
||||
Returns a shipping price. Since the UPS will only allow a lookup from one source
|
||||
to one destination at a time, this method may make several XML requests from the
|
||||
UPS server.
|
||||
|
||||
=head3 $cart
|
||||
|
||||
A WebGUI::Shop::Cart object. The contents of the cart are analyzed to calculate
|
||||
the shipping costs. If no items in the cart require shipping, then no shipping
|
||||
costs are assessed.
|
||||
|
||||
=cut
|
||||
|
||||
sub calculate {
|
||||
my ($self, $cart) = @_;
|
||||
if (! $self->get('sourceZip')) {
|
||||
WebGUI::Error::InvalidParam->throw(error => q{Driver configured without a source zipcode.});
|
||||
}
|
||||
if (! $self->get('sourceCountry')) {
|
||||
WebGUI::Error::InvalidParam->throw(error => q{Driver configured without a source country.});
|
||||
}
|
||||
if (! $self->get('userId')) {
|
||||
WebGUI::Error::InvalidParam->throw(error => q{Driver configured without a UPS userId.});
|
||||
}
|
||||
if (! $self->get('password')) {
|
||||
WebGUI::Error::InvalidParam->throw(error => q{Driver configured without a UPS password.});
|
||||
}
|
||||
if (! $self->get('licenseNo')) {
|
||||
WebGUI::Error::InvalidParam->throw(error => q{Driver configured without a UPS license number.});
|
||||
}
|
||||
my $cost = 0;
|
||||
##Sort the items into shippable bundles.
|
||||
my @shippableUnits = $self->_getShippableUnits($cart);
|
||||
my $packageCount = scalar @shippableUnits;
|
||||
my $anyShippable = $packageCount > 0 ? 1 : 0;
|
||||
return $cost unless $anyShippable;
|
||||
#$cost = scalar @shippableUnits * $self->get('flatFee');
|
||||
##Build XML ($cart, @shippableUnits)
|
||||
foreach my $unit (@shippableUnits) {
|
||||
if ($packageCount > 200) {
|
||||
WebGUI::Error::InvalidParam->throw(error => q{Cannot do UPS lookups for more than 200 items.});
|
||||
}
|
||||
my $xml = $self->buildXML($cart, $unit);
|
||||
##Do request ($xml)
|
||||
my $response = $self->_doXmlRequest($xml);
|
||||
##Error handling
|
||||
if (! $response->is_success) {
|
||||
WebGUI::Error::Shop::RemoteShippingRate->throw(error => 'Problem connecting to UPS Web Tools: '. $response->status_line);
|
||||
}
|
||||
my $returnedXML = $response->content;
|
||||
my $xmlData = XMLin($returnedXML, ForceArray => [qw/RatedPackage/]);
|
||||
if (! $xmlData->{Response}->{ResponseStatusCode}) {
|
||||
WebGUI::Error::Shop::RemoteShippingRate->throw(error => 'Problem with UPS Online Tools XML: '. $xmlData->{Response}->{Error}->{ErrorDescription});
|
||||
}
|
||||
##Summarize costs from returned data
|
||||
$cost += $self->_calculateFromXML($xmlData);
|
||||
}
|
||||
return $cost;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 _calculateFromXML ( $xmlData )
|
||||
|
||||
Takes data from the UPS and returns the calculated shipping price.
|
||||
|
||||
=head3 $xmlData
|
||||
|
||||
Processed data from an XML rate request, as a perl data structure. The data is expected to
|
||||
have this structure:
|
||||
|
||||
{
|
||||
RatedShipment => {
|
||||
TotalCharges => {
|
||||
MonetaryValue => xx.yy
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
=cut
|
||||
|
||||
sub _calculateFromXML {
|
||||
my ($self, $xmlData) = @_;
|
||||
##Additional error checking on the XML data can be done in here. Or, in the future,
|
||||
##individual elements of the cost can be parsed and returned.
|
||||
return $xmlData->{RatedShipment}->{TotalCharges}->{MonetaryValue};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 definition ( $session )
|
||||
|
||||
This subroutine returns an arrayref of hashrefs, used to validate data put into
|
||||
the object by the user, and to automatically generate the edit form to show
|
||||
the user.
|
||||
|
||||
=cut
|
||||
|
||||
sub definition {
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
WebGUI::Error::InvalidParam->throw(error => q{Must provide a session variable})
|
||||
unless ref $session eq 'WebGUI::Session';
|
||||
my $definition = shift || [];
|
||||
my $i18n = WebGUI::International->new($session, 'ShipDriver_UPS');
|
||||
|
||||
tie my %shippingTypes, 'Tie::IxHash';
|
||||
##Other shipping types can be added below, but also need to be handled by the
|
||||
##javascript.
|
||||
$shippingTypes{'us domestic'} = $i18n->get('us domestic');
|
||||
$shippingTypes{'us international'} = $i18n->get('us international');
|
||||
|
||||
tie my %shippingServices, 'Tie::IxHash';
|
||||
##Note, these keys are required XML keywords in the UPS XML API.
|
||||
##It needs a one of every key, regardless of the correct label.
|
||||
##The right set of options is set via JavaScript in the form.
|
||||
$shippingServices{'01'} = $i18n->get('us domestic 01');
|
||||
$shippingServices{'02'} = $i18n->get('us domestic 02');
|
||||
$shippingServices{'03'} = $i18n->get('us domestic 03');
|
||||
$shippingServices{'07'} = $i18n->get('us international 07');
|
||||
$shippingServices{'08'} = $i18n->get('us international 08');
|
||||
$shippingServices{'11'} = $i18n->get('us international 11');
|
||||
$shippingServices{'12'} = $i18n->get('us domestic 12');
|
||||
$shippingServices{'13'} = $i18n->get('us domestic 13');
|
||||
$shippingServices{'14'} = $i18n->get('us domestic 14');
|
||||
$shippingServices{'54'} = $i18n->get('us international 54');
|
||||
$shippingServices{'59'} = $i18n->get('us domestic 59');
|
||||
$shippingServices{'65'} = $i18n->get('us international 65');
|
||||
|
||||
tie my %pickupTypes, 'Tie::IxHash';
|
||||
##Note, these keys are required XML keywords in the UPS XML API.
|
||||
$pickupTypes{'01'} = $i18n->get('pickup code 01');
|
||||
$pickupTypes{'03'} = $i18n->get('pickup code 03');
|
||||
$pickupTypes{'06'} = $i18n->get('pickup code 06');
|
||||
$pickupTypes{'07'} = $i18n->get('pickup code 07');
|
||||
$pickupTypes{'11'} = $i18n->get('pickup code 11');
|
||||
$pickupTypes{'19'} = $i18n->get('pickup code 19');
|
||||
$pickupTypes{'20'} = $i18n->get('pickup code 20');
|
||||
|
||||
tie my %customerClassification, 'Tie::IxHash';
|
||||
##Note, these keys are required XML keywords in the UPS XML API.
|
||||
$customerClassification{'01'} = $i18n->get('customer classification 01');
|
||||
$customerClassification{'03'} = $i18n->get('customer classification 03');
|
||||
$customerClassification{'04'} = $i18n->get('customer classification 04');
|
||||
|
||||
my $localizedCountries = Locales->new('en'); ##Note, for future i18n change the locale
|
||||
tie my %localizedCountries, 'Tie::IxHash';
|
||||
%localizedCountries = map { $_ => $_ } grep { !ref $_ } $localizedCountries->get_territory_names();
|
||||
|
||||
tie my %fields, 'Tie::IxHash';
|
||||
%fields = (
|
||||
instructions => {
|
||||
fieldType => 'readOnly',
|
||||
label => $i18n->get('instructions'),
|
||||
defaultValue => $i18n->get('ups instructions'),
|
||||
noFormProcess => 1,
|
||||
},
|
||||
userId => {
|
||||
fieldType => 'text',
|
||||
label => $i18n->get('userid'),
|
||||
hoverHelp => $i18n->get('userid help'),
|
||||
defaultValue => '',
|
||||
},
|
||||
password => {
|
||||
fieldType => 'password',
|
||||
label => $i18n->get('password'),
|
||||
hoverHelp => $i18n->get('password help'),
|
||||
defaultValue => '',
|
||||
},
|
||||
licenseNo => {
|
||||
fieldType => 'text',
|
||||
label => $i18n->get('license'),
|
||||
hoverHelp => $i18n->get('license help'),
|
||||
defaultValue => '',
|
||||
},
|
||||
sourceZip => {
|
||||
fieldType => 'zipcode',
|
||||
label => $i18n->get('source zipcode'),
|
||||
hoverHelp => $i18n->get('source zipcode help'),
|
||||
defaultValue => '',
|
||||
},
|
||||
sourceCountry => {
|
||||
fieldType => 'selectBox',
|
||||
label => $i18n->get('source country'),
|
||||
hoverHelp => $i18n->get('source country help'),
|
||||
options => \%localizedCountries,
|
||||
defaultValue => 'US',
|
||||
},
|
||||
shipType => {
|
||||
fieldType => 'selectBox',
|
||||
label => $i18n->get('ship type'),
|
||||
hoverHelp => $i18n->get('ship type help'),
|
||||
options => \%shippingTypes,
|
||||
defaultValue => 'us domestic',
|
||||
extras => q{onchange="WebGUI.ShipDriver.UPS.changeServices(this.options[this.selectedIndex].value,'shipService_formId')"},
|
||||
},
|
||||
shipService => {
|
||||
fieldType => 'selectBox',
|
||||
label => $i18n->get('ship service'),
|
||||
hoverHelp => $i18n->get('ship service help'),
|
||||
options => \%shippingServices,
|
||||
defaultValue => '03',
|
||||
},
|
||||
pickupType => {
|
||||
fieldType => 'selectBox',
|
||||
label => $i18n->get('pickup type'),
|
||||
hoverHelp => $i18n->get('pickup type help'),
|
||||
options => \%pickupTypes,
|
||||
defaultValue => '01',
|
||||
},
|
||||
customerClassification => {
|
||||
fieldType => 'selectBox',
|
||||
label => $i18n->get('customer classification'),
|
||||
hoverHelp => $i18n->get('customer classification help'),
|
||||
options => \%customerClassification,
|
||||
defaultValue => '01',
|
||||
},
|
||||
residentialIndicator => {
|
||||
fieldType => 'radioList',
|
||||
label => $i18n->get('residential'),
|
||||
hoverHelp => $i18n->get('residential help'),
|
||||
options => {
|
||||
residential => $i18n->get('residential'),
|
||||
commercial => $i18n->get('commercial'),
|
||||
},
|
||||
defaultValue => 'commercial',
|
||||
},
|
||||
##Note, if a flat fee is added to this driver, then according to the license
|
||||
##terms the website must display a note to the user (shop customer) that additional
|
||||
##fees have been added.
|
||||
# flatFee => {
|
||||
# fieldType => 'float',
|
||||
# label => $i18n->get('flatFee'),
|
||||
# hoverHelp => $i18n->get('flatFee help'),
|
||||
# defaultValue => 0,
|
||||
# },
|
||||
);
|
||||
my %properties = (
|
||||
name => 'UPS',
|
||||
properties => \%fields,
|
||||
);
|
||||
push @{ $definition }, \%properties;
|
||||
return $class->SUPER::definition($session, $definition);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 _doXmlRequest ( $xml )
|
||||
|
||||
Contact the UPS website and submit the XML for a shipping rate lookup.
|
||||
Returns a LWP::UserAgent response object.
|
||||
|
||||
=head3 $xml
|
||||
|
||||
XML to send. It has some very high standards, including XML components in
|
||||
the right order and sets of allowed tags.
|
||||
|
||||
=cut
|
||||
|
||||
sub _doXmlRequest {
|
||||
my ($self, $xml) = @_;
|
||||
my $userAgent = LWP::UserAgent->new;
|
||||
$userAgent->env_proxy;
|
||||
$userAgent->agent('WebGUI');
|
||||
#
|
||||
my $url;
|
||||
if ($self->testMode) {
|
||||
$url = 'https://wwwcie.ups.com/ups.app/xml/Rate';
|
||||
}
|
||||
else {
|
||||
$url = 'https://wwwcie.ups.com/ups.app/xml/Rate';
|
||||
}
|
||||
my $request = HTTP::Request->new(POST => $url);
|
||||
$request->content_type( 'text/xml' );
|
||||
$request->content( $xml );
|
||||
|
||||
my $response = $userAgent->request($request);
|
||||
return $response;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getEditForm ( )
|
||||
|
||||
Override the master method to stuff in some javascript.
|
||||
|
||||
=cut
|
||||
|
||||
sub getEditForm {
|
||||
my $self = shift;
|
||||
$self->session->style->setScript(
|
||||
$self->session->url->extras('yui/build/utilities/utilities.js'),
|
||||
{ type => 'text/javascript', },
|
||||
);
|
||||
$self->session->style->setScript(
|
||||
$self->session->url->extras('yui/build/yahoo-dom-event/yahoo-dom-event.js'),
|
||||
{ type => 'text/javascript', },
|
||||
);
|
||||
$self->session->style->setScript(
|
||||
$self->session->url->extras('yui/build/json/json-min.js'),
|
||||
{ type => 'text/javascript', },
|
||||
);
|
||||
$self->session->style->setScript(
|
||||
$self->session->url->extras('yui-webgui/build/i18n/i18n.js'),
|
||||
{ type => 'text/javascript', },
|
||||
);
|
||||
$self->session->style->setScript(
|
||||
$self->session->url->extras('yui-webgui/build/ShipDriver/UPS.js'),
|
||||
{ type => 'text/javascript', },
|
||||
);
|
||||
$self->session->style->setRawHeadTags(<<EOL);
|
||||
<script type="text/javascript">
|
||||
YAHOO.util.Event.onDOMReady( WebGUI.ShipDriver.UPS.initI18n );
|
||||
</script>
|
||||
EOL
|
||||
return $self->SUPER::getEditForm();
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 _getShippableUnits ( $cart )
|
||||
|
||||
This is a private method.
|
||||
|
||||
Sorts items into the cart by how they must be shipped; together, separate,
|
||||
etc, following these rules:
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
Each item which ships separately is 1 shippable unit.
|
||||
|
||||
=item *
|
||||
|
||||
All loose items are bundled together by zip code.
|
||||
|
||||
=back
|
||||
|
||||
This method returns a
|
||||
|
||||
For an empty cart (which shouldn't ever happen), it would return an empty array.
|
||||
|
||||
=head3 $cart
|
||||
|
||||
A WebGUI::Shop::Cart object. It provides access to the items in the cart
|
||||
that must be sorted.
|
||||
|
||||
=cut
|
||||
|
||||
sub _getShippableUnits {
|
||||
my ($self, $cart) = @_;
|
||||
##All units sorted by zip code. Loose units kept separately so they
|
||||
##can be easily bundled together by zip code.
|
||||
my %shippableUnits = ();
|
||||
my %looseUnits = ();
|
||||
ITEM: foreach my $item (@{$cart->getItems}) {
|
||||
my $sku = $item->getSku;
|
||||
next ITEM unless $sku->isShippingRequired;
|
||||
my $zip = $item->getShippingAddress->get('code');
|
||||
if ($sku->shipsSeparately) {
|
||||
push @{ $shippableUnits{$zip} }, ( [ $item ] ) x $item->get('quantity');
|
||||
}
|
||||
else {
|
||||
push @{ $looseUnits{$zip} }, $item;
|
||||
}
|
||||
}
|
||||
##Merge the two together now
|
||||
while (my ($zip, $units) = each %looseUnits) {
|
||||
push @{ $shippableUnits{$zip} }, $units;
|
||||
}
|
||||
return values %shippableUnits;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -6,6 +6,7 @@ use WebGUI::Exception;
|
|||
use XML::Simple;
|
||||
use LWP;
|
||||
use Tie::IxHash;
|
||||
use Data::Dumper;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
|
|
@ -13,7 +14,7 @@ Package WebGUI::Shop::ShipDriver::USPS
|
|||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Shipping driver for the United States Postal Service.
|
||||
Shipping driver for the United States Postal Service, domestic shipping services.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
|
|
@ -53,9 +54,12 @@ sub buildXML {
|
|||
$xmlTop->{Package} = [];
|
||||
##Do a request for each package.
|
||||
my $packageIndex;
|
||||
my $shipType = $self->get('shipType');
|
||||
my $service = $shipType eq 'PRIORITY VARIABLE' ? 'PRIORITY'
|
||||
: $shipType;
|
||||
my $shipType = $self->get('shipType');
|
||||
my $service = $shipType eq 'PRIORITY VARIABLE'
|
||||
? 'PRIORITY'
|
||||
: $shipType;
|
||||
my $sourceZip = $self->get('sourceZip');
|
||||
$sourceZip =~ s/^(\d{5}).*$/$1/;
|
||||
PACKAGE: for(my $packageIndex = 0; $packageIndex < scalar @packages; $packageIndex++) {
|
||||
my $package = $packages[$packageIndex];
|
||||
next PACKAGE unless scalar @{ $package };
|
||||
|
|
@ -72,9 +76,13 @@ sub buildXML {
|
|||
$weight += $itemWeight;
|
||||
}
|
||||
my $pounds = int($weight);
|
||||
my $ounces = int(16 * ($weight - $pounds));
|
||||
my $ounces = sprintf '%3.1f', (16 * ($weight - $pounds));
|
||||
if ($pounds == 0 && $ounces eq '0.0' ) {
|
||||
$ounces = 0.1;
|
||||
}
|
||||
my $destination = $package->[0]->getShippingAddress;
|
||||
my $destZipCode = $destination->get('code');
|
||||
$destZipCode =~ s/^(\d{5}).*$/$1/;
|
||||
$packageData{ID} = $packageIndex;
|
||||
$packageData{Service} = [ $service ];
|
||||
$packageData{ZipOrigination} = [ $self->get('sourceZip') ];
|
||||
|
|
@ -126,6 +134,9 @@ sub calculate {
|
|||
if (! $self->get('userId')) {
|
||||
WebGUI::Error::InvalidParam->throw(error => q{Driver configured without a USPS userId.});
|
||||
}
|
||||
if ($cart->getShippingAddress->get('country') ne 'United States') {
|
||||
WebGUI::Error::InvalidParam->throw(error => q{Driver only handles domestic shipping});
|
||||
}
|
||||
my $cost = 0;
|
||||
##Sort the items into shippable bundles.
|
||||
my @shippableUnits = $self->_getShippableUnits($cart);
|
||||
|
|
@ -142,15 +153,16 @@ sub calculate {
|
|||
my $response = $self->_doXmlRequest($xml);
|
||||
##Error handling
|
||||
if (! $response->is_success) {
|
||||
WebGUI::Error::RemoteShippingRate->throw(error => 'Problem connecting to USPS Web Tools: '. $response->status_line);
|
||||
WebGUI::Error::Shop::RemoteShippingRate->throw(error => 'Problem connecting to USPS Web Tools: '. $response->status_line);
|
||||
}
|
||||
my $returnedXML = $response->content;
|
||||
my $xmlData = XMLin($returnedXML, ForceArray => [qw/Package/]);
|
||||
my $xmlData = XMLin($returnedXML, KeepRoot => 1, ForceArray => [qw/Package/]);
|
||||
if (exists $xmlData->{Error}) {
|
||||
WebGUI::Error::RemoteShippingRate->throw(error => 'Problem with USPS Web Tools XML: '. $xmlData->{Description});
|
||||
WebGUI::Error::Shop::RemoteShippingRate->throw(error => 'Problem with USPS Web Tools XML: '. $xmlData->{Error}->{Description});
|
||||
}
|
||||
##Summarize costs from returned data
|
||||
$cost = $self->_calculateFromXML($xmlData, @shippableUnits);
|
||||
$cost += $self->_calculateInsurance(@shippableUnits);
|
||||
return $cost;
|
||||
}
|
||||
|
||||
|
|
@ -166,14 +178,16 @@ Processed XML data from an XML rate request, processed in perl data structure.
|
|||
have this structure:
|
||||
|
||||
{
|
||||
Package => [
|
||||
{
|
||||
ID => 0,
|
||||
Postage => {
|
||||
Rate => some_number
|
||||
}
|
||||
},
|
||||
]
|
||||
RateV3Response => {
|
||||
Package => [
|
||||
{
|
||||
ID => 0,
|
||||
Postage => {
|
||||
Rate => some_number
|
||||
}
|
||||
},
|
||||
]
|
||||
}
|
||||
}
|
||||
|
||||
=head3 @shippableUnits
|
||||
|
|
@ -185,12 +199,15 @@ The set of shippable units, which are required to do quantity lookups.
|
|||
sub _calculateFromXML {
|
||||
my ($self, $xmlData, @shippableUnits) = @_;
|
||||
my $cost = 0;
|
||||
foreach my $package (@{ $xmlData->{Package} }) {
|
||||
foreach my $package (@{ $xmlData->{RateV3Response}->{Package} }) {
|
||||
my $id = $package->{ID};
|
||||
my $rate = $package->{Postage}->{Rate};
|
||||
##Error check for invalid index
|
||||
if ($id < 0 || $id > $#shippableUnits) {
|
||||
WebGUI::Error::RemoteShippingRate->throw(error => "Illegal package index returned by USPS: $id");
|
||||
if ($id < 0 || $id > $#shippableUnits || $id !~ /^\d+$/) {
|
||||
WebGUI::Error::Shop::RemoteShippingRate->throw(error => "Illegal package index returned by USPS: $id");
|
||||
}
|
||||
if (exists $package->{Error}) {
|
||||
WebGUI::Error::Shop::RemoteShippingRate->throw(error => $package->{Error}->{Description});
|
||||
}
|
||||
my $unit = $shippableUnits[$id];
|
||||
if ($unit->[0]->getSku->isShippingSeparately) {
|
||||
|
|
@ -208,6 +225,74 @@ sub _calculateFromXML {
|
|||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 _calculateInsurance ( @shippableUnits )
|
||||
|
||||
Takes data from the USPS and returns the calculated shipping price.
|
||||
|
||||
=head3 @shippableUnits
|
||||
|
||||
The set of shippable units, which are required to do quantity and cost lookups.
|
||||
|
||||
=cut
|
||||
|
||||
sub _calculateInsurance {
|
||||
my ($self, @shippableUnits) = @_;
|
||||
my $insuranceCost = 0;
|
||||
return $insuranceCost unless $self->get('addInsurance') && $self->get('insuranceRates');
|
||||
my @insuranceTable = _parseInsuranceRates($self->get('insuranceRates'));
|
||||
##Sort by decreasing value for easy post processing
|
||||
@insuranceTable = sort { $a->[0] <=> $b->[0] } @insuranceTable;
|
||||
foreach my $package (@shippableUnits) {
|
||||
my $value = 0;
|
||||
ITEM: foreach my $item (@{ $package }) {
|
||||
$value += $item->getSku->getPrice() * $item->get('quantity');
|
||||
}
|
||||
my $pricePoint;
|
||||
POINT: foreach my $point (@insuranceTable) {
|
||||
if ($value < $point->[0]) {
|
||||
$pricePoint = $point;
|
||||
last POINT;
|
||||
}
|
||||
}
|
||||
if (!defined $pricePoint) {
|
||||
$pricePoint = $insuranceTable[-1];
|
||||
}
|
||||
$insuranceCost += $pricePoint->[1];
|
||||
}
|
||||
return $insuranceCost;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 _parseInsuranceRates ( $rates )
|
||||
|
||||
Take the user entered data, a string, and turn it into an array.
|
||||
|
||||
=head3 $rates
|
||||
|
||||
The rate data entered by the user. One set of data per line. Each line has the value of
|
||||
shipment, a colon, and the cost of insuring a shipment of that value.
|
||||
|
||||
=cut
|
||||
|
||||
sub _parseInsuranceRates {
|
||||
my $rates = shift;
|
||||
$rates =~ tr/\r//d;
|
||||
my $number = qr/\d+(?:\.\d+)?/;
|
||||
my $rate = qr{ \s* $number \s* : \s* $number \s* }x;
|
||||
return () if ($rates !~ m{ \A (?: $rate \r?\n )* $rate (?:\r\n)? \Z }x);
|
||||
my @lines = split /\n/, $rates;
|
||||
my @table = ();
|
||||
foreach my $line (@lines) {
|
||||
$line =~ s/\s+//g;
|
||||
my ($value, $cost) = split /:/, $line;
|
||||
push @table, [ $value, $cost ];
|
||||
}
|
||||
return @table;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 definition ( $session )
|
||||
|
||||
This subroutine returns an arrayref of hashrefs, used to validate data put into
|
||||
|
|
@ -262,6 +347,18 @@ sub definition {
|
|||
options => \%shippingTypes,
|
||||
defaultValue => 'PARCEL',
|
||||
},
|
||||
addInsurance => {
|
||||
fieldType => 'yesNo',
|
||||
label => $i18n->get('add insurance'),
|
||||
hoverHelp => $i18n->get('add insurance help'),
|
||||
defaultValue => 0,
|
||||
},
|
||||
insuranceRates => {
|
||||
fieldType => 'textarea',
|
||||
label => $i18n->get('insurance rates'),
|
||||
hoverHelp => $i18n->get('insurance rates help'),
|
||||
defaultValue => "50:1.75\n100:2.25",
|
||||
},
|
||||
##Note, if a flat fee is added to this driver, then according to the license
|
||||
##terms the website must display a note to the user (shop customer) that additional
|
||||
##fees have been added.
|
||||
|
|
@ -299,6 +396,7 @@ sub _doXmlRequest {
|
|||
my $userAgent = LWP::UserAgent->new;
|
||||
$userAgent->env_proxy;
|
||||
$userAgent->agent('WebGUI');
|
||||
$userAgent->timeout('45');
|
||||
my $url = 'http://production.shippingapis.com/ShippingAPI.dll?API=RateV3&XML=';
|
||||
$url .= $xml;
|
||||
my $request = HTTP::Request->new(GET => $url);
|
||||
|
|
@ -344,6 +442,9 @@ sub _getShippableUnits {
|
|||
}
|
||||
else {
|
||||
my $zip = $item->getShippingAddress->get('code');
|
||||
if ($item->getShippingAddress->get('country') ne 'United States') {
|
||||
WebGUI::Error::InvalidParam->throw(error => q{Driver only handles domestic shipping});
|
||||
}
|
||||
push @{ $looseUnits{$zip} }, $item;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
411
lib/WebGUI/Shop/ShipDriver/USPSInternational.pm
Normal file
411
lib/WebGUI/Shop/ShipDriver/USPSInternational.pm
Normal file
|
|
@ -0,0 +1,411 @@
|
|||
package WebGUI::Shop::ShipDriver::USPSInternational;
|
||||
|
||||
use strict;
|
||||
use base qw/WebGUI::Shop::ShipDriver/;
|
||||
use WebGUI::Exception;
|
||||
use XML::Simple;
|
||||
use LWP;
|
||||
use Tie::IxHash;
|
||||
use Data::Dumper;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Package WebGUI::Shop::ShipDriver::USPSInternational
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Shipping driver for the United States Postal Service, international shipping services.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
See the master class, WebGUI::Shop::ShipDriver for information about
|
||||
base methods. These methods are customized in this class:
|
||||
|
||||
=cut
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 buildXML ( $cart, @packages )
|
||||
|
||||
Returns XML for submitting to the US Postal Service servers
|
||||
|
||||
=head3 $cart
|
||||
|
||||
A WebGUI::Shop::Cart object. This allows us access to the user's
|
||||
address book
|
||||
|
||||
=head3 @packages
|
||||
|
||||
An array of array references. Each array element is 1 set of items. The
|
||||
quantity of items will vary in each set. If the quantity of an item
|
||||
is more than 1, then we will check for shipping 1 item, and multiple the
|
||||
result by the quantity, rather than doing several identical checks.
|
||||
|
||||
=cut
|
||||
|
||||
sub buildXML {
|
||||
my ($self, $cart, @packages) = @_;
|
||||
tie my %xmlHash, 'Tie::IxHash';
|
||||
%xmlHash = ( IntlRateRequest => {}, );
|
||||
my $xmlTop = $xmlHash{IntlRateRequest};
|
||||
$xmlTop->{USERID} = $self->get('userId');
|
||||
$xmlTop->{Package} = [];
|
||||
##Do a request for each package.
|
||||
my $packageIndex;
|
||||
PACKAGE: for(my $packageIndex = 0; $packageIndex < scalar @packages; $packageIndex++) {
|
||||
my $package = $packages[$packageIndex];
|
||||
next PACKAGE unless scalar @{ $package };
|
||||
tie my %packageData, 'Tie::IxHash';
|
||||
my $weight = 0;
|
||||
my $value = 0;
|
||||
foreach my $item (@{ $package }) {
|
||||
my $sku = $item->getSku;
|
||||
my $itemWeight = $sku->getWeight();
|
||||
my $itemValue = $sku->getPrice();
|
||||
##Items that ship separately with a quantity > 1 are rate estimated as 1 item and then the
|
||||
##shipping cost is multiplied by the quantity.
|
||||
if (! $sku->shipsSeparately ) {
|
||||
$itemWeight *= $item->get('quantity');
|
||||
$itemValue *= $item->get('quantity');
|
||||
}
|
||||
$weight += $itemWeight;
|
||||
$value += $itemValue;
|
||||
}
|
||||
my $pounds = int($weight);
|
||||
my $ounces = sprintf '%3.1f', (16 * ($weight - $pounds));
|
||||
if ($pounds == 0 && $ounces eq '0.0' ) {
|
||||
$ounces = 0.1;
|
||||
}
|
||||
$value = sprintf '%.2f', $value;
|
||||
my $destination = $package->[0]->getShippingAddress;
|
||||
my $country = $self->correctCountry($destination->get('country'));
|
||||
$packageData{ID} = $packageIndex;
|
||||
$packageData{Pounds} = [ $pounds ];
|
||||
$packageData{Ounces} = [ $ounces ];
|
||||
$packageData{Machinable} = [ 'true' ];
|
||||
$packageData{MailType} = [ 'Package' ];
|
||||
if ($self->get('addInsurance')) {
|
||||
$packageData{ValueOfContents} = [ $value ];
|
||||
}
|
||||
$packageData{Country} = [ $country ];
|
||||
push @{ $xmlTop->{Package} }, \%packageData;
|
||||
}
|
||||
my $xml = XMLout(\%xmlHash,
|
||||
KeepRoot => 1,
|
||||
NoSort => 1,
|
||||
NoIndent => 1,
|
||||
KeyAttr => {
|
||||
Package => 'ID',
|
||||
},
|
||||
SuppressEmpty => 0,
|
||||
);
|
||||
return $xml;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 calculate ( $cart )
|
||||
|
||||
Returns a shipping price.
|
||||
|
||||
=head3 $cart
|
||||
|
||||
A WebGUI::Shop::Cart object. The contents of the cart are analyzed to calculate
|
||||
the shipping costs. If no items in the cart require shipping, then no shipping
|
||||
costs are assessed.
|
||||
|
||||
=cut
|
||||
|
||||
sub calculate {
|
||||
my ($self, $cart) = @_;
|
||||
if (! $self->get('userId')) {
|
||||
WebGUI::Error::InvalidParam->throw(error => q{Driver configured without a USPS userId.});
|
||||
}
|
||||
if ($cart->getShippingAddress->get('country') eq 'United States') {
|
||||
WebGUI::Error::InvalidParam->throw(error => q{Driver only handles international shipping});
|
||||
}
|
||||
my $cost = 0;
|
||||
##Sort the items into shippable bundles.
|
||||
my @shippableUnits = $self->_getShippableUnits($cart);
|
||||
my $packageCount = scalar @shippableUnits;
|
||||
if ($packageCount > 25) {
|
||||
WebGUI::Error::InvalidParam->throw(error => q{Cannot do USPS lookups for more than 25 items.});
|
||||
}
|
||||
my $anyShippable = $packageCount > 0 ? 1 : 0;
|
||||
return $cost unless $anyShippable;
|
||||
#$cost = scalar @shippableUnits * $self->get('flatFee');
|
||||
##Build XML ($cart, @shippableUnits)
|
||||
my $xml = $self->buildXML($cart, @shippableUnits);
|
||||
##Do request ($xml)
|
||||
my $response = $self->_doXmlRequest($xml);
|
||||
##Error handling
|
||||
if (! $response->is_success) {
|
||||
WebGUI::Error::Shop::RemoteShippingRate->throw(error => 'Problem connecting to USPS Web Tools: '. $response->status_line);
|
||||
}
|
||||
my $returnedXML = $response->content;
|
||||
#warn $returnedXML;
|
||||
my $xmlData = XMLin($returnedXML, KeepRoot => 1, ForceArray => [qw/Package/]);
|
||||
if (exists $xmlData->{Error}) {
|
||||
WebGUI::Error::Shop::RemoteShippingRate->throw(error => 'Problem with USPS Web Tools XML: '. $xmlData->{Error}->{Description});
|
||||
}
|
||||
##Summarize costs from returned data
|
||||
$cost = $self->_calculateFromXML($xmlData, @shippableUnits);
|
||||
return $cost;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 _calculateFromXML ( $xmlData, @shippableUnits )
|
||||
|
||||
Takes data from the USPS and returns the calculated shipping price.
|
||||
|
||||
=head3 $xmlData
|
||||
|
||||
Processed XML data from an XML rate request, processed in perl data structure. The data is expected to
|
||||
have this structure:
|
||||
|
||||
{
|
||||
IntlRateResponse => {
|
||||
Package => [
|
||||
{
|
||||
ID => 0,
|
||||
Postage => {
|
||||
Rate => some_number
|
||||
}
|
||||
},
|
||||
]
|
||||
}
|
||||
}
|
||||
|
||||
=head3 @shippableUnits
|
||||
|
||||
The set of shippable units, which are required to do quantity lookups.
|
||||
|
||||
=cut
|
||||
|
||||
sub _calculateFromXML {
|
||||
my ($self, $xmlData, @shippableUnits) = @_;
|
||||
my $cost = 0;
|
||||
foreach my $package (@{ $xmlData->{IntlRateResponse}->{Package} }) {
|
||||
my $id = $package->{ID};
|
||||
##Error check for invalid index
|
||||
if ($id < 0 || $id > $#shippableUnits || $id !~ /^\d+$/) {
|
||||
WebGUI::Error::Shop::RemoteShippingRate->throw(error => "Illegal package index returned by USPS: $id");
|
||||
}
|
||||
if (exists $package->{Error}) {
|
||||
WebGUI::Error::Shop::RemoteShippingRate->throw(error => $package->{Error}->{Description});
|
||||
}
|
||||
my $unit = $shippableUnits[$id];
|
||||
my $rate;
|
||||
SERVICE: foreach my $service (@{ $package->{Service} }) {
|
||||
next SERVICE unless $service->{ID} eq $self->get('shipType');
|
||||
$rate = $service->{Postage};
|
||||
if ($self->get('addInsurance')) {
|
||||
if (exists $service->{InsComment}) {
|
||||
WebGUI::Error::Shop::RemoteShippingRate->throw(error => "No insurance because of: ".$service->{InsComment});
|
||||
}
|
||||
$rate += $service->{Insurance};
|
||||
}
|
||||
}
|
||||
if (!$rate) {
|
||||
WebGUI::Error::Shop::RemoteShippingRate->throw(error => 'Selected shipping service not available');
|
||||
}
|
||||
if ($unit->[0]->getSku->shipsSeparately) {
|
||||
##This is a single item due to ships separately. Since in reality there will be
|
||||
## N things being shipped, multiply the rate by the quantity.
|
||||
$cost += $rate * $unit->[0]->get('quantity');
|
||||
}
|
||||
else {
|
||||
##This is a loose bundle of items, all shipped together
|
||||
$cost += $rate;
|
||||
}
|
||||
}
|
||||
return $cost;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 correctCountry ( $country )
|
||||
|
||||
Correct country names to be compliant with USPS International's ICL.
|
||||
|
||||
=cut
|
||||
|
||||
sub correctCountry {
|
||||
my $self = shift;
|
||||
my $country = shift;
|
||||
return $country eq q{United Kingdom} ? q{United Kingdom (Great Britain)}
|
||||
: $country eq q{Congo, the Democratic Republic of the} ? q{Congo, Democratic Republic of the}
|
||||
: $country eq q{Cocos (Keeling) Islands} ? q{Cocos Island (Australia)}
|
||||
: $country eq q{Congo} ? q{Congo, Republic of the}
|
||||
: $country eq q{Christmas Island} ? q{Christmas Island (Australia)}
|
||||
: $country eq q{Georgia} ? q{Georgia, Republic of}
|
||||
: $country eq q{Heard and Mc Donald Islands} ? q{Australia}
|
||||
: $country eq q{Korea (South)} ? q{South Korea}
|
||||
: $country eq q{Korea, Republic of} ? q{Democratic People's Republic of Korea}
|
||||
: $country eq q{Lao People's Democratic Republic} ? q{Laos}
|
||||
: $country eq q{Macedonia} ? q{Macedonia, Republic of}
|
||||
: $country eq q{Moldova, Republic of} ? q{Moldova}
|
||||
: $country eq q{Pitcairn} ? q{Pitcairn Island}
|
||||
: $country eq q{Russian Federation} ? q{Russia}
|
||||
: $country eq q{Slovakia} ? q{Slovak Republic}
|
||||
: $country eq q{Tokelau} ? q{Tokelau (Union) Group (Western Samoa)}
|
||||
: $country eq q{Trinidad} ? q{Trinidad and Tobago}
|
||||
: $country eq q{Vatican City State (Holy See)} ? q{Vatican City}
|
||||
: $country eq q{Viet Nam} ? q{Vietnam}
|
||||
: $country eq q{Virgin Islands (U.S.)} ? q{Virgin Islands U.S.}
|
||||
: $country;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 definition ( $session )
|
||||
|
||||
This subroutine returns an arrayref of hashrefs, used to validate data put into
|
||||
the object by the user, and to automatically generate the edit form to show
|
||||
the user.
|
||||
|
||||
=cut
|
||||
|
||||
sub definition {
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
WebGUI::Error::InvalidParam->throw(error => q{Must provide a session variable})
|
||||
unless ref $session eq 'WebGUI::Session';
|
||||
my $definition = shift || [];
|
||||
my $i18n = WebGUI::International->new($session, 'ShipDriver_USPS');
|
||||
my $i18n2 = WebGUI::International->new($session, 'ShipDriver_USPSInternational');
|
||||
tie my %shippingTypes, 'Tie::IxHash';
|
||||
##Note, these keys are used by buildXML
|
||||
$shippingTypes{1} = $i18n2->get('express mail international');
|
||||
$shippingTypes{2} = $i18n2->get('priority mail international');
|
||||
$shippingTypes{6} = $i18n2->get('global express guaranteed rectangular');
|
||||
$shippingTypes{7} = $i18n2->get('global express guaranteed non-rectangular');
|
||||
$shippingTypes{9} = $i18n2->get('priority mail flat rate box');
|
||||
$shippingTypes{11} = $i18n2->get('priority mail large flat rate box');
|
||||
$shippingTypes{15} = $i18n2->get('first class mail international parcels');
|
||||
$shippingTypes{16} = $i18n2->get('priority mail small flat rate box');
|
||||
tie my %fields, 'Tie::IxHash';
|
||||
%fields = (
|
||||
instructions => {
|
||||
fieldType => 'readOnly',
|
||||
label => $i18n->get('instructions'),
|
||||
defaultValue => $i18n->get('usps instructions'),
|
||||
noFormProcess => 1,
|
||||
},
|
||||
userId => {
|
||||
fieldType => 'text',
|
||||
label => $i18n->get('userid'),
|
||||
hoverHelp => $i18n->get('userid help'),
|
||||
defaultValue => '',
|
||||
},
|
||||
shipType => {
|
||||
fieldType => 'selectBox',
|
||||
label => $i18n->get('ship type'),
|
||||
hoverHelp => $i18n->get('ship type help'),
|
||||
options => \%shippingTypes,
|
||||
defaultValue => 'PARCEL',
|
||||
},
|
||||
addInsurance => {
|
||||
fieldType => 'yesNo',
|
||||
label => $i18n->get('add insurance'),
|
||||
hoverHelp => $i18n->get('add insurance help'),
|
||||
defaultValue => 0,
|
||||
},
|
||||
##Note, if a flat fee is added to this driver, then according to the license
|
||||
##terms the website must display a note to the user (shop customer) that additional
|
||||
##fees have been added.
|
||||
# flatFee => {
|
||||
# fieldType => 'float',
|
||||
# label => $i18n->get('flatFee'),
|
||||
# hoverHelp => $i18n->get('flatFee help'),
|
||||
# defaultValue => 0,
|
||||
# },
|
||||
);
|
||||
my %properties = (
|
||||
name => $i18n2->get('U.S. Postal Service, International'),
|
||||
properties => \%fields,
|
||||
);
|
||||
push @{ $definition }, \%properties;
|
||||
return $class->SUPER::definition($session, $definition);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 _doXmlRequest ( $xml )
|
||||
|
||||
Contact the USPS website and submit the XML for a shipping rate lookup.
|
||||
Returns a LWP::UserAgent response object.
|
||||
|
||||
=head3 $xml
|
||||
|
||||
XML to send. It has some very high standards, including XML components in
|
||||
the right order and sets of allowed tags.
|
||||
|
||||
=cut
|
||||
|
||||
sub _doXmlRequest {
|
||||
my ($self, $xml) = @_;
|
||||
my $userAgent = LWP::UserAgent->new;
|
||||
$userAgent->env_proxy;
|
||||
$userAgent->agent('WebGUI');
|
||||
$userAgent->timeout('45');
|
||||
my $url = 'http://production.shippingapis.com/ShippingAPI.dll?API=IntlRate&XML=';
|
||||
$url .= $xml;
|
||||
my $request = HTTP::Request->new(GET => $url);
|
||||
my $response = $userAgent->request($request);
|
||||
return $response;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 _getShippableUnits ( $cart )
|
||||
|
||||
This is a private method.
|
||||
|
||||
Sorts items into the cart by how they must be shipped, together, separate,
|
||||
etc. Returns an array of array references of cart items grouped by
|
||||
whether or not they ship separately, and then sorted by destination
|
||||
zip code.
|
||||
|
||||
If an item in the cart must be shipped separately, but has a quantity greater
|
||||
than 1, then for the purposes of looking up shipping costs it is returned
|
||||
as 1 bundle, since the total cost can now be calculated by multiplying the
|
||||
quantity together with the cost for a single unit.
|
||||
|
||||
For an empty cart (which shouldn't ever happen), it would return an empty array.
|
||||
|
||||
=head3 $cart
|
||||
|
||||
A WebGUI::Shop::Cart object. It provides access to the items in the cart
|
||||
that must be sorted.
|
||||
|
||||
=cut
|
||||
|
||||
sub _getShippableUnits {
|
||||
my ($self, $cart) = @_;
|
||||
my @shippableUnits = ();
|
||||
##Loose units are sorted by zip code.
|
||||
my %looseUnits = ();
|
||||
ITEM: foreach my $item (@{$cart->getItems}) {
|
||||
my $sku = $item->getSku;
|
||||
next ITEM unless $sku->isShippingRequired;
|
||||
if ($sku->shipsSeparately) {
|
||||
push @shippableUnits, [ $item ];
|
||||
}
|
||||
else {
|
||||
my $zip = $item->getShippingAddress->get('code');
|
||||
if ($item->getShippingAddress->get('country') eq 'United States') {
|
||||
WebGUI::Error::InvalidParam->throw(error => q{Driver only handles international shipping});
|
||||
}
|
||||
push @{ $looseUnits{$zip} }, $item;
|
||||
}
|
||||
}
|
||||
push @shippableUnits, values %looseUnits;
|
||||
return @shippableUnits;
|
||||
}
|
||||
|
||||
1;
|
||||
Loading…
Add table
Add a link
Reference in a new issue