oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge branch 'ShipDriver_cio' into WebGUI8

Browse source
This commit is contained in:
Colin Kuskie 2010-10-14 20:02:14 -07:00
commit bf8bdd1ac6
16 changed files with 552 additions and 940 deletions
Download patch file Download diff file Expand all files Collapse all files

3
lib/WebGUI/Shop/Ship.pm
View file

@ -73,7 +73,8 @@ sub addShipper {
unless exists $self->getDrivers->{$requestedClass};
WebGUI::Error::InvalidParam->throw(error => q{You must pass a hashref of options to create a new ShipDriver object})
unless defined($options) and ref $options eq 'HASH' and scalar keys %{ $options };
my $driver = eval { WebGUI::Pluggable::instanciate($requestedClass, 'create', [ $self->session, $options ]) };
my $driver = eval { WebGUI::Pluggable::instanciate($requestedClass, 'new', [ $self->session, $options ]) };
$driver->write;
return $driver;
}

314
lib/WebGUI/Shop/ShipDriver.pm
View file

@ -2,7 +2,6 @@ package WebGUI::Shop::ShipDriver;
use strict;
use Class::InsideOut qw{ :std };
use Carp qw(croak);
use Tie::IxHash;
use WebGUI::International;
@ -10,6 +9,9 @@ use WebGUI::HTMLForm;
use WebGUI::Exception::Shop;
use JSON;
use Moose;
use WebGUI::Definition::Shop;
=head1 NAME
Package WebGUI::Shop::ShipDriver
@ -31,9 +33,78 @@ These subroutines are available from this package:
=cut
readonly session => my %session;
private options => my %options;
private shipperId => my %shipperId;
define tableName => 'shipper';
define pluginName => ['Shipping Driver', 'ShipDriver'];
property label => (
fieldType => 'text',
label => ['label', 'ShipDriver'],
hoverHelp => ['label help', 'ShipDriver'],
default => "Credit Card",
);
around label => sub {
my $orig = shift;
my $self = shift;
if (@_ > 0) {
my $label = shift;
$label = $self->getName($self->session) if $label eq '' || lc($label) eq 'untitled';
unshift @_, $label;
}
$self->$orig(@_);
};
property enabled => (
fieldType => 'yesNo',
label => ['enabled', 'ShipDriver'],
hoverHelp => ['enabled help', 'ShipDriver'],
default => 1,
);
property groupToUse => (
fieldType => 'group',
label => ['who can use', 'ShipDriver'],
hoverHelp => ['who can use help', 'ShipDriver'],
default => 7,
);
has [ qw/session shipperId/ ] => (
is => 'ro',
required => 1,
);
around BUILDARGS => sub {
my $orig = shift;
my $class = shift;
if(ref $_[0] eq 'HASH') {
##Standard Moose invocation for creating a new object
return $class->$orig(@_);
}
my $session = shift;
WebGUI::Error::InvalidParam->throw(error => q{Must provide a session variable})
unless blessed $session && $session->isa('WebGUI::Session');
if (ref $_[0] eq 'HASH') {
##Create an object from a hashref of options
my $options = shift;
$options->{session} = $session;
$options->{shipperId} = $session->id->generate;
return $class->$orig($options);
}
##Must be a paymentGatewayId, look it up in the database
my $shipperId = shift;
WebGUI::Error::InvalidParam->throw(error => q{Must provide a shipperId})
unless defined $shipperId;
my $properties = $session->db->quickHashRef('select * from shipper where shipperId=?', [
$shipperId,
]);
WebGUI::Error::ObjectNotFound->throw(error => q{shipperId not found in db}, id => $shipperId)
unless scalar keys %{ $properties };
croak "Somehow, the options property of this object, $shipperId, got broken in the db"
unless exists $properties->{options} and $properties->{options};
my $options = from_json($properties->{options});
$options->{session} = $session;
$options->{shipperId} = $shipperId;
return $class->$orig($options);
};
#-------------------------------------------------------------------
@ -88,88 +159,20 @@ sub canUse {
WebGUI::Error::InvalidParam->throw(error => q{Must provide user information})
}
}
return $userObject->isInGroup($self->get('groupToUse'));
return $userObject->isInGroup($self->groupToUse);
}
#-------------------------------------------------------------------
=head2 create ( $session, $options )
=head2 className ( )
Constructor for new WebGUI::Shop::ShipperDriver objects. Returns a WebGUI::Shop::ShipperDriver object.
To access driver objects that have already been configured, use C<new>.
=head3 $session
A WebGUI::Session object.
=head4 $options
A list of properties to assign to this ShipperDriver. See C<definition> for details.
Accessor for the className of the object. This is the name of the driver that is used
to do calculations.
=cut
sub create {
my $class = shift;
my $session = shift;
WebGUI::Error::InvalidParam->throw(error => q{Must provide a session variable})
unless ref $session eq 'WebGUI::Session';
my $options = shift;
WebGUI::Error::InvalidParam->throw(error => q{Must provide a hashref of options})
unless ref $options eq 'HASH' and scalar keys %{ $options };
my $shipperId = $session->id->generate;
$session->db->write('insert into shipper (shipperId,className) VALUES (?,?)', [$shipperId, $class]);
my $self = $class->new($session, $shipperId);
$self->update($options);
return $self;
}
#-------------------------------------------------------------------
=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.
The optional hash key noFormProcess may be added to any field definition.
This will prevent that field from being processed by processPropertiesFromFormPost.
=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');
tie my %fields, 'Tie::IxHash';
%fields = (
label => {
fieldType => 'text',
label => $i18n->get('label'),
hoverHelp => $i18n->get('label help'),
defaultValue => undef,
},
enabled => {
fieldType => 'yesNo',
label => $i18n->get('enabled'),
hoverHelp => $i18n->get('enabled help'),
defaultValue => 1,
},
groupToUse => {
fieldType => 'group',
label => $i18n->get('who can use'),
hoverHelp => $i18n->get('who can use help'),
defaultValue => 7,
},
);
my %properties = (
name => 'Shipper Driver',
properties => \%fields,
);
push @{ $definition }, \%properties;
return $definition;
sub className {
return ref $_[0];
}
#-------------------------------------------------------------------
@ -182,65 +185,42 @@ Removes this ShipDriver object from the db.
sub delete {
my $self = shift;
$self->session->db->write('delete from shipper where shipperId=?',[$self->getId]);
$self->session->db->write('delete from shipper where shipperId=?', [$self->getId]);
return;
}
#-------------------------------------------------------------------
=head2 get ( [ $param ] )
This is an enhanced accessor for the options property. By default,
it returns all the options as a hashref. If the name of a key
in the hash is passed, it will only return that value from the
options hash.
=head3 $param
An optional parameter. If it matches the key of a hash, it will
return the value from the options hash.
=cut
sub get {
my $self = shift;
my $param = shift;
my $opts = $options{id $self};
if ($opts eq "") {
$opts = {};
}
else {
$opts = JSON::from_json($opts);
}
if (defined $param) {
return $opts->{$param};
}
my %copy = %{$opts};
return \%copy;
}
#-------------------------------------------------------------------
=head2 getEditForm ( )
Dynamically generate an HTMLForm based on the contents
of the definition sub, and return the form.
Returns the configuration form for the options of this plugin.
=cut
sub getEditForm {
my $self = shift;
my $definition = $self->definition($self->session);
my $self = shift;
my $form = WebGUI::HTMLForm->new($self->session);
$form->submit;
$form->hidden(name => 'shop',value => "ship");
$form->hidden(name => 'method',value => "do");
$form->hidden(name => 'do',value => "editSave");
$form->hidden(
name => 'driverId',
value => $self->getId,
);
$form->hidden(name => 'shop',value => "ship");
$form->hidden(name => 'method',value => "do");
$form->hidden(name => 'do',value => "editSave");
tie my %form_options, 'Tie::IxHash';
foreach my $property_name ($self->getProperties) {
my $property = $self->meta->find_attribute_by_name($property_name);
$form_options{$property_name} = {
value => $self->$property_name,
%{ $self->getFormProperties($property_name)},
};
}
my $definition = [ { properties => \%form_options }, ];
$form->dynamicForm($definition, 'properties', $self);
return $form;
}
@ -255,7 +235,7 @@ since a lot of WebGUI classes have a getId method.
sub getId {
my $self = shift;
return $shipperId{id $self};
return $self->shipperId;
}
#-------------------------------------------------------------------
@ -270,39 +250,13 @@ This is a class method.
=cut
sub getName {
my ($class, $session) = @_;
my $definition = $class->definition($session);
return $definition->[0]->{name};
}
#-------------------------------------------------------------------
=head2 new ( $session, $shipperId )
Looks up an existing ShipperDriver in the db by shipperId and returns
that object.
=cut
sub new {
my $class = shift;
my $session = shift;
my $class = shift;
my $session = shift;
WebGUI::Error::InvalidParam->throw(error => q{Must provide a session variable})
unless ref $session eq 'WebGUI::Session';
my $shipperId = shift;
WebGUI::Error::InvalidParam->throw(error => q{Must provide a shipperId})
unless defined $shipperId;
my $properties = $session->db->quickHashRef('select * from shipper where shipperId=?',[$shipperId]);
WebGUI::Error::ObjectNotFound->throw(error => q{shipperId not found in db}, id => $shipperId)
unless scalar keys %{ $properties };
my $self = register $class;
my $id = id $self;
$session{ $id } = $session;
$options{ $id } = $properties->{options};
$shipperId{ $id } = $shipperId;
return $self;
}
return WebGUI::International->new($session)->get(@{ $class->meta->pluginName });
}
#-------------------------------------------------------------------
@ -313,23 +267,19 @@ Updates ship driver with data from Form.
=cut
sub processPropertiesFromFormPost {
my $self = shift;
my $session = $self->session;
my $form = $session->form;
my %properties;
my $fullDefinition = $self->definition($session);
foreach my $definition (@{$fullDefinition}) {
PROPERTY: foreach my $property (keys %{$definition->{properties}}) {
next PROPERTY if $definition->{properties}{$property}->{noFormProcess};
$properties{$property} = $form->process(
$property,
$definition->{properties}{$property}{fieldType},
$definition->{properties}{$property}{defaultValue}
);
}
my $self = shift;
my $form = $self->session->form;
foreach my $property_name ($self->getProperties) {
my $property = $self->meta->find_attribute_by_name($property_name);
my $value = $form->process(
$property_name,
$property->form->{fieldType},
$self->$property_name,
);
$self->$property_name($value);
}
$properties{title} = $fullDefinition->[0]{name} if ($properties{title} eq "" || lc($properties{title}) eq "untitled");
$self->update(\%properties);
$self->write;
}
#-------------------------------------------------------------------
@ -342,27 +292,25 @@ Accessor for the session object. Returns the session object.
#-------------------------------------------------------------------
=head2 update ( $options )
=head2 write ( $options )
Setter for user configurable options in the ship objects. It does not support updating subsets
of the options. If a currently set option is missing from the set of passed in options, it will be lost.
=head4 $options
A list of properties to assign to this ShipperDriver. See C<definition> for details. The options are
flattened into JSON and stored in the database as text. There is no content checking performed.
Setter for user configurable options in the payment objects.
=cut
sub update {
my $self = shift;
my $options = shift || {};
WebGUI::Error::InvalidParam->throw(error => 'update was not sent a hashref of options to store in the database')
unless ref $options eq 'HASH' and scalar keys %{ $options };
my $jsonOptions = JSON::to_json($options);
$options{id $self} = $jsonOptions;
$self->session->db->write('update shipper set options=? where shipperId=?', [$jsonOptions, $self->getId]);
return undef;
sub write {
my $self = shift;
my $properties = $self->get();
delete $properties->{session};
delete $properties->{shipperId};
my $jsonOptions = to_json($properties);
$self->session->db->setRow($self->tableName, 'shipperId', {
shipperId => $self->shipperId,
className => $self->className,
options => $jsonOptions,
});
return;
}

91
lib/WebGUI/Shop/ShipDriver/FlatRate.pm
View file

@ -1,9 +1,36 @@
package WebGUI::Shop::ShipDriver::FlatRate;
use strict;
use base qw/WebGUI::Shop::ShipDriver/;
use Moose;
use WebGUI::Definition::Shop;
extends qw/WebGUI::Shop::ShipDriver/;
use WebGUI::Exception;
use Tie::IxHash;
define pluginName => ['Flat Rate','ShipDriver_FlatRate'];
property flatFee => (
fieldType => 'float',
label => ['flatFee', 'ShipDriver_FlatRate'],
hoverHelp => ['flatFee help', 'ShipDriver_FlatRate'],
default => 0,
);
property percentageOfPrice => (
fieldType => 'float',
label => ['percentageOfPrice', 'ShipDriver_FlatRate'],
hoverHelp => ['percentageOfPrice help', 'ShipDriver_FlatRate'],
default => 0,
);
property pricePerWeight => (
fieldType => 'float',
label => ['percentageOfWeight', 'ShipDriver_FlatRate'],
hoverHelp => ['percentageOfWeight help', 'ShipDriver_FlatRate'],
default => 0,
);
property pricePerItem => (
fieldType => 'float',
label => ['pricePerItem', 'ShipDriver_FlatRate'],
hoverHelp => ['pricePerItem help', 'ShipDriver_FlatRate'],
default => 0,
);
=head1 NAME
@ -52,9 +79,9 @@ sub calculate {
my $sku = $item->getSku;
if ($sku->isShippingRequired) {
my $quantity = $item->get('quantity');
$cost += ($quantity * $sku->getPrice * $self->get("percentageOfPrice") / 100) # cost by price
+ ($quantity * $sku->getWeight * $self->get("pricePerWeight") / 100) # cost by weight
+ ($quantity * $self->get("pricePerItem")); # cost by item
$cost += ($quantity * $sku->getPrice * $self->percentageOfPrice / 100) # cost by price
+ ($quantity * $sku->getWeight * $self->pricePerWeight / 100) # cost by weight
+ ($quantity * $self->pricePerItem); # cost by item
$anyShippable = 1;
##Account for items which must be shipped separately, and with those that can be shipped
##together.
@ -70,61 +97,9 @@ sub calculate {
}
}
if ($anyShippable) {
$cost += $self->get('flatFee') * ($separatelyShipped + $looseBundle);
$cost += $self->flatFee * ($separatelyShipped + $looseBundle);
}
return $cost;
}
#-------------------------------------------------------------------
=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_FlatRate');
tie my %fields, 'Tie::IxHash';
%fields = (
flatFee => {
fieldType => 'float',
label => $i18n->get('flatFee'),
hoverHelp => $i18n->get('flatFee help'),
defaultValue => 0,
},
percentageOfPrice => {
fieldType => 'float',
label => $i18n->get('percentageOfPrice'),
hoverHelp => $i18n->get('percentageOfPrice help'),
defaultValue => 0,
},
pricePerWeight => {
fieldType => 'float',
label => $i18n->get('percentageOfWeight'),
hoverHelp => $i18n->get('percentageOfWeight help'),
defaultValue => 0,
},
pricePerItem => {
fieldType => 'float',
label => $i18n->get('pricePerItem'),
hoverHelp => $i18n->get('pricePerItem help'),
defaultValue => 0,
},
);
my %properties = (
name => 'Flat Rate',
properties => \%fields,
);
push @{ $definition }, \%properties;
return $class->SUPER::definition($session, $definition);
}
1;

353
lib/WebGUI/Shop/ShipDriver/UPS.pm
View file

@ -1,17 +1,171 @@
package WebGUI::Shop::ShipDriver::UPS;
use strict;
use base qw/WebGUI::Shop::ShipDriver/;
use Moose;
use WebGUI::Definition::Shop;
extends 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;
#public testMode => my %testMode;
define pluginName => [qw/UPS ShipDriver_UPS/];
property instructions => (
fieldType => 'readOnly',
label => ['instructions', 'ShipDriver_UPS'],
builder => '_instructions_default',
lazy => 1,
noFormProcess => 1,
);
sub _instructions_default {
my $session = shift->session;
my $i18n = WebGUI::International->new($session, 'ShipDriver_UPS');
return $i18n->get('ups instructions');
}
property userId => (
fieldType => 'text',
label => ['userid', 'ShipDriver_UPS'],
hoverHelp => ['userid help', 'ShipDriver_UPS'],
default => '',
);
property password => (
fieldType => 'password',
label => ['password', 'ShipDriver_UPS'],
hoverHelp => ['password help', 'ShipDriver_UPS'],
default => '',
);
property licenseNo => (
fieldType => 'text',
label => ['license', 'ShipDriver_UPS'],
hoverHelp => ['license help', 'ShipDriver_UPS'],
default => '',
);
property sourceZip => (
fieldType => 'zipcode',
label => ['source zipcode', 'ShipDriver_UPS'],
hoverHelp => ['source zipcode help', 'ShipDriver_UPS'],
default => '',
);
property sourceCountry => (
fieldType => 'selectBox',
label => ['source country', 'ShipDriver_UPS'],
hoverHelp => ['source country help', 'ShipDriver_UPS'],
options => \&_sourceCountry_options,
default => 'US',
);
sub _sourceCountry_options {
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();
return \%localizedCountries;
}
property shipType => (
fieldType => 'selectBox',
label => ['ship type', 'ShipDriver_UPS'],
hoverHelp => ['ship type help', 'ShipDriver_UPS'],
options => \&_shipType_options,
default => 'us domestic',
extras => q{onchange="WebGUI.ShipDriver.UPS.changeServices(this.options[this.selectedIndex].value,'shipService_formId')"},
);
sub _shipType_options {
my $session = shift->session;
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');
return \%shippingTypes;
}
property shipService => (
fieldType => 'selectBox',
label => ['ship service', 'ShipDriver_UPS'],
hoverHelp => ['ship service help', 'ShipDriver_UPS'],
options => \&_shippingServices_options,
default => '03',
);
sub _shippingServices_options {
my $session = shift->session;
my $i18n = WebGUI::International->new($session, 'ShipDriver_UPS');
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');
return \%shippingServices;
}
property pickupType => (
fieldType => 'selectBox',
label => ['pickup type', 'ShipDriver_UPS'],
hoverHelp => ['pickup type help', 'ShipDriver_UPS'],
options => \&_pickupTypes_options,
default => '01',
);
sub _pickupTypes_options {
my $session = shift->session;
my $i18n = WebGUI::International->new($session, 'ShipDriver_UPS');
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');
return \%pickupTypes;
}
property customerClassification => (
fieldType => 'selectBox',
label => ['customer classification', 'ShipDriver_UPS'],
hoverHelp => ['customer classification help', 'ShipDriver_UPS'],
options => \&_customerClassification_options,
default => '01',
);
sub _customerClassification_options {
my $session = shift->session;
my $i18n = WebGUI::International->new($session, 'ShipDriver_UPS');
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');
return \%customerClassification;
}
property residentialIndicator => (
fieldType => 'radioList',
label => ['residential', 'ShipDriver_UPS'],
hoverHelp => ['residential help', 'ShipDriver_UPS'],
options => \&_residentialIndicator_options,
default => 'commercial',
);
sub _residentialIndicator_options {
my $session = shift->session;
my $i18n = WebGUI::International->new($session, 'ShipDriver_UPS');
my %residentialIndicators = (
residential => $i18n->get('residential'),
commercial => $i18n->get('commercial'),
);
return \%residentialIndicators;
}
=head1 NAME
@ -61,9 +215,9 @@ sub buildXML {
);
my $xmlAcc = $xmlHash{AccessRequest};
$xmlAcc->{'xml:lang'} = 'en-US';
$xmlAcc->{AccessLicenseNumber} = [ $self->get('licenseNo') ];
$xmlAcc->{UserId} = [ $self->get('userId') ];
$xmlAcc->{Password} = [ $self->get('password') ];
$xmlAcc->{AccessLicenseNumber} = [ $self->licenseNo ];
$xmlAcc->{UserId} = [ $self->userId ];
$xmlAcc->{Password} = [ $self->password ];
my $localizedCountry = Locales->new('en');
my $xml = XMLout(\%xmlHash,
KeepRoot => 1,
@ -87,16 +241,16 @@ sub buildXML {
# RequestOption => [ 'shop' ],
};
$xmlRate->{PickupType} = {
Code => [ $self->get('pickupType') ],
Code => [ $self->pickupType ],
};
$xmlRate->{CustomerClassification} = {
Code => [ $self->get('customerClassification') ],
Code => [ $self->customerClassification ],
};
$xmlRate->{Shipment} = {
Shipper => {
Address => [ {
PostalCode => [ $self->get('sourceZip') ],
CountryCode => [ $localizedCountry->get_code_from_territory($self->get('sourceCountry')) ],
PostalCode => [ $self->sourceZip ],
CountryCode => [ $localizedCountry->get_code_from_territory($self->sourceCountry) ],
}, ],
},
ShipTo => {
@ -106,11 +260,11 @@ sub buildXML {
} ],
},
Service => {
Code => [ $self->get('shipService') ],
Code => [ $self->shipService ],
},
Package => [],
};
if ($self->get('residentialIndicator') eq 'residential') {
if ($self->residentialIndicator eq 'residential') {
$xmlRate->{Shipment}->{ShipTo}->{Address}->[0]->{ResidentialAddressIndicator} = [''];
}
my $packHash = $xmlRate->{Shipment}->{Package};
@ -171,19 +325,19 @@ costs are assessed.
sub calculate {
my ($self, $cart) = @_;
if (! $self->get('sourceZip')) {
if (! $self->sourceZip) {
WebGUI::Error::InvalidParam->throw(error => q{Driver configured without a source zipcode.});
}
if (! $self->get('sourceCountry')) {
if (! $self->sourceCountry) {
WebGUI::Error::InvalidParam->throw(error => q{Driver configured without a source country.});
}
if (! $self->get('userId')) {
if (! $self->userId) {
WebGUI::Error::InvalidParam->throw(error => q{Driver configured without a UPS userId.});
}
if (! $self->get('password')) {
if (! $self->password) {
WebGUI::Error::InvalidParam->throw(error => q{Driver configured without a UPS password.});
}
if (! $self->get('licenseNo')) {
if (! $self->licenseNo) {
WebGUI::Error::InvalidParam->throw(error => q{Driver configured without a UPS license number.});
}
my $cost = 0;
@ -246,163 +400,6 @@ sub _calculateFromXML {
#-------------------------------------------------------------------
=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.
@ -421,13 +418,7 @@ sub _doXmlRequest {
$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 $url = 'https://wwwcie.ups.com/ups.app/xml/Rate';
my $request = HTTP::Request->new(POST => $url);
$request->content_type( 'text/xml' );
$request->content( $xml );

171
lib/WebGUI/Shop/ShipDriver/USPS.pm
View file

@ -1,7 +1,73 @@
package WebGUI::Shop::ShipDriver::USPS;
use strict;
use base qw/WebGUI::Shop::ShipDriver/;
use Moose;
use WebGUI::Definition::Shop;
extends qw/WebGUI::Shop::ShipDriver/;
define pluginName => ['United States Postal Service', 'ShipDriver_USPS'];
property instructions => (
fieldType => 'readOnly',
label => ['instructions', 'ShipDriver_USPS'],
builder => '_instructions_default',
lazy => 1,
noFormProcess => 1,
);
sub _instructions_default {
my $session = shift->session;
my $i18n = WebGUI::International->new($session, 'ShipDriver_USPS');
return $i18n->get('instructions');
}
property userId => (
fieldType => 'text',
label => ['userid', 'ShipDriver_USPS'],
hoverHelp => ['userid help', 'ShipDriver_USPS'],
default => '',
);
property password => (
fieldType => 'password',
label => ['password', 'ShipDriver_USPS'],
hoverHelp => ['password help', 'ShipDriver_USPS'],
default => '',
);
property sourceZip => (
fieldType => 'zipcode',
label => ['source zipcode', 'ShipDriver_USPS'],
hoverHelp => ['source zipcode help', 'ShipDriver_USPS'],
default => '',
);
property shipType => (
fieldType => 'selectBox',
label => ['ship type', 'ShipDriver_USPS'],
hoverHelp => ['ship type help', 'ShipDriver_USPS'],
default => 'PARCEL',
options => \&_shipType_options,
);
sub _shipType_options {
my $session = shift->session;
my $i18n = WebGUI::International->new($session, 'ShipDriver_USPS');
tie my %shippingTypes, 'Tie::IxHash';
##Note, these keys are used by buildXML
$shippingTypes{'PRIORITY VARIABLE'} = $i18n->get('priority variable');
$shippingTypes{'PRIORITY'} = $i18n->get('priority');
$shippingTypes{'EXPRESS' } = $i18n->get('express');
$shippingTypes{'PARCEL' } = $i18n->get('parcel post');
return \%shippingTypes;
}
property addInsurance => (
fieldType => 'yesNo',
label => ['add insurance', 'ShipDriver_USPS'],
hoverHelp => ['add insurance help', 'ShipDriver_USPS'],
default => 0,
);
property insuranceRates => (
fieldType => 'textarea',
label => ['insurance rates', 'ShipDriver_USPS'],
hoverHelp => ['insurance rates help', 'ShipDriver_USPS'],
default => "50:1.75\n100:2.25",
);
use WebGUI::Exception;
use XML::Simple;
use LWP;
@ -50,15 +116,15 @@ sub buildXML {
tie my %xmlHash, 'Tie::IxHash';
%xmlHash = ( RateV3Request => {}, );
my $xmlTop = $xmlHash{RateV3Request};
$xmlTop->{USERID} = $self->get('userId');
$xmlTop->{USERID} = $self->userId;
$xmlTop->{Package} = [];
##Do a request for each package.
my $packageIndex;
my $shipType = $self->get('shipType');
my $shipType = $self->shipType;
my $service = $shipType eq 'PRIORITY VARIABLE'
? 'PRIORITY'
: $shipType;
my $sourceZip = $self->get('sourceZip');
my $sourceZip = $self->sourceZip;
$sourceZip =~ s/^(\d{5}).*$/$1/;
PACKAGE: for(my $packageIndex = 0; $packageIndex < scalar @packages; $packageIndex++) {
my $package = $packages[$packageIndex];
@ -85,7 +151,7 @@ sub buildXML {
$destZipCode =~ s/^(\d{5}).*$/$1/;
$packageData{ID} = $packageIndex;
$packageData{Service} = [ $service ];
$packageData{ZipOrigination} = [ $self->get('sourceZip') ];
$packageData{ZipOrigination} = [ $self->sourceZip ];
$packageData{ZipDestination} = [ $destZipCode ];
$packageData{Pounds} = [ $pounds ];
$packageData{Ounces} = [ $ounces ];
@ -128,10 +194,10 @@ costs are assessed.
sub calculate {
my ($self, $cart) = @_;
if (! $self->get('sourceZip')) {
if (! $self->sourceZip) {
WebGUI::Error::InvalidParam->throw(error => q{Driver configured without a source zipcode.});
}
if (! $self->get('userId')) {
if (! $self->userId) {
WebGUI::Error::InvalidParam->throw(error => q{Driver configured without a USPS userId.});
}
if ($cart->getShippingAddress->get('country') ne 'United States') {
@ -146,7 +212,6 @@ sub calculate {
}
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)
@ -238,8 +303,8 @@ The set of shippable units, which are required to do quantity and cost lookups.
sub _calculateInsurance {
my ($self, @shippableUnits) = @_;
my $insuranceCost = 0;
return $insuranceCost unless $self->get('addInsurance') && $self->get('insuranceRates');
my @insuranceTable = _parseInsuranceRates($self->get('insuranceRates'));
return $insuranceCost unless $self->addInsurance && $self->insuranceRates;
my @insuranceTable = _parseInsuranceRates($self->insuranceRates);
##Sort by decreasing value for easy post processing
@insuranceTable = sort { $a->[0] <=> $b->[0] } @insuranceTable;
foreach my $package (@shippableUnits) {
@ -293,92 +358,6 @@ sub _parseInsuranceRates {
#-------------------------------------------------------------------
=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');
tie my %shippingTypes, 'Tie::IxHash';
##Note, these keys are used by buildXML
$shippingTypes{'PRIORITY VARIABLE'} = $i18n->get('priority variable');
$shippingTypes{'PRIORITY'} = $i18n->get('priority');
$shippingTypes{'EXPRESS' } = $i18n->get('express');
$shippingTypes{'PARCEL' } = $i18n->get('parcel post');
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 => '',
},
password => {
fieldType => 'password',
label => $i18n->get('password'),
hoverHelp => $i18n->get('password help'),
defaultValue => '',
},
sourceZip => {
fieldType => 'zipcode',
label => $i18n->get('source zipcode'),
hoverHelp => $i18n->get('source zipcode 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,
},
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.
# flatFee => {
# fieldType => 'float',
# label => $i18n->get('flatFee'),
# hoverHelp => $i18n->get('flatFee help'),
# defaultValue => 0,
# },
);
my %properties = (
name => 'U.S. Postal Service',
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.

136
lib/WebGUI/Shop/ShipDriver/USPSInternational.pm
View file

@ -1,12 +1,61 @@
package WebGUI::Shop::ShipDriver::USPSInternational;
use strict;
use base qw/WebGUI::Shop::ShipDriver/;
use Moose;
use WebGUI::Definition::Shop;
extends qw/WebGUI::Shop::ShipDriver/;
use WebGUI::Exception;
use XML::Simple;
use LWP;
use Tie::IxHash;
use Data::Dumper;
define pluginName => ['U.S. Postal Service, International', 'ShipDriver_USPSInternational'],
property instructions => (
fieldType => 'readOnly',
label => ['instructions', 'ShipDriver_USPS'],
builder => '_instructions_default',
lazy => 1,
noFormProcess => 1,
);
sub _instructions_default {
my $session = shift->session;
my $i18n = WebGUI::International->new($session, 'ShipDriver_USPS');
return $i18n->get('instructions');
}
property userId => (
fieldType => 'text',
label => ['userid', 'ShipDriver_USPS'],
hoverHelp => ['userid help', 'ShipDriver_USPS'],
default => '',
);
property shipType => (
fieldType => 'selectBox',
label => ['ship type', 'ShipDriver_USPS'],
hoverHelp => ['ship type help', 'ShipDriver_USPS'],
options => \&_shipType_options,
default => 'PARCEL',
);
sub _shipType_options {
my $session = shift->session;
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');
return \%shippingTypes;
}
property addInsurance => (
fieldType => 'yesNo',
label => ['add insurance', 'ShipDriver_USPS'],
hoverHelp => ['add insurance help', 'ShipDriver_USPS'],
default => 0,
);
=head1 NAME
@ -50,7 +99,7 @@ sub buildXML {
tie my %xmlHash, 'Tie::IxHash';
%xmlHash = ( IntlRateRequest => {}, );
my $xmlTop = $xmlHash{IntlRateRequest};
$xmlTop->{USERID} = $self->get('userId');
$xmlTop->{USERID} = $self->userId;
$xmlTop->{Package} = [];
##Do a request for each package.
my $packageIndex;
@ -86,7 +135,7 @@ sub buildXML {
$packageData{Ounces} = [ $ounces ];
$packageData{Machinable} = [ 'true' ];
$packageData{MailType} = [ 'Package' ];
if ($self->get('addInsurance')) {
if ($self->addInsurance) {
$packageData{ValueOfContents} = [ $value ];
}
$packageData{Country} = [ $country ];
@ -121,7 +170,7 @@ costs are assessed.
sub calculate {
my ($self, $cart) = @_;
if (! $self->get('userId')) {
if (! $self->userId) {
WebGUI::Error::InvalidParam->throw(error => q{Driver configured without a USPS userId.});
}
if ($cart->getShippingAddress->get('country') eq 'United States') {
@ -201,9 +250,9 @@ sub _calculateFromXML {
my $unit = $shippableUnits[$id];
my $rate;
SERVICE: foreach my $service (@{ $package->{Service} }) {
next SERVICE unless $service->{ID} eq $self->get('shipType');
next SERVICE unless $service->{ID} eq $self->shipType;
$rate = $service->{Postage};
if ($self->get('addInsurance')) {
if ($self->addInsurance) {
if (exists $service->{InsComment}) {
WebGUI::Error::Shop::RemoteShippingRate->throw(error => "No insurance because of: ".$service->{InsComment});
}
@ -266,79 +315,6 @@ sub correctCountry {
#-------------------------------------------------------------------
=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.

6
lib/WebGUI/i18n/English/ShipDriver.pm
View file

@ -38,6 +38,12 @@ our $I18N = {
context => q|Hover help for the group to use option.|,
},
'Shipping Driver' => {
message => q|Shipping Driver|,
lastUpdated => 0,
context => q|Name of the base Shipping Driver|,
},
};
1;

5
lib/WebGUI/i18n/English/ShipDriver_FlatRate.pm
View file

@ -48,6 +48,11 @@ our $I18N = {
lastUpdated => 1203569582,
},
'Flat Rate' => {
message => q|Flat Rate|,
lastUpdated => 1203569582,
},
};
1;

6
lib/WebGUI/i18n/English/ShipDriver_UPS.pm
View file

@ -290,6 +290,12 @@ our $I18N = {
context => q|Label for a type of shipping from the UPS.|,
},
'UPS' => {
message => q|UPS|,
lastUpdated => 1242166045,
context => q|Label for the plugin, the acronym United Parcel Service|,
},
};
1;

6
lib/WebGUI/i18n/English/ShipDriver_USPS.pm
View file

@ -118,6 +118,12 @@ our $I18N = {
context => q|Help for the insurance rate field.|,
},
'United States Postal Service' => {
message => q|United States Postal Service|,
lastUpdated => 1257369016,
context => q|Label for the shipping driver.|,
},
};
1;

4
t/Shop/Ship.t
View file

@ -124,13 +124,13 @@ cmp_deeply(
eval { $shipper = $ship->addShipper('WebGUI::Shop::ShipDriver::FlatRate', {}); };
$e = Exception::Class->caught();
isa_ok($e, 'WebGUI::Error::InvalidParam', 'addShipper croaks without options to build a object with');
isa_ok($e, 'WebGUI::Error::InvalidParam', 'addShipper croaks with empty options to build a object with');
cmp_deeply(
$e,
methods(
error => 'You must pass a hashref of options to create a new ShipDriver object',
),
'addShipper croaks without options to build a object with',
'addShipper croaks with empty options to build a object with',
);
my $driver = $ship->addShipper('WebGUI::Shop::ShipDriver::FlatRate', { enabled=>1, label=>q{Jake's Jailbird Airmail}, groupToUse=>7});

153
t/Shop/ShipDriver.t
View file

@ -21,6 +21,8 @@ use HTML::Form;
use WebGUI::Test; # Must use this before any other WebGUI modules
use WebGUI::Session;
use WebGUI::Shop::ShipDriver;
use Clone;
#----------------------------------------------------------------------------
# Init
@ -29,125 +31,41 @@ my $session = WebGUI::Test->session;
#----------------------------------------------------------------------------
# Tests
my $tests = 44;
plan tests => 1 + $tests;
plan tests => 32;
#----------------------------------------------------------------------------
# put your tests here
my $e;
my $loaded = use_ok('WebGUI::Shop::ShipDriver');
my $storage;
#######################################################################
#
# definition
#
#######################################################################
my $definition;
eval { $definition = WebGUI::Shop::ShipDriver->definition(); };
$e = Exception::Class->caught();
isa_ok($e, 'WebGUI::Error::InvalidParam', 'definition takes an exception to not giving it a session variable');
cmp_deeply(
$e,
methods(
error => 'Must provide a session variable',
),
'definition: requires a session variable',
);
$definition = WebGUI::Shop::ShipDriver->definition($session);
cmp_deeply(
$definition,
[ {
name => 'Shipper Driver',
properties => {
label => {
fieldType => 'text',
label => ignore(),
hoverHelp => ignore(),
defaultValue => undef,
},
enabled => {
fieldType => 'yesNo',
label => ignore(),
hoverHelp => ignore(),
defaultValue => 1,
},
groupToUse => {
fieldType => 'group',
label => ignore(),
hoverHelp => ignore(),
defaultValue => 7,
},
}
} ],
,
'Definition returns an array of hashrefs',
);
$definition = WebGUI::Shop::ShipDriver->definition($session, [ { name => 'Red' }]);
cmp_deeply(
$definition,
[
{
name => 'Red',
},
{
name => 'Shipper Driver',
properties => ignore(),
}
],
,
'New data is appended correctly',
);
#######################################################################
#
# create
# new
#
#######################################################################
my $driver;
eval { $driver = WebGUI::Shop::ShipDriver->create(); };
eval { $driver = WebGUI::Shop::ShipDriver->new(); };
$e = Exception::Class->caught();
isa_ok($e, 'WebGUI::Error::InvalidParam', 'create takes exception to not giving it a session object');
isa_ok($e, 'WebGUI::Error::InvalidParam', 'new takes exception to not giving it a session object');
cmp_deeply(
$e,
methods(
error => 'Must provide a session variable',
),
'create takes exception to not giving it a session object',
'new takes exception to not giving it a session object',
);
eval { $driver = WebGUI::Shop::ShipDriver->create($session); };
eval { $driver = WebGUI::Shop::ShipDriver->new($session); };
$e = Exception::Class->caught();
isa_ok($e, 'WebGUI::Error::InvalidParam', 'create takes exception to not giving it a hashref of options');
isa_ok($e, 'WebGUI::Error::InvalidParam', 'new takes exception to not giving it a hashref of options');
cmp_deeply(
$e,
methods(
error => 'Must provide a hashref of options',
error => 'Must provide a shipperId',
),
'create takes exception to not giving it a hashref of options',
);
eval { $driver = WebGUI::Shop::ShipDriver->create($session, {}); };
$e = Exception::Class->caught();
isa_ok($e, 'WebGUI::Error::InvalidParam', 'create takes exception to not giving it an empty hashref of options');
cmp_deeply(
$e,
methods(
error => 'Must provide a hashref of options',
),
'create takes exception to not giving it an empty hashref of options',
'new takes exception to not giving it a shipperId',
);
my $options = {
@ -156,7 +74,8 @@ my $options = {
groupToUse => 7,
};
$driver = WebGUI::Shop::ShipDriver->create( $session, $options );
$driver = WebGUI::Shop::ShipDriver->new( $session, Clone::clone($options) );
$driver->write;
WebGUI::Test->addToCleanup($driver);
isa_ok($driver, 'WebGUI::Shop::ShipDriver');
@ -167,8 +86,7 @@ is($session->getId, $driver->session->getId, 'session method returns OUR session
like($driver->getId, $session->id->getValidator, 'got a valid GUID for shipperId');
cmp_deeply($driver->get, $options, 'options accessor works');
cmp_deeply($driver->get, { %{$options}, shipperId=>ignore()} , 'get works');
my $dbData = $session->db->quickHashRef('select * from shipper where shipperId=?',[$driver->getId]);
cmp_deeply(
@ -187,7 +105,7 @@ cmp_deeply(
#
#######################################################################
is (WebGUI::Shop::ShipDriver->getName($session), 'Shipper Driver', 'getName returns the human readable name of this driver');
is (WebGUI::Shop::ShipDriver->getName($session), 'Shipping Driver', 'getName returns the human readable name of this driver');
#######################################################################
#
@ -238,10 +156,6 @@ cmp_deeply(
name => undef,
type => 'submit',
},
{
name => 'driverId',
type => 'hidden',
},
{
name => 'shop',
type => 'hidden',
@ -254,6 +168,10 @@ cmp_deeply(
name => 'do',
type => 'hidden',
},
{
name => 'driverId',
type => 'hidden',
},
{
name => 'label',
type => 'text',
@ -284,28 +202,6 @@ cmp_deeply(
my $oldDriver;
eval { $oldDriver = WebGUI::Shop::ShipDriver->new(); };
$e = Exception::Class->caught();
isa_ok($e, 'WebGUI::Error::InvalidParam', 'new takes exception to not giving it a session object');
cmp_deeply(
$e,
methods(
error => 'Must provide a session variable',
),
'new takes exception to not giving it a session object',
);
eval { $oldDriver = WebGUI::Shop::ShipDriver->new($session); };
$e = Exception::Class->caught();
isa_ok($e, 'WebGUI::Error::InvalidParam', 'new takes exception to not giving it a shipperId');
cmp_deeply(
$e,
methods(
error => 'Must provide a shipperId',
),
'new takes exception to not giving it a shipperId',
);
eval { $oldDriver = WebGUI::Shop::ShipDriver->new($session, 'notEverAnId'); };
$e = Exception::Class->caught();
isa_ok($e, 'WebGUI::Error::ObjectNotFound', 'new croaks unless the requested shipperId object exists in the db');
@ -339,17 +235,6 @@ like ($@, qr/^You must override the calculate method/, 'calculate croaks to forc
#
#######################################################################
eval { $driver->update(); };
$e = Exception::Class->caught();
isa_ok($e, 'WebGUI::Error::InvalidParam', 'update takes exception to not giving it a hashref of options');
cmp_deeply(
$e,
methods(
error => 'update was not sent a hashref of options to store in the database',
),
'update takes exception to not giving it a hashref of options',
);
isa_ok( $driver->get(), 'HASH', 'get returns a hashref if called with no param');
is($driver->get('groupToUse'), 7, '... default group is 7');

98
t/Shop/ShipDriver/FlatRate.t
View file

@ -29,94 +29,13 @@ my $session = WebGUI::Test->session;
#----------------------------------------------------------------------------
# Tests
my $tests = 19;
plan tests => 1 + $tests;
plan tests => 17;
#----------------------------------------------------------------------------
# put your tests here
use_ok('WebGUI::Shop::ShipDriver::FlatRate');
#######################################################################
#
# definition
#
#######################################################################
my $definition;
my $e; ##Exception variable, used throughout the file
eval { $definition = WebGUI::Shop::ShipDriver::FlatRate->definition(); };
$e = Exception::Class->caught();
isa_ok($e, 'WebGUI::Error::InvalidParam', 'definition takes an exception to not giving it a session variable');
cmp_deeply(
$e,
methods(
error => 'Must provide a session variable',
),
'definition: requires a session variable',
);
$definition = WebGUI::Shop::ShipDriver::FlatRate->definition($session);
cmp_deeply(
$definition,
[ {
name => 'Flat Rate',
properties => {
flatFee => {
fieldType => 'float',
label => ignore(),
hoverHelp => ignore(),
defaultValue => 0,
},
percentageOfPrice => {
fieldType => 'float',
label => ignore(),
hoverHelp => ignore(),
defaultValue => 0,
},
pricePerWeight => {
fieldType => 'float',
label => ignore(),
hoverHelp => ignore(),
defaultValue => 0,
},
pricePerItem => {
fieldType => 'float',
label => ignore(),
hoverHelp => ignore(),
defaultValue => 0,
},
}
},
{
name => 'Shipper Driver',
properties => {
label => {
fieldType => 'text',
label => ignore(),
hoverHelp => ignore(),
defaultValue => undef,
},
enabled => {
fieldType => 'yesNo',
label => ignore(),
hoverHelp => ignore(),
defaultValue => 1,
},
groupToUse => {
fieldType => 'group',
label => ignore(),
hoverHelp => ignore(),
defaultValue => 7,
},
}
} ],
'Definition returns an array of hashrefs',
);
#######################################################################
#
# create
@ -132,7 +51,9 @@ my $options = {
pricePerItem => 0.1,
};
my $driver2 = WebGUI::Shop::ShipDriver::FlatRate->create($session, $options);
my $driver2 = WebGUI::Shop::ShipDriver::FlatRate->new($session, $options);
$driver2->write;
WebGUI::Test->addToCleanup($driver2);
isa_ok($driver2, 'WebGUI::Shop::ShipDriver::FlatRate');
@ -183,10 +104,6 @@ cmp_deeply(
name => undef,
type => 'submit',
},
{
name => 'driverId',
type => 'hidden',
},
{
name => 'shop',
type => 'hidden',
@ -199,6 +116,10 @@ cmp_deeply(
name => 'do',
type => 'hidden',
},
{
name => 'driverId',
type => 'hidden',
},
{
name => 'label',
type => 'text',
@ -306,7 +227,7 @@ $options = {
pricePerItem => 10,
};
my $driver = WebGUI::Shop::ShipDriver::FlatRate->create($session, $options);
my $driver = WebGUI::Shop::ShipDriver::FlatRate->new($session, $options);
WebGUI::Test->addToCleanup($driver);
my $cart = WebGUI::Shop::Cart->newBySession($session);
@ -372,7 +293,6 @@ my $boughtCar = $car->addToCart($car->getCollateral('variantsJSON', 'variantId',
my $firstKey = $key->addToCart($key->getCollateral('variantsJSON', 'variantId', $metalKey));
is($driver->calculate($cart), 2, 'shipsSeparately: returns two, one for ships separately, one for ships bundled');
diag $boughtCar->getSku->getMaxAllowedInCart;
$boughtCar->adjustQuantity();
is($driver->calculate($cart), 2, '... returns two, one for ships separately, one for ships bundled, even for two items');

74
t/Shop/ShipDriver/UPS.t
View file

@ -37,7 +37,7 @@ $session->user({user => $user});
#----------------------------------------------------------------------------
# Tests
plan tests => 41;
plan tests => 38;
#----------------------------------------------------------------------------
# put your tests here
@ -112,33 +112,6 @@ foreach my $asset($rockHammer, $bible, $feather) {
$asset = $asset->cloneFromDb;
}
#######################################################################
#
# definition
#
#######################################################################
my $definition;
my $e; ##Exception variable, used throughout the file
eval { $definition = WebGUI::Shop::ShipDriver::UPS->definition(); };
$e = Exception::Class->caught();
isa_ok($e, 'WebGUI::Error::InvalidParam', 'definition takes an exception to not giving it a session variable');
cmp_deeply(
$e,
methods(
error => 'Must provide a session variable',
),
'... checking error message',
);
isa_ok(
$definition = WebGUI::Shop::ShipDriver::UPS->definition($session),
'ARRAY'
);
#######################################################################
#
# create
@ -150,7 +123,7 @@ my $options = {
enabled => 1,
};
$driver = WebGUI::Shop::ShipDriver::UPS->create($session, $options);
$driver = WebGUI::Shop::ShipDriver::UPS->new($session, $options);
isa_ok($driver, 'WebGUI::Shop::ShipDriver::UPS');
isa_ok($driver, 'WebGUI::Shop::ShipDriver');
@ -183,7 +156,9 @@ undef $driver;
#
#######################################################################
$driver = WebGUI::Shop::ShipDriver::UPS->create($session, {
my $e;
$driver = WebGUI::Shop::ShipDriver::UPS->new($session, {
label => 'Shipping from Shawshank',
enabled => 1,
shipType => 'PARCEL',
@ -201,9 +176,8 @@ cmp_deeply(
'... checking error message',
);
my $properties = $driver->get();
$properties->{sourceZip} = '97123';
$driver->update($properties);
$driver->sourceZip(97123);
$driver->sourceCountry('');
eval { $driver->calculate() };
$e = Exception::Class->caught();
isa_ok($e, 'WebGUI::Error::InvalidParam', 'calculate throws an exception when no source country');
@ -215,9 +189,7 @@ cmp_deeply(
'... checking error message',
);
$properties = $driver->get();
$properties->{sourceCountry} = 'United States';
$driver->update($properties);
$driver->sourceCountry('US');
eval { $driver->calculate() };
$e = WebGUI::Error->caught();
isa_ok($e, 'WebGUI::Error::InvalidParam', 'calculate throws an exception when no userId');
@ -229,9 +201,7 @@ cmp_deeply(
'... checking error message',
);
$properties = $driver->get();
$properties->{userId} = 'Me';
$driver->update($properties);
$driver->userId('Me');
eval { $driver->calculate() };
$e = Exception::Class->caught();
isa_ok($e, 'WebGUI::Error::InvalidParam', 'calculate throws an exception when no password');
@ -243,9 +213,7 @@ cmp_deeply(
'... checking error message',
);
$properties = $driver->get();
$properties->{password} = 'knock knock';
$driver->update($properties);
$driver->password('knock knock');
eval { $driver->calculate() };
$e = Exception::Class->caught();
isa_ok($e, 'WebGUI::Error::InvalidParam', 'calculate throws an exception when no license number');
@ -353,19 +321,17 @@ if (! $license) {
$license = "bogey";
}
$properties = $driver->get();
$properties->{userId} = $userId;
$properties->{password} = $password;
$properties->{licenseNo} = $license;
$properties->{sourceZip} = '97123';
$properties->{sourceCountry} = 'United States';
$properties->{shipService} = '03';
$properties->{pickupType} = '01';
$properties->{customerClassification} = '04';
$properties->{residentialIndicator} = 'residential';
$driver->update($properties);
$driver->userId($userId);
$driver->password($password);
$driver->licenseNo($license);
$driver->sourceZip('97123');
$driver->sourceCountry('United States');
$driver->shipService('03');
$driver->pickupType('01');
$driver->customerClassification('04');
$driver->residentialIndicator('residential');
$driver->testMode(1);
#$driver->testMode(1);
my $rockItem = $rockHammer->addToCart($rockHammer->getCollateral('variantsJSON', 'variantId', $smallHammer));
my @shippableUnits = $driver->_getShippableUnits($cart);

38
t/Shop/ShipDriver/USPS.t
View file

@ -23,7 +23,7 @@ use WebGUI::Test; # Must use this before any other WebGUI modules
use WebGUI::Session;
use WebGUI::Shop::ShipDriver::USPS;
plan tests => 69;
plan tests => 66;
#----------------------------------------------------------------------------
# Init
@ -113,34 +113,7 @@ foreach my $asset ($bible, $rockHammer) {
#######################################################################
#
# definition
#
#######################################################################
my $definition;
my $e; ##Exception variable, used throughout the file
eval { $definition = WebGUI::Shop::ShipDriver::USPS->definition(); };
$e = Exception::Class->caught();
isa_ok($e, 'WebGUI::Error::InvalidParam', 'definition takes an exception to not giving it a session variable');
cmp_deeply(
$e,
methods(
error => 'Must provide a session variable',
),
'... checking error message',
);
isa_ok(
$definition = WebGUI::Shop::ShipDriver::USPS->definition($session),
'ARRAY'
);
#######################################################################
#
# create
# new
#
#######################################################################
@ -149,7 +122,7 @@ my $options = {
enabled => 1,
};
$driver2 = WebGUI::Shop::ShipDriver::USPS->create($session, $options);
$driver2 = WebGUI::Shop::ShipDriver::USPS->new($session, $options);
addToCleanup($driver2);
isa_ok($driver2, 'WebGUI::Shop::ShipDriver::USPS');
@ -161,7 +134,7 @@ isa_ok($driver2, 'WebGUI::Shop::ShipDriver');
#
#######################################################################
is (WebGUI::Shop::ShipDriver::USPS->getName($session), 'U.S. Postal Service', 'getName returns the human readable name of this driver');
is (WebGUI::Shop::ShipDriver::USPS->getName($session), 'United States Postal Service', 'getName returns the human readable name of this driver');
#######################################################################
#
@ -183,13 +156,14 @@ undef $driver2;
#
#######################################################################
my $driver = WebGUI::Shop::ShipDriver::USPS->create($session, {
my $driver = WebGUI::Shop::ShipDriver::USPS->new($session, {
label => 'Shipping from Shawshank',
enabled => 1,
shipType => 'PARCEL',
});
addToCleanup($driver);
my $e;
eval { $driver->calculate() };
$e = Exception::Class->caught();
isa_ok($e, 'WebGUI::Error::InvalidParam', 'calculate throws an exception when no zipcode has been set');

34
t/Shop/ShipDriver/USPSInternational.t
View file

@ -23,7 +23,7 @@ use WebGUI::Test; # Must use this before any other WebGUI modules
use WebGUI::Session;
use WebGUI::Shop::ShipDriver::USPSInternational;
plan tests => 40;
plan tests => 37;
#----------------------------------------------------------------------------
# Init
@ -111,33 +111,6 @@ foreach my $asset ($rockHammer, $bible) {
$asset = $asset->cloneFromDb;
}
#######################################################################
#
# definition
#
#######################################################################
my $definition;
my $e; ##Exception variable, used throughout the file
eval { $definition = WebGUI::Shop::ShipDriver::USPSInternational->definition(); };
$e = Exception::Class->caught();
isa_ok($e, 'WebGUI::Error::InvalidParam', 'definition takes an exception to not giving it a session variable');
cmp_deeply(
$e,
methods(
error => 'Must provide a session variable',
),
'... checking error message',
);
isa_ok(
$definition = WebGUI::Shop::ShipDriver::USPSInternational->definition($session),
'ARRAY'
);
#######################################################################
#
# create
@ -149,7 +122,7 @@ my $options = {
enabled => 1,
};
$driver2 = WebGUI::Shop::ShipDriver::USPSInternational->create($session, $options);
$driver2 = WebGUI::Shop::ShipDriver::USPSInternational->new($session, $options);
addToCleanup($driver2);
isa_ok($driver2, 'WebGUI::Shop::ShipDriver::USPSInternational');
@ -183,12 +156,13 @@ undef $driver2;
#
#######################################################################
my $driver = WebGUI::Shop::ShipDriver::USPSInternational->create($session, {
my $driver = WebGUI::Shop::ShipDriver::USPSInternational->new($session, {
label => 'Shipping from Shawshank',
enabled => 1,
});
addToCleanup($driver);
my $e;
eval { $driver->calculate() };
$e = Exception::Class->caught();
isa_ok($e, 'WebGUI::Error::InvalidParam', 'calculate throws an exception when no userId');