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

Merge branch 'master' of git@github.com:plainblack/webgui

Browse source
This commit is contained in:
daviddelikat 2009-11-15 22:03:40 -06:00
commit 4278058c3c
30 changed files with 1549 additions and 58 deletions
Download patch file Download diff file Expand all files Collapse all files

13
lib/WebGUI/Asset/File/GalleryFile.pm
View file

@ -738,6 +738,19 @@ sub update {
}
#----------------------------------------------------------------------------
=head2 validParent ( )
Override validParent to only allow GalleryAlbums to hold GalleryFiles.
=cut
sub validParent {
my ($class, $session) = @_;
return $session->asset->isa('WebGUI::Asset::Wobject::GalleryAlbum');
}
#----------------------------------------------------------------------------
=head2 view ( )

10
lib/WebGUI/Asset/File/GalleryFile/Photo.pm
View file

@ -478,10 +478,12 @@ This page is only available to those who can edit this Photo.
sub www_edit {
my $self = shift;
my $session = $self->session;
my $form = $self->session->form;
my $form = $session->form;
return $self->session->privilege->insufficient unless $self->canEdit;
return $self->session->privilege->locked unless $self->canEditIfLocked;
return $session->privilege->insufficient unless $self->canEdit;
return $session->privilege->locked unless $self->canEditIfLocked;
my $i18n = WebGUI::International->new($session, 'WebGUI');
# Prepare the template variables
# Cannot get all template vars since they require a storage location, doesn't work for
@ -539,7 +541,7 @@ sub www_edit {
$var->{ form_submit }
= WebGUI::Form::submit( $session, {
name => "submit",
value => "Save",
value => $i18n->get('save'),
});
$var->{ form_title }

5
lib/WebGUI/Asset/Wobject/GalleryAlbum.pm
View file

@ -306,10 +306,7 @@ sub canEdit {
my $form = $self->session->form;
# Handle adding a photo
if ( $form->get("func") eq "add" ) {
return $self->canAddFile;
}
elsif ( $form->get("func") eq "editSave" && $form->get("className") eq __PACKAGE__ ) {
if ( $form->get("func") eq "add" || $form->get("func") eq "editSave" ) {
return $self->canAddFile;
}
else {

4
lib/WebGUI/AssetBranch.pm
View file

@ -317,6 +317,8 @@ sub www_editBranchSave {
my %data;
my $pb = WebGUI::ProgressBar->new($session);
my $i18n = WebGUI::International->new($session, 'Asset');
$pb->start($i18n->get('edit branch'), $session->url->extras('adminConsole/assets.gif'));
$pb->update($i18n->get('Processing form data'));
$data{isHidden} = $form->yesNo("isHidden") if ($form->yesNo("change_isHidden"));
$data{newWindow} = $form->yesNo("newWindow") if ($form->yesNo("change_newWindow"));
$data{encryptPage} = $form->yesNo("encryptPage") if ($form->yesNo("change_encryptPage"));
@ -353,7 +355,6 @@ sub www_editBranchSave {
$urlBase = $form->text("baseUrl");
$endOfUrl = $form->selectBox("endOfUrl");
}
$pb->start($i18n->get('edit branch'), $session->url->extras('adminConsole/assets.gif'));
my $descendants = $self->getLineage(["self","descendants"],{returnObjects=>1});
DESCENDANT: foreach my $descendant (@{$descendants}) {
if ( !$descendant->canEdit ) {
@ -401,6 +402,7 @@ sub www_editBranchSave {
}
}
}
$pb->update(sprintf $i18n->get('Attempting to commit changes'));
if (WebGUI::VersionTag->autoCommitWorkingIfEnabled($self->session, {
allowComments => 1,
returnUrl => $self->getUrl,

4
lib/WebGUI/Auth.pm
View file

@ -701,8 +701,8 @@ Returns a hash reference with the user's authentication information. This metho
=cut
sub getParams {
my $self = shift;
my $userId = $_[0] || $self->userId;
my $self = shift;
my $userId = $_[0] || $self->userId;
my $authMethod = $_[1] || $self->authMethod;
return $self->session->db->buildHashRef("select fieldName, fieldData from authentication where userId=".$self->session->db->quote($userId)." and authMethod=".$self->session->db->quote($authMethod));
}

43
lib/WebGUI/Auth/LDAP.pm
View file

@ -40,9 +40,11 @@ i.e., it does not validate their username or ensure their account is active.
=cut
sub _isValidLDAPUser {
my $self = shift;
my $self = shift;
my $session = $self->session;
my $form = $session->form;
my ($error, $ldap, $search, $auth, $connectDN);
my $i18n = WebGUI::International->new($self->session);
my $i18n = WebGUI::International->new($session);
my $connection = $self->getLDAPConnection;
return 0 unless $connection;
@ -53,8 +55,8 @@ sub _isValidLDAPUser {
$self->error('<li>'.$i18n->get(2,'AuthLDAP').'</li>');
return 0;
}
my $username = $self->session->form->get("authLDAP_ldapId") || $self->session->form->get("username");
my $password = $self->session->form->get("authLDAP_identifier") || $self->session->form->get("identifier");
my $username = $form->get("authLDAP_ldapId") || $form->get("username");
my $password = $form->get("authLDAP_identifier") || $form->get("identifier");
my $uri = URI->new($connection->{ldapUrl}) or $error = '<li>'.$i18n->get(2,'AuthLDAP').'</li>';
@ -102,27 +104,27 @@ sub _isValidLDAPUser {
# Invalid login credentials, directory did not authenticate the user
if ($auth->code == 48 || $auth->code == 49) {
$error .= '<li>'.$i18n->get(68).'</li>';
$self->session->errorHandler->warn("Invalid LDAP information for registration of LDAP ID: ".$self->session->form->process('authLDAP_ldapId'));
$session->log->warn("Invalid LDAP information for registration of LDAP ID: ".$self->session->form->process('authLDAP_ldapId'));
}
elsif ($auth->code > 0) { # Some other LDAP error occured
$error .= '<li>LDAP error "'.$self->ldapStatusCode($auth->code).'" occured. '.$i18n->get(69).'</li>';
$self->session->errorHandler->error("LDAP error: ".$self->ldapStatusCode($auth->code));
$session->log->error("LDAP error: ".$self->ldapStatusCode($auth->code));
}
$ldap->unbind;
}
else { # Could not find the user in the directory to build a DN
$error .= '<li>'.$i18n->get(68).'</li>';
$self->session->errorHandler->warn("Invalid LDAP information for registration of LDAP ID: ".$self->session->form->process("authLDAP_ldapId"));
$session->log->warn("Invalid LDAP information for registration of LDAP ID: ".$self->session->form->process("authLDAP_ldapId"));
}
}
else { # Unable to bind with proxy user credentials or anonymously for our search
$error = '<li>'.$i18n->get(2,'AuthLDAP').'</li>';
$self->session->errorHandler->error("Couldn't bind to LDAP server: ".$connection->{ldapUrl});
$session->log->error("Couldn't bind to LDAP server: ".$connection->{ldapUrl});
}
}
else { # Could not create our LDAP object
$error = '<li>'.$i18n->get(2,'AuthLDAP').'</li>';
$self->session->errorHandler->error("Couldn't create LDAP object: ".$connection->{ldapUrl});
$session->log->error("Couldn't create LDAP object: ".$connection->{ldapUrl});
}
$self->error($error);
@ -176,21 +178,32 @@ sub authenticate {
# Try to bind using the users dn and password
$auth = $ldap->bind(dn=>$userData->{connectDN}, password=>$identifier);
# Failure to bind could have resulted from change to in DN on LDAP server.
# Test for new DN and update user account as needed
if ($auth->code > 0 && $self->_isValidLDAPUser()) {
# Update user profile and log change
# _isValidLDAPUser will set _connectDN to new correct value
$auth = $ldap->bind(dn=>$self->{_connectDN}, password=>$identifier);
my $message = "DN has been changed for user ".$_[0]." from \"".$userData->{connectDN}."\" to \"".$self->{_connectDN}."\"";
$self->saveParams($self->user->userId, $self->authMethod, { connectDN => $self->{_connectDN} });
$self->session->errorHandler->warn($message);
}
# Authentication failed
if ($auth->code == 48 || $auth->code == 49){
if ($auth->code == 48 || $auth->code == 49 || $auth->code == 32){
$error .= $self->SUPER::authenticationError;
}
elsif ($auth->code > 0) { # Some other LDAP error happened
$error .= '<li>LDAP error "'.$self->ldapStatusCode($auth->code).'" occured.'.$i18n->get(69).'</li>';
$self->session->errorHandler->error("LDAP error: ".$self->ldapStatusCode($auth->code));
$self->session->log->error("LDAP error: ".$self->ldapStatusCode($auth->code));
}
$ldap->unbind;
}
else {
$error .= '<li>'.$i18n->get(13,'AuthLDAP').'</li>';
$self->session->errorHandler->error("Could not process this LDAP URL: ".$userData->{ldapUrl});
$self->session->log->error("Could not process this LDAP URL: ".$userData->{ldapUrl});
}
if($error ne ""){
@ -645,8 +658,8 @@ Process the login form. Create a new account if auto registration is enabled.
sub login {
my $self = shift;
my $i18n = WebGUI::International->new($self->session);
my $username = $self->session->form->process("username");
my $identifier = $self->session->form->process("identifier");
my $username = $self->session->form->process("username");
my $identifier = $self->session->form->process("identifier");
my $autoRegistration = $self->session->setting->get("automaticLDAPRegistration");
my $hasAuthenticated = 0;
@ -684,7 +697,7 @@ sub login {
}
return $self->SUPER::login() if $hasAuthenticated; #Standard login routine for login
$self->session->errorHandler->security("login to account ".$self->session->form->process("username")." with invalid information.");
$self->session->log->security("login to account ".$self->session->form->process("username")." with invalid information.");
return $self->displayLogin("<h1>".$i18n->get(70)."</h1>".$self->error);
}

29
lib/WebGUI/LDAPLink.pm
View file

@ -49,8 +49,9 @@ These subroutines are available from this package:
=head2 bind ( )
Authenticates against the ldap server with the parameters stored in the class, returning a valid ldap connection, or 0 if a connection
cannot be established
Authenticates against the ldap server with the parameters stored in the
class, returning a valid ldap connection, or 0 if a connection cannot
be established
=cut
@ -141,6 +142,19 @@ sub get {
#-------------------------------------------------------------------
=head2 getErrorCode ( )
Returns the numerical error code generated by the bind() method.
=cut
sub getErrorCode {
my $self = shift;
return $self->{_error};
}
#-------------------------------------------------------------------
=head2 getErrorMessage ( [ldapErrorCode] )
Returns the error string representing the error code generated by Net::LDAP. If no code is passed in, the most recent error stored by the class is returned
@ -153,7 +167,7 @@ A valid ldap error code.
sub getErrorMessage {
my $self = shift;
my $errorCode = shift || $self->{_error};
my $errorCode = shift || $self->getErrorMessage;
return "" unless $errorCode;
my $i18nCode = "LDAPLink_".$errorCode;
my $i18n = WebGUI::International->new($self->session,"AuthLDAP");
@ -242,12 +256,11 @@ The ldapLinkId of the ldapLink you're creating an object reference for.
=cut
sub new {
my ($ldapLinkId, $ldapLink);
my $class = shift;
my $session = shift;
$ldapLinkId = shift;
my $class = shift;
my $session = shift;
my $ldapLinkId = shift;
return undef unless $ldapLinkId;
$ldapLink = $session->db->quickHashRef("select * from ldapLink where ldapLinkId=?",[$ldapLinkId]);
my $ldapLink = $session->db->quickHashRef("select * from ldapLink where ldapLinkId=?",[$ldapLinkId]);
bless {_session=>$session, _ldapLinkId=>$ldapLinkId, _ldapLink=>$ldapLink }, $class;
}

20
lib/WebGUI/Operation/LDAPLink.pm
View file

@ -361,16 +361,16 @@ links. Each LDAP link is tested and the status of that test is returned.
sub www_listLDAPLinks {
my $session = shift;
return $session->privilege->adminOnly() unless canView($session);
my ($output, $p, $sth, $data, @row, $i);
my $i18n = WebGUI::International->new($session,"AuthLDAP");
my $returnUrl = "";
if ($session->form->process("returnUrl")) {
$returnUrl = ";returnUrl=".$session->url->escape($session->form->process("returnUrl"));
}
$sth = $session->db->read("select * from ldapLink order by ldapLinkName");
$row[$i] = '<tr><td valign="top" class="tableData">&nbsp;</td><td valign="top" class="tableData">'.$i18n->get("LDAPLink_1076").'</td><td>'.$i18n->get("LDAPLink_1077").'</td></tr>';
my $sth = $session->db->read("select * from ldapLink order by ldapLinkName");
my $i = 0;
my @row = ();
$i++;
while ($data = $sth->hashRef) {
while (my $data = $sth->hashRef) {
$row[$i] = '<tr><td valign="top" class="tableData">'
.$session->icon->delete('op=deleteLDAPLink;llid='.$data->{ldapLinkId},$session->url->page(),$i18n->get("LDAPLink_988"))
.$session->icon->edit('op=editLDAPLink;llid='.$data->{ldapLinkId}.$returnUrl)
@ -380,10 +380,11 @@ sub www_listLDAPLinks {
my $ldapLink = WebGUI::LDAPLink->new($session,$data->{ldapLinkId});
my $status = $i18n->get("LDAPLink_1078");
if ($ldapLink->bind) {
if ($ldapLink->bind && $ldapLink->getErrorCode == 0) {
$status = $i18n->get("LDAPLink_1079");
} else {
$session->errorHandler->warn($ldapLink->getErrorMessage());
$status .= ": ".$ldapLink->getErrorMessage();
}
$ldapLink->unbind;
$row[$i] .= '<td valign="top" class="tableData">'.$status.'</td>';
@ -391,9 +392,14 @@ sub www_listLDAPLinks {
$i++;
}
$sth->finish;
$p = WebGUI::Paginator->new($session,$session->url->page('op=listLDAPLinks'));
my $p = WebGUI::Paginator->new($session,$session->url->page('op=listLDAPLinks'));
$p->setDataByArrayRef(\@row);
$output .= '<table border="1" cellpadding="3" cellspacing="0" align="center">';
my $output = qq{<table border="1" cellpadding="3" cellspacing="0" align="center">\n};
$output .= q{<tr><td valign="top" class="tableData">&nbsp;</td><td valign="top" class="tableData">}
. $i18n->get("LDAPLink_1076")
. q{</td><td>}
. $i18n->get("LDAPLink_1077")
. qq{</td></tr>\n};
$output .= $p->getPage;
$output .= '</table>';
$output .= $p->getBarTraditional;

3
lib/WebGUI/ProgressBar.pm
View file

@ -147,7 +147,8 @@ A message to be displayed in the status bar.
sub update {
my $self = shift;
my $message = shift; ##JS string escaping?
my $message = shift;
$message =~ s/'/\\'/g; ##Encode single quotes for JSON;
$self->session->log->preventDebugOutput;
$self->{_counter} += 1;

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

@ -199,11 +199,11 @@ sub _calculateFromXML {
my $id = $package->{ID};
my $rate = $package->{Postage}->{Rate};
##Error check for invalid index
if ($id < 0 || $id > $#shippableUnits) {
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->{Description});
WebGUI::Error::Shop::RemoteShippingRate->throw(error => $package->{Error}->{Description});
}
my $unit = $shippableUnits[$id];
if ($unit->[0]->getSku->shipsSeparately) {

376
lib/WebGUI/Shop/ShipDriver/USPSInternational.pm Normal file
View file

@ -0,0 +1,376 @@
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 = $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 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');
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;

12
lib/WebGUI/i18n/English/Asset.pm
View file

@ -343,12 +343,24 @@ our $I18N = {
context => q|To skip, to move over, to not process|
},
'Processing form data' => {
message => q|Processing form data|,
lastUpdated => 1245343280,
context => q|To edit or change|
},
'editing %s' => {
message => q|editing %s|,
lastUpdated => 1245343280,
context => q|To edit or change|
},
'Attempting to commit changes' => {
message => q|Attempting to commit changes|,
lastUpdated => 1245343280,
context => q||,
},
'this asset only' => {
message => q|This&nbsp;Asset&nbsp;Only|,
lastUpdated => 0,

63
lib/WebGUI/i18n/English/ShipDriver_USPSInternational.pm Normal file
View file

@ -0,0 +1,63 @@
package WebGUI::i18n::English::ShipDriver_USPSInternational;
use strict;
our $I18N = {
'U.S. Postal Service, International' => {
message => q|U.S. Postal Service, International|,
lastUpdated => 1203569535,
context => q|Name of the shipping driver|,
},
'express mail international' => {
message => q|Express Mail International|,
lastUpdated => 1203569535,
context => q|Name of a shipping option|,
},
'priority mail international' => {
message => q|Priority Mail International|,
lastUpdated => 1203569535,
context => q|Name of a shipping option|,
},
'global express guaranteed rectangular' => {
message => q|Global Express Guaranteed Non-Document Rectangular|,
lastUpdated => 1203569535,
context => q|Name of a shipping option|,
},
'global express guaranteed non-rectangular' => {
message => q|Global Express Guaranteed Non-Document Non-Rectangular|,
lastUpdated => 1203569535,
context => q|Name of a shipping option|,
},
'priority mail flat rate box' => {
message => q|Priority Mail Flat Rate Box|,
lastUpdated => 1203569535,
context => q|Name of a shipping option|,
},
'priority mail large flat rate box' => {
message => q|Priority Mail Large Flat Rate Box|,
lastUpdated => 1203569535,
context => q|Name of a shipping option|,
},
'priority mail small flat rate box' => {
message => q|Priority Mail Small Flat Rate Box|,
lastUpdated => 1203569535,
context => q|Name of a shipping option|,
},
'first class mail international parcels' => {
message => q|First Class Mail International Parcels|,
lastUpdated => 1203569535,
context => q|Name of a shipping option|,
},
};
1;