diff --git a/docs/changelog/7.x.x.txt b/docs/changelog/7.x.x.txt index 9668abf09..3c85b8396 100644 --- a/docs/changelog/7.x.x.txt +++ b/docs/changelog/7.x.x.txt @@ -11,6 +11,12 @@ - fixed #11215: Los Angeles cannot be default timezone - fixed #11220: Map asset badly broken - fixed #11222: testEnvironment.pl Missing Dependencies + - fixed #11226: New stylesheet (wg-base.css), new style templates (from the TWG) + - fixed #11216: LDAP Connections status incorrect + - fixed #11229: ProgressBar throws errors on some messages. + - fixed #11217: LDAP authentication fails if user DN changes + - fixed #11228: Gallery image upload to other users folder permission denied + - added USPS International driver. 7.8.4 - Fixed a compatibility problem between WRE and new Spectre code. diff --git a/docs/credits.txt b/docs/credits.txt index 266cf0530..1f248664a 100644 --- a/docs/credits.txt +++ b/docs/credits.txt @@ -14,24 +14,29 @@ Contributing Developers..............Meg O'Keefe Andrea / Plain Black Leendert Bottelberghs / United Knowledge Richard Caelius / 100 World Irving Carrion + N. Hao Ching / Plain Black Richard Clark Doug Collinge Misja Op de Coul / E-Wise Flavio Curti John Dagitz / Plain Black Joeri de Bruin / Oqapi + David Delikat Michele Dell'Aquila / CSU Jeff Depons / Adaptive Dynamics Frank Dillon / Plain Black Arne Dokken Patrick Donelan / SDH Consulting + Paul Driver / Plain Black Junying Du / Brunswick Ed Van Duinen / UNC Greg Fast / Brunswick Chris Gebhardt / OpenServe Andy Grundman + Tessa Harmon / Knowmad Technologies Chris Jackson Roy Johnson / Plain Black + Bart Jol / ProcoliX Koen de Jonge / ProcoliX Martin Kamerbeek / Oqapi Yung Han Khoe @@ -47,6 +52,7 @@ Contributing Developers..............Meg O'Keefe Andrea / Plain Black Kaleb Murphy / Plain Black Chris Nehren / Plain Black Ernesto Hernández-Novich / itverx C.A. + Stephen Opal / Plain Black Tavis Parker / Plain Black Daniel Quinlan Jukka Raimovaara / Axxion Oy @@ -56,11 +62,14 @@ Contributing Developers..............Meg O'Keefe Andrea / Plain Black Tera Runde / Plain Black Steve Simms Ben Simpson + Andrew Smith / SDH Consulting Alan Smithee Steve Swanson / Plain Black Jeff Szpak / Plain Black + Henry Tang / Long Term Results B.V. Sean Tu / WDI Vladimir Vitkovsky / WebGUI Worldwide + Rogier Voogt / United Knowledge Jamie Vrbsky / Plain Black Arjan Widlak / United Knowledge Madsen Wikholm @@ -69,7 +78,7 @@ Contributing Developers..............Meg O'Keefe Andrea / Plain Black Zhou Xiaopeng / WebGUI Worldwide Gerald Young Tabitha Zipperer / Plain Black - Henry Tang / Long Term Results B.V. + Rory Zweistra / Oqapi The following are people/companies who didn't directly contribute to WebGUI, but whose work has made WebGUI possible: diff --git a/docs/gotcha.txt b/docs/gotcha.txt index c294a19a0..24271457b 100644 --- a/docs/gotcha.txt +++ b/docs/gotcha.txt @@ -15,6 +15,25 @@ save you many hours of grief. the Visitor account. Previously, based on how the user was created, they would get default values from different places. +* The following style templates have been cleaned up by the TWG: + - WebGUI 6 Blank Style, Style 01; Style 02, Style 03: + - no structural changes + - Fail safe: + - added new CSS that is more robust and validates (in external file: style.css); + - it was also necessary to update the css to work with the new navigation templates + - changed the markup and the order of the home/login/user/admin controls at the bottom + - All of the above templates: + - added a link tag to wg-base.css + - added conditional comments at the top and bottom of the body tag to be able to target + IE versions easily with css + +* Added wg-base.css, which is linked to in each style template. This stylesheet is for css that + is used in more than one tempalte, like pagination inline icons etc. Inline styles that are + removed from templates, will be replaced with styles in wg-base.css (and example is RFE 11182). + Elements that are styled in wg-base.css have a classname that starts with "wg-". + + wg-base.css replaces webgui.css, which will be removed from the site. + 7.8.4 -------------------------------------------------------------------- * A bug introduced in 7.8.1 could cause the Shop sale notification diff --git a/docs/upgrades/packages-7.8.5/css.wgpkg b/docs/upgrades/packages-7.8.5/css.wgpkg new file mode 100644 index 000000000..e2bbbbc0f Binary files /dev/null and b/docs/upgrades/packages-7.8.5/css.wgpkg differ diff --git a/docs/upgrades/packages-7.8.5/root_import_style.wgpkg b/docs/upgrades/packages-7.8.5/root_import_style.wgpkg new file mode 100644 index 000000000..7a324f859 Binary files /dev/null and b/docs/upgrades/packages-7.8.5/root_import_style.wgpkg differ diff --git a/docs/upgrades/packages-7.8.5/style_01.wgpkg b/docs/upgrades/packages-7.8.5/style_01.wgpkg new file mode 100644 index 000000000..a23322b09 Binary files /dev/null and b/docs/upgrades/packages-7.8.5/style_01.wgpkg differ diff --git a/docs/upgrades/packages-7.8.5/style_02.wgpkg b/docs/upgrades/packages-7.8.5/style_02.wgpkg new file mode 100644 index 000000000..cf0e8adb9 Binary files /dev/null and b/docs/upgrades/packages-7.8.5/style_02.wgpkg differ diff --git a/docs/upgrades/packages-7.8.5/style_03.wgpkg b/docs/upgrades/packages-7.8.5/style_03.wgpkg new file mode 100644 index 000000000..3791ffe8c Binary files /dev/null and b/docs/upgrades/packages-7.8.5/style_03.wgpkg differ diff --git a/docs/upgrades/upgrade_7.8.4-7.8.5.pl b/docs/upgrades/upgrade_7.8.4-7.8.5.pl index 04c47c2fd..d5fddd0b6 100644 --- a/docs/upgrades/upgrade_7.8.4-7.8.5.pl +++ b/docs/upgrades/upgrade_7.8.4-7.8.5.pl @@ -32,7 +32,8 @@ my $session = start(); # this line required fixPackageFlagOnOlder( $session ); addEMSSubmissionTables($session); configEMSActivities($session); - +removeOldWebGUICSS($session); +addUSPSInternationalShippingDriver( $session ); # upgrade functions go here @@ -48,6 +49,19 @@ finish($session); # this line required # print "DONE!\n" unless $quiet; #} +#---------------------------------------------------------------------------- +# Describe what our function does +sub removeOldWebGUICSS { + my $session = shift; + print "\tRemoving the old webgui.css file... " unless $quiet; + my $snippet = WebGUI::Asset->newByDynamicClass($session, 'PcRRPhh-0KfvLLNIPdxJTw'); + if ($snippet) { + $snippet->purge; + } + # and here's our code + print "DONE!\n" unless $quiet; +} + #---------------------------------------------------------------------------- # Describe what our function does sub configEMSActivities { @@ -160,6 +174,14 @@ ENDSQL } +sub addUSPSInternationalShippingDriver { + my $session = shift; + print "\tAdd the USPS International shipping driver... " unless $quiet; + # and here's our code + $session->config->addToArray('shippingDrivers', 'WebGUI::Shop::ShipDriver::USPSInternational'); + print "DONE!\n" unless $quiet; +} + sub fixPackageFlagOnOlder { my $session = shift; print "\tFixing isPackage flag on folders and isDefault on templates from 7.6.35 to 7.7.17 upgrade. If default templates have been deleted from your site, you may see warnings about not being able to find assets. You may safely ignore those warnings. This entire process may take a while.. " unless $quiet; diff --git a/etc/WebGUI.conf.original b/etc/WebGUI.conf.original index 229ea13bb..46fbddd80 100644 --- a/etc/WebGUI.conf.original +++ b/etc/WebGUI.conf.original @@ -191,6 +191,7 @@ "shippingDrivers" : [ "WebGUI::Shop::ShipDriver::FlatRate", "WebGUI::Shop::ShipDriver::USPS", + "WebGUI::Shop::ShipDriver::USPSInternational", "WebGUI::Shop::ShipDriver::UPS" ], diff --git a/lib/WebGUI/Asset/File/GalleryFile.pm b/lib/WebGUI/Asset/File/GalleryFile.pm index 210bccb25..c640dcf45 100644 --- a/lib/WebGUI/Asset/File/GalleryFile.pm +++ b/lib/WebGUI/Asset/File/GalleryFile.pm @@ -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 ( ) diff --git a/lib/WebGUI/Asset/File/GalleryFile/Photo.pm b/lib/WebGUI/Asset/File/GalleryFile/Photo.pm index d09cfb6fd..9547b4784 100644 --- a/lib/WebGUI/Asset/File/GalleryFile/Photo.pm +++ b/lib/WebGUI/Asset/File/GalleryFile/Photo.pm @@ -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 } diff --git a/lib/WebGUI/Asset/Wobject/GalleryAlbum.pm b/lib/WebGUI/Asset/Wobject/GalleryAlbum.pm index d339d2cba..79937eb06 100644 --- a/lib/WebGUI/Asset/Wobject/GalleryAlbum.pm +++ b/lib/WebGUI/Asset/Wobject/GalleryAlbum.pm @@ -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 { diff --git a/lib/WebGUI/AssetBranch.pm b/lib/WebGUI/AssetBranch.pm index 6dd5dd746..faca1854c 100644 --- a/lib/WebGUI/AssetBranch.pm +++ b/lib/WebGUI/AssetBranch.pm @@ -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, diff --git a/lib/WebGUI/Auth.pm b/lib/WebGUI/Auth.pm index 363771176..222a59083 100644 --- a/lib/WebGUI/Auth.pm +++ b/lib/WebGUI/Auth.pm @@ -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)); } diff --git a/lib/WebGUI/Auth/LDAP.pm b/lib/WebGUI/Auth/LDAP.pm index c80d5a0f9..c60d2bf84 100644 --- a/lib/WebGUI/Auth/LDAP.pm +++ b/lib/WebGUI/Auth/LDAP.pm @@ -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('
  • '.$i18n->get(2,'AuthLDAP').'
  • '); 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 = '
  • '.$i18n->get(2,'AuthLDAP').'
  • '; @@ -102,27 +104,27 @@ sub _isValidLDAPUser { # Invalid login credentials, directory did not authenticate the user if ($auth->code == 48 || $auth->code == 49) { $error .= '
  • '.$i18n->get(68).'
  • '; - $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 .= '
  • LDAP error "'.$self->ldapStatusCode($auth->code).'" occured. '.$i18n->get(69).'
  • '; - $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 .= '
  • '.$i18n->get(68).'
  • '; - $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 = '
  • '.$i18n->get(2,'AuthLDAP').'
  • '; - $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 = '
  • '.$i18n->get(2,'AuthLDAP').'
  • '; - $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 .= '
  • LDAP error "'.$self->ldapStatusCode($auth->code).'" occured.'.$i18n->get(69).'
  • '; - $self->session->errorHandler->error("LDAP error: ".$self->ldapStatusCode($auth->code)); + $self->session->log->error("LDAP error: ".$self->ldapStatusCode($auth->code)); } $ldap->unbind; } else { $error .= '
  • '.$i18n->get(13,'AuthLDAP').'
  • '; - $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("

    ".$i18n->get(70)."

    ".$self->error); } diff --git a/lib/WebGUI/LDAPLink.pm b/lib/WebGUI/LDAPLink.pm index daa358ff1..2d6008f04 100644 --- a/lib/WebGUI/LDAPLink.pm +++ b/lib/WebGUI/LDAPLink.pm @@ -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; } diff --git a/lib/WebGUI/Operation/LDAPLink.pm b/lib/WebGUI/Operation/LDAPLink.pm index d303a06d5..5d7e8690a 100644 --- a/lib/WebGUI/Operation/LDAPLink.pm +++ b/lib/WebGUI/Operation/LDAPLink.pm @@ -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] = ' '.$i18n->get("LDAPLink_1076").''.$i18n->get("LDAPLink_1077").''; + 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] = '' .$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] .= ''.$status.''; @@ -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 .= ''; + my $output = qq{
    \n}; + $output .= q{\n}; $output .= $p->getPage; $output .= '
     } + . $i18n->get("LDAPLink_1076") + . q{} + . $i18n->get("LDAPLink_1077") + . qq{
    '; $output .= $p->getBarTraditional; diff --git a/lib/WebGUI/ProgressBar.pm b/lib/WebGUI/ProgressBar.pm index 6fb9990eb..5be25932a 100644 --- a/lib/WebGUI/ProgressBar.pm +++ b/lib/WebGUI/ProgressBar.pm @@ -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; diff --git a/lib/WebGUI/Shop/ShipDriver/USPS.pm b/lib/WebGUI/Shop/ShipDriver/USPS.pm index 8ddc2bc01..d4c32b91f 100644 --- a/lib/WebGUI/Shop/ShipDriver/USPS.pm +++ b/lib/WebGUI/Shop/ShipDriver/USPS.pm @@ -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) { diff --git a/lib/WebGUI/Shop/ShipDriver/USPSInternational.pm b/lib/WebGUI/Shop/ShipDriver/USPSInternational.pm new file mode 100644 index 000000000..4d52983c3 --- /dev/null +++ b/lib/WebGUI/Shop/ShipDriver/USPSInternational.pm @@ -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; diff --git a/lib/WebGUI/i18n/English/Asset.pm b/lib/WebGUI/i18n/English/Asset.pm index 72817513f..708f23973 100644 --- a/lib/WebGUI/i18n/English/Asset.pm +++ b/lib/WebGUI/i18n/English/Asset.pm @@ -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 Asset Only|, lastUpdated => 0, diff --git a/lib/WebGUI/i18n/English/ShipDriver_USPSInternational.pm b/lib/WebGUI/i18n/English/ShipDriver_USPSInternational.pm new file mode 100644 index 000000000..b628981f4 --- /dev/null +++ b/lib/WebGUI/i18n/English/ShipDriver_USPSInternational.pm @@ -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; diff --git a/t/Asset/Wobject/GalleryAlbum/permission.t b/t/Asset/Wobject/GalleryAlbum/permission.t index 2ae6a5750..86a0dcd98 100644 --- a/t/Asset/Wobject/GalleryAlbum/permission.t +++ b/t/Asset/Wobject/GalleryAlbum/permission.t @@ -32,6 +32,7 @@ WebGUI::Test->usersToDelete($user{'2'}); my $versionTag = WebGUI::VersionTag->getWorking($session); $versionTag->set({name=>"Album Test"}); +addToCleanup($versionTag); my $gallery = $node->addChild({ className => "WebGUI::Asset::Wobject::Gallery", @@ -104,10 +105,3 @@ $maker->prepare({ fail => [ 1, ], }); $maker->run; - -#---------------------------------------------------------------------------- -# Cleanup -END { - $versionTag->rollback(); -} - diff --git a/t/Auth.t b/t/Auth.t index 281fb010a..571011797 100644 --- a/t/Auth.t +++ b/t/Auth.t @@ -33,7 +33,7 @@ my ($request, $oldRequest, $output); #---------------------------------------------------------------------------- # Tests -plan tests => 2; # Increment this number for each test you create +plan tests => 3; # Increment this number for each test you create #---------------------------------------------------------------------------- # Test createAccountSave and returnUrl together @@ -71,12 +71,14 @@ $session->{_request} = $request; $auth = WebGUI::Auth->new( $session, $AUTH_METHOD, 3 ); my $username = $session->id->generate; push @cleanupUsernames, $username; +$session->setting->set('showMessageOnLogin', 0); $output = $auth->login; is( $session->http->getRedirectLocation, 'REDIRECT_LOGIN_URL', "returnUrl field is used to set redirect after login", ); +is $output, undef, 'login returns undef when showMessageOnLogin is false'; # Session Cleanup $session->{_request} = $oldRequest; diff --git a/t/Auth/LDAP.t b/t/Auth/LDAP.t index 35971413c..24def1b75 100644 --- a/t/Auth/LDAP.t +++ b/t/Auth/LDAP.t @@ -19,6 +19,7 @@ use lib "$FindBin::Bin/../lib"; use Test::More; use WebGUI::Test; # Must use this before any other WebGUI modules use WebGUI::Session; +use Test::Deep; use Scope::Guard; #---------------------------------------------------------------------------- @@ -36,7 +37,8 @@ my $ldapProps = { ldapLinkId => sprintf( '%022s', "testlink" ), }; $session->db->setRow("ldapLink","ldapLinkId",$ldapProps, $ldapProps->{ldapLinkId}); -my $ldap = WebGUI::LDAPLink->new( $session, $ldapProps->{ldapLinkId} ); +my $ldapLink = WebGUI::LDAPLink->new( $session, $ldapProps->{ldapLinkId} ); +my $ldap = $ldapLink->bind; $session->setting->set('ldapConnection', $ldapProps->{ldapLinkId} ); # Cleanup @@ -50,7 +52,7 @@ my @cleanup = ( #---------------------------------------------------------------------------- # Tests -plan tests => 3; # Increment this number for each test you create +plan tests => 8; # Increment this number for each test you create #---------------------------------------------------------------------------- # Test Login of existing user @@ -110,5 +112,76 @@ is( $session->user->get('username'), 'Bogs Diamond', 'Bogs was created' ) or diag( $auth->error ); WebGUI::Test->addToCleanup( $session->user ); -$session->user({ userId => 1 }); # Restore Visitor +$session->setting->set('automaticLDAPRegistration', 0); +$session->user({ userId => 1 }); # Restore Visitor + +#---------------------------------------------------------------------------- +# Test DN reset from LDAP + +$session->setting->set('automaticLDAPRegistration', 1); +my $result = $ldap->add( 'cn=Brooks Hatley,ou=Convicts,o=shawshank', + attr => [ + cn => 'Brooks Hatley', + givenName => 'Brooks', + sn => 'Hatley', + ou => 'Convicts', + o => 'shawshank', + objectClass => [ qw( top inetOrgPerson ) ], + userPassword => 'BrooksHatley', + ] +); + +$session->request->setup_body({ + username => 'Brooks Hatley', + identifier => 'BrooksHatley', +}); +$auth = WebGUI::Auth::LDAP->new( $session, 'LDAP' ); +$out = $auth->login; +is $session->user->get('username'), 'Brooks Hatley', 'Brooks was created'; +cmp_deeply( + $auth->getParams, + { + connectDN => 'cn=Brooks Hatley,ou=Convicts,o=shawshank', + ldapConnection => '00000000000000testlink', + ldapUrl => 'ldaps://smoke.plainblack.com/ou=Convicts,o=shawshank', + }, + 'authentication information set after creating account' +); +WebGUI::Test->addToCleanup( $session->user, ); +$out = $auth->logout; +is $session->user->get('username'), 'Visitor', 'Brooks was logged out'; + +$ldap->moddn( 'cn=Brooks Hatley,ou=Convicts,o=shawshank', + newrdn => 'cn=Brooks Hatlen', +); + +$ldap->modify( 'cn=Brooks Hatlen,ou=Convicts,o=shawshank', + replace => { + sn => 'Hatlen', + userPassword => 'BrooksHatlen', + }, +); + +$session->request->setup_body({ + username => 'Brooks Hatley', + identifier => 'BrooksHatlen', +}); + +$auth = WebGUI::Auth::LDAP->new( $session, 'LDAP' ); +$out = $auth->login; +is $session->user->get('username'), 'Brooks Hatley', 'Brooks was logged in after name change'; +cmp_deeply( + $auth->getParams, + { + connectDN => 'cn=Brooks Hatlen,ou=Convicts,o=shawshank', + ldapConnection => '00000000000000testlink', + ldapUrl => 'ldaps://smoke.plainblack.com/ou=Convicts,o=shawshank', + }, + 'authentication information updated after name change' +); + + +$ldap->delete( 'cn=Brooks Hatlen,ou=Convicts,o=shawshank' ); +$ldap->delete( 'cn=Brooks Hatley,ou=Convicts,o=shawshank' ); + $session->setting->set('automaticLDAPRegistration', 0); diff --git a/t/LDAPLink.t b/t/LDAPLink.t new file mode 100644 index 000000000..f068a35eb --- /dev/null +++ b/t/LDAPLink.t @@ -0,0 +1,82 @@ +# vim:syntax=perl +#------------------------------------------------------------------- +# WebGUI is Copyright 2001-2009 Plain Black Corporation. +#------------------------------------------------------------------- +# Please read the legal notices (docs/legal.txt) and the license +# (docs/license.txt) that came with this distribution before using +# this software. +#------------------------------------------------------------------ +# http://www.plainblack.com info@plainblack.com +#------------------------------------------------------------------ + +# Test Auth::LDAP to make sure it works with both ldap and ldaps +# +# + +use FindBin; +use strict; +use lib "$FindBin::Bin/lib"; +use Test::More; +use Test::Deep; +use Data::Dumper; +use WebGUI::Test; # Must use this before any other WebGUI modules +use WebGUI::Session; +use WebGUI::LDAPLink; + +#---------------------------------------------------------------------------- +# Init +my $session = WebGUI::Test->session; + +#---------------------------------------------------------------------------- +# Tests + +plan tests => 8; # Increment this number for each test you create + + +########################################################################### +# +# new +# +########################################################################### + +{ + my $ldap = WebGUI::LDAPLink->new($session, "new"); + addToCleanup($ldap); + isa_ok($ldap, 'WebGUI::LDAPLink'); + is $ldap->{_ldapLinkId}, "new", '... created with correct linkId'; +} + +########################################################################### +# +# successful bind +# +########################################################################### + +{ + my $ldapProps = WebGUI::Test->getSmokeLDAPProps(); + $session->db->setRow('ldapLink', 'ldapLinkId', $ldapProps, $ldapProps->{ldapLinkId}); + my $ldap = WebGUI::LDAPLink->new($session, $ldapProps->{ldapLinkId}); + addToCleanup($ldap); + cmp_deeply $ldap->get(), superhashof($ldapProps), 'all db properties retrieved'; + my $connection = $ldap->bind(); + isa_ok $connection, 'Net::LDAP', 'returned by bind'; + is $ldap->{'_error'}, undef, 'no errors from binding' +} + +########################################################################### +# +# failed bind +# +########################################################################### + +{ + my $ldapProps = WebGUI::Test->getSmokeLDAPProps(); + $ldapProps->{identifier} = 'hadley'; + $session->db->setRow('ldapLink', 'ldapLinkId', $ldapProps, $ldapProps->{ldapLinkId}); + my $ldap = WebGUI::LDAPLink->new($session, $ldapProps->{ldapLinkId}); + addToCleanup($ldap); + my $connection = $ldap->bind(); + isa_ok $connection, 'Net::LDAP', 'returned by bind'; + is $ldap->{_error}, 104, 'auth error due to bad identifier'; + is $ldap->getErrorCode, 104, 'getErrorCode returns the stored error code'; +} diff --git a/t/Shop/Ship.t b/t/Shop/Ship.t index a75073f33..0efead294 100644 --- a/t/Shop/Ship.t +++ b/t/Shop/Ship.t @@ -93,9 +93,10 @@ cmp_bag( [ 'WebGUI::Shop::ShipDriver::FlatRate', 'WebGUI::Shop::ShipDriver::USPS', + 'WebGUI::Shop::ShipDriver::USPSInternational', 'WebGUI::Shop::ShipDriver::UPS', ], - 'getDrivers: WebGUI ships with 3 default shipping drivers', + 'getDrivers: All default shipping drivers present', ); ####################################################################### diff --git a/t/Shop/ShipDriver/USPSInternational.t b/t/Shop/ShipDriver/USPSInternational.t new file mode 100644 index 000000000..2b9d2b2a8 --- /dev/null +++ b/t/Shop/ShipDriver/USPSInternational.t @@ -0,0 +1,757 @@ +# vim:syntax=perl +#------------------------------------------------------------------- +# WebGUI is Copyright 2001-2009 Plain Black Corporation. +#------------------------------------------------------------------- +# Please read the legal notices (docs/legal.txt) and the license +# (docs/license.txt) that came with this distribution before using +# this software. +#------------------------------------------------------------------ +# http://www.plainblack.com info@plainblack.com +#------------------------------------------------------------------ + +# Write a little about what this script tests. +# +# + +use FindBin; +use strict; +use lib "$FindBin::Bin/../../lib"; +use Test::More; +use Test::Deep; +use XML::Simple; +use Data::Dumper; + +use WebGUI::Test; # Must use this before any other WebGUI modules +use WebGUI::Session; +use WebGUI::Shop::ShipDriver::USPSInternational; + +plan tests => 40; + +#---------------------------------------------------------------------------- +# Init +my $session = WebGUI::Test->session; +my $user = WebGUI::User->create($session); +WebGUI::Test->usersToDelete($user); +$session->user({user => $user}); + +#---------------------------------------------------------------------------- +# Tests + +#---------------------------------------------------------------------------- +# put your tests here + + +my ($driver2, $cart); + +my $versionTag = WebGUI::VersionTag->getWorking($session); + +my $home = WebGUI::Asset->getDefault($session); + +my $rockHammer = $home->addChild({ + className => 'WebGUI::Asset::Sku::Product', + isShippingRequired => 1, title => 'Rock Hammers', + shipsSeparately => 0, +}); + +my $smallHammer = $rockHammer->setCollateral('variantsJSON', 'variantId', 'new', + { + shortdesc => 'Small rock hammer', price => 7.50, + varSku => 'small-hammer', weight => 1.5, + quantity => 9999, + } +); + +my $bigHammer = $rockHammer->setCollateral('variantsJSON', 'variantId', 'new', + { + shortdesc => 'Big rock hammer', price => 19.99, + varSku => 'big-hammer', weight => 12, + quantity => 9999, + } +); + +my $bible = $home->addChild({ + className => 'WebGUI::Asset::Sku::Product', + isShippingRequired => 1, title => 'Bibles, individuall wrapped and shipped', + shipsSeparately => 1, +}); + +my $kjvBible = $bible->setCollateral('variantsJSON', 'variantId', 'new', + { + shortdesc => 'King James Bible', price => 17.50, + varSku => 'kjv-bible', weight => 2.5, + quantity => 99999, + } +); + +my $nivBible = $bible->setCollateral('variantsJSON', 'variantId', 'new', + { + shortdesc => 'NIV Bible', price => 22.50, + varSku => 'niv-bible', weight => 2.0, + quantity => 999999, + } +); + +my $gospels = $bible->setCollateral('variantsJSON', 'variantId', 'new', + { + shortdesc => 'Gospels from the new Testament', + price => 1.50, varSku => 'gospels', + weight => 2.0, quantity => 999999, + } +); + +my $singlePage = $bible->setCollateral('variantsJSON', 'variantId', 'new', + { + shortdesc => 'Single page from bible', + price => 0.01, varSku => 'page', + weight => 0.0001, quantity => 999999, + } +); + +$versionTag->commit; +addToCleanup($versionTag); + +####################################################################### +# +# 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 +# +####################################################################### + +my $options = { + label => 'Intl USPS Driver', + enabled => 1, + }; + +$driver2 = WebGUI::Shop::ShipDriver::USPSInternational->create($session, $options); +addToCleanup($driver2); + +isa_ok($driver2, 'WebGUI::Shop::ShipDriver::USPSInternational'); +isa_ok($driver2, 'WebGUI::Shop::ShipDriver'); + +####################################################################### +# +# getName +# +####################################################################### + +is (WebGUI::Shop::ShipDriver::USPSInternational->getName($session), 'U.S. Postal Service, International', 'getName returns the human readable name of this driver'); + +####################################################################### +# +# delete +# +####################################################################### + +my $driverId = $driver2->getId; +$driver2->delete; + +my $count = $session->db->quickScalar('select count(*) from shipper where shipperId=?',[$driverId]); +is($count, 0, 'delete deleted the object'); + +undef $driver2; + +####################################################################### +# +# calculate, and private methods. +# +####################################################################### + +my $driver = WebGUI::Shop::ShipDriver::USPSInternational->create($session, { + label => 'Shipping from Shawshank', + enabled => 1, +}); +addToCleanup($driver); + +eval { $driver->calculate() }; +$e = Exception::Class->caught(); +isa_ok($e, 'WebGUI::Error::InvalidParam', 'calculate throws an exception when no userId'); +cmp_deeply( + $e, + methods( + error => 'Driver configured without a USPS userId.', + ), + '... checking error message', +); + +$cart = WebGUI::Shop::Cart->newBySession($session); +addToCleanup($cart); +my $addressBook = $cart->getAddressBook; +my $workAddress = $addressBook->addAddress({ + label => 'work', + organization => 'ProcoliX', + address1 => 'Rotterdamseweg 183C', + city => 'Delft', code => '2629HD', + country => 'Netherlands', +}); +my $sdhAddress = $addressBook->addAddress({ + label => 'other side of planet', + organization => 'SDH', + country => 'Australia', +}); +$cart->update({shippingAddressId => $workAddress->getId}); + +cmp_deeply( + [$driver->_getShippableUnits($cart)], + [(), ], + '_getShippableUnits: empty cart' +); + +$rockHammer->addToCart($rockHammer->getCollateral('variantsJSON', 'variantId', $smallHammer)); +cmp_deeply( + [$driver->_getShippableUnits($cart)], + [[ ignore() ], ], + '_getShippableUnits: one loose item in the cart' +); + +$rockHammer->addToCart($rockHammer->getCollateral('variantsJSON', 'variantId', $bigHammer)); +cmp_deeply( + [$driver->_getShippableUnits($cart)], + [[ ignore(), ignore() ], ], + '_getShippableUnits: two loose items in the cart' +); + +$bible->addToCart($bible->getCollateral('variantsJSON', 'variantId', $kjvBible)); +cmp_bag( + [$driver->_getShippableUnits($cart)], + [[ ignore(), ignore() ], [ ignore(), ], ], + '_getShippableUnits: two loose items, and 1 ships separately item in the cart' +); + +my $bibleItem = $bible->addToCart($bible->getCollateral('variantsJSON', 'variantId', $nivBible)); +$bibleItem->setQuantity(5); +cmp_bag( + [$driver->_getShippableUnits($cart)], + [[ ignore(), ignore() ], [ ignore() ], [ ignore() ], ], + '_getShippableUnits: two loose items, and 2 ships separately item in the cart, regarless of quantity for the new item' +); + +my $rockHammer2 = $bible->addToCart($rockHammer->getCollateral('variantsJSON', 'variantId', $smallHammer)); +$rockHammer2->update({shippingAddressId => $sdhAddress->getId}); +cmp_bag( + [$driver->_getShippableUnits($cart)], + [[ ignore(), ignore() ], [ ignore() ], [ ignore() ], [ ignore() ], ], + '_getShippableUnits: two loose items, and 2 ships separately item in the cart, and another loose item sorted by zipcode' +); + +$cart->empty; +$bible->addToCart($bible->getCollateral('variantsJSON', 'variantId', $nivBible)); +cmp_deeply( + [$driver->_getShippableUnits($cart)], + [ [ ignore() ], ], + '_getShippableUnits: only 1 ships separately item in the cart' +); +$cart->empty; + +my $userId = $session->config->get('testing/USPS_userId'); +my $hasRealUserId = 1; +##If there isn't a userId, set a fake one for XML testing. +if (! $userId) { + $hasRealUserId = 0; + $userId = "blahBlahBlah"; +} +my $properties = $driver->get(); +$properties->{userId} = $userId; +$properties->{shipType} = '9'; +$driver->update($properties); + +$rockHammer->addToCart($rockHammer->getCollateral('variantsJSON', 'variantId', $smallHammer)); +my @shippableUnits = $driver->_getShippableUnits($cart); + +my $xml = $driver->buildXML($cart, @shippableUnits); +like($xml, qr/ 1, + ForceArray => ['Package'], +); +cmp_deeply( + $xmlData, + { + IntlRateRequest => { + USERID => $userId, + Package => [ + { + ID => 0, + Pounds => '1', Ounces => '8.0', + Machinable => 'true', Country => 'Netherlands', + MailType => 'Package', + }, + ], + } + }, + 'buildXML: 1 item in cart' +); + +like($xml, qr/IntlRateRequest USERID.+?Package ID=.+?Pounds.+?Ounces.+?Machinable.+?MailType.+?Country.+?/, '... and tag order'); + +SKIP: { + + skip 'No userId for testing', 2 unless $hasRealUserId; + + my $response = $driver->_doXmlRequest($xml); + ok($response->is_success, '_doXmlRequest to USPS successful'); + my $xmlData = XMLin($response->content, ForceArray => [qw/Package/],); + cmp_deeply( + $xmlData, + { + Package => [ + { + ID => 0, + AreasServed => ignore(), Prohibitions => ignore(), + ExpressMail => ignore(), CustomsForms => ignore(), + Observations => ignore(), Restrictions => ignore(), + Service => [ + { + ID => ignore(), + MaxWeight => ignore(), + MaxDimensions => ignore(), + MailType => 'Package', + Ounces => '8', + Pounds => '1', + Country => 'NETHERLANDS', + Machinable => 'true', + Postage => num(100,99), + SvcCommitments => ignore(), + SvcDescription => ignore(), + }, + (ignore())x12, + ], + }, + ], + }, + '... returned data from USPS in correct format. If this test fails, the driver may need to be updated' + ); +} + +my $cost = $driver->_calculateFromXML( + { + IntlRateResponse => { + Package => [ + { + ID => 0, + Service => [ + { + ID => '9', + Postage => '5.25', + MaxWeight => '70' + }, + { + ID => '11', + Postage => '7.25', + MaxWeight => '70' + }, + ], + }, + ], + }, + }, + @shippableUnits +); + +is($cost, 5.25, '_calculateFromXML calculates shipping cost correctly for 1 item in the cart'); + +$bibleItem = $bible->addToCart($bible->getCollateral('variantsJSON', 'variantId', $nivBible)); +@shippableUnits = $driver->_getShippableUnits($cart); + +$xml = $driver->buildXML($cart, @shippableUnits); +$xmlData = XMLin( $xml, + KeepRoot => 1, + ForceArray => ['Package'], +); + +cmp_deeply( + $xmlData, + { + IntlRateRequest => { + USERID => $userId, + Package => [ + { + ID => 0, + Pounds => '2', Ounces => '0.0', + Machinable => 'true', Country => 'Netherlands', + MailType => 'Package', + }, + { + ID => 1, + Pounds => '1', Ounces => '8.0', + Machinable => 'true', Country => 'Netherlands', + MailType => 'Package', + }, + ], + } + }, + 'Validate XML structure and content for 2 items in the cart' +); + +SKIP: { + + skip 'No userId for testing', 2 unless $hasRealUserId; + + my $response = $driver->_doXmlRequest($xml); + ok($response->is_success, '_doXmlRequest to USPS successful for 2 items in cart'); +} + +$cost = $driver->_calculateFromXML( + { + IntlRateResponse => { + Package => [ + { + ID => 0, + Service => [ + { + ID => '9', + Postage => '7.00', + MaxWeight => '70' + }, + { + ID => '11', + Postage => '9.00', + MaxWeight => '70' + }, + ], + }, + { + ID => 1, + Service => [ + { + ID => '9', + Postage => '5.25', + MaxWeight => '70' + }, + { + ID => '11', + Postage => '7.25', + MaxWeight => '70' + }, + ], + }, + ], + }, + }, + @shippableUnits +); + +is($cost, 12.25, '_calculateFromXML calculates shipping cost correctly for 2 items in the cart'); + +$bibleItem->setQuantity(2); +@shippableUnits = $driver->_getShippableUnits($cart); + +$cost = $driver->_calculateFromXML( + { + IntlRateResponse => { + Package => [ + { + ID => 0, + Service => [ + { + ID => '9', + Postage => '7.00', + MaxWeight => '70' + }, + { + ID => '11', + Postage => '9.00', + MaxWeight => '70' + }, + ], + }, + { + ID => 1, + Service => [ + { + ID => '9', + Postage => '5.25', + MaxWeight => '70' + }, + { + ID => '11', + Postage => '7.25', + MaxWeight => '70' + }, + ], + }, + ], + }, + }, + @shippableUnits +); +is($cost, 19.25, '_calculateFromXML calculates shipping cost correctly for 2 items in the cart, with quantity of 2'); + +$rockHammer2 = $rockHammer->addToCart($rockHammer->getCollateral('variantsJSON', 'variantId', $bigHammer)); +$rockHammer2->update({shippingAddressId => $sdhAddress->getId}); +@shippableUnits = $driver->_getShippableUnits($cart); +$xml = $driver->buildXML($cart, @shippableUnits); + +$xmlData = XMLin( $xml, + KeepRoot => 1, + ForceArray => ['Package'], +); + +cmp_deeply( + $xmlData, + { + IntlRateRequest => { + USERID => $userId, + Package => [ + { + ID => 0, + Pounds => '2', Ounces => '0.0', + Machinable => 'true', Country => 'Netherlands', + MailType => 'Package', + }, + { + ID => 1, + Pounds => '12', Ounces => '0.0', + Machinable => 'true', Country => 'Australia', + MailType => 'Package', + }, + { + ID => 2, + Pounds => '1', Ounces => '8.0', + Machinable => 'true', Country => 'Netherlands', + MailType => 'Package', + }, + ], + } + }, + 'Validate XML structure and content for 3 items in the cart, 3 shippable items' +); + +SKIP: { + skip 'No userId for testing', 2 unless $hasRealUserId; + + my $response = $driver->_doXmlRequest($xml); + ok($response->is_success, '_doXmlRequest to USPS successful for 3 items in cart'); +} + +####################################################################### +# +# Check for minimum weight allowed +# +####################################################################### + +$cart->empty; +$properties = $driver->get(); +$properties->{shipType} = '9'; +$properties->{addInsurance} = 0; +$driver->update($properties); +my $page1 = $bible->addToCart($bible->getCollateral('variantsJSON', 'variantId', $singlePage)); +@shippableUnits = $driver->_getShippableUnits($cart); +$xml = $driver->buildXML($cart, @shippableUnits); +$xmlData = XMLin($xml, + KeepRoot => 1, + ForceArray => ['Package'], +); +cmp_deeply( + $xmlData, + { + IntlRateRequest => { + USERID => $userId, + Package => [ + { + ID => 0, + Pounds => '0', Ounces => '0.1', + Machinable => 'true', Country => 'Netherlands', + MailType => 'Package', + }, + ], + } + }, + 'buildXML: minimum weight' +); + +####################################################################### +# +# Check too heavy for my shipping type +# +####################################################################### + +SKIP: { + + skip 'No userId for testing', 2 unless $hasRealUserId; + + $cart->empty; + $properties = $driver->get(); + $properties->{shipType} = '9'; + $driver->update($properties); + + my $heavyHammer = $rockHammer->addToCart($rockHammer->getCollateral('variantsJSON', 'variantId', $bigHammer)); + $heavyHammer->setQuantity(2); + $cost = eval { $driver->calculate($cart); }; + $e = Exception::Class->caught(); + isa_ok($e, 'WebGUI::Error::Shop::RemoteShippingRate', "USPS returns error when package is too heavy for the selected service"); + cmp_deeply( + $e, + methods( + error => 'Selected shipping service not available', + ), + '... checking error message', + ); + + $heavyHammer->setQuantity(20); + $cost = eval { $driver->calculate($cart); }; + $e = Exception::Class->caught(); + isa_ok($e, 'WebGUI::Error::Shop::RemoteShippingRate', "USPS returns error when package is too heavy for any service"); + +} + +####################################################################### +# +# Insurance +# +####################################################################### + +SKIP: { + + skip 'No userId for testing', 3 unless $hasRealUserId; + + + $cart->empty; + $properties = $driver->get(); + $properties->{shipType} = '9'; + $driver->update($properties); + $rockHammer->addToCart($rockHammer->getCollateral('variantsJSON', 'variantId', $bigHammer)); + + my $noInsuranceCost = $driver->calculate($cart); + + $properties->{addInsurance} = 1; + $driver->update($properties); + + @shippableUnits = $driver->_getShippableUnits($cart); + my $xml = $driver->buildXML($cart, @shippableUnits); + my $xmlData = XMLin($xml, + KeepRoot => 1, + ForceArray => ['Package'], + ); + + cmp_deeply( + $xmlData, + { + IntlRateRequest => { + USERID => $userId, + Package => [ + { + ID => 0, + Pounds => '12', Ounces => '0.0', + Machinable => 'true', Country => 'Netherlands', + MailType => 'Package', ValueOfContents => '19.99', + }, + ], + } + }, + 'buildXML: 1 item in cart' + ); + like($xml, qr/IntlRateRequest USERID.+?Package ID=.+?Pounds.+?Ounces.+?Machinable.+?MailType.+?ValueOfContents.+?Country.+?/, '... and tag order'); + + my $insuredCost = $driver->calculate($cart); + cmp_ok $noInsuranceCost, '<', $insuredCost, 'insured cost is higher than uninsured cost'; + + $properties->{addInsurance} = 0; + $driver->update($properties); + +} + +####################################################################### +# +# _calculateFromXML +# +####################################################################### + +$cart->empty; +$properties = $driver->get(); +$properties->{shipType} = '9'; +$properties->{addInsurance} = 1; +$driver->update($properties); +$rockHammer->addToCart($rockHammer->getCollateral('variantsJSON', 'variantId', $bigHammer)); +@shippableUnits = $driver->_getShippableUnits($cart); + +$cost = eval { $driver->_calculateFromXML( + { + IntlRateResponse => { + Package => [ + { + ID => 11, + Service => [ + { + ID => '9', + Postage => '5.25', + MaxWeight => '70' + }, + ], + }, + ], + }, + }, + @shippableUnits +); }; + +$e = Exception::Class->caught(); +isa_ok($e, 'WebGUI::Error::Shop::RemoteShippingRate', '_calculateFromXML throws an exception for illegal package ids'); +cmp_deeply( + $e, + methods( + error => 'Illegal package index returned by USPS: 11', + ), + '... checking error message', +); + +####################################################################### +# +# Check for throwing an exception +# +####################################################################### + +$userId = $driver->get('userId'); +$properties = $driver->get(); +$properties->{userId} = '_NO_NO_NO_NO'; +$driver->update($properties); + +$cost = eval { $driver->calculate($cart); }; +$e = Exception::Class->caught(); +isa_ok($e, 'WebGUI::Error::Shop::RemoteShippingRate', 'calculate throws an exception when a bad userId is used'); + +$properties->{userId} = $userId; +$driver->update($properties); + +my $dutchAddress = $addressBook->addAddress({ + label => 'american', + organization => 'Plain Black Corporation', + address1 => '1360 Regent St. #145', + city => 'Madison', state => 'WI', code => '53715', + country => 'United States', +}); + +$cart->update({shippingAddressId => $dutchAddress->getId}); +$cost = eval { $driver->calculate($cart); }; +$e = Exception::Class->caught(); +isa_ok($e, 'WebGUI::Error::InvalidParam', "calculate won't calculate for domestic countries"); + +$cart->update({shippingAddressId => $workAddress->getId}); + diff --git a/t/lib/WebGUI/Test.pm b/t/lib/WebGUI/Test.pm index 05b4e5154..afe889baa 100644 --- a/t/lib/WebGUI/Test.pm +++ b/t/lib/WebGUI/Test.pm @@ -113,6 +113,7 @@ sub import { 'Transaction Items' => 'transactionItem', 'Ship Drivers' => 'shipper', 'Database Links' => 'databaseLink', + 'LDAP Links' => 'ldapLink', ); my %initCounts; for ( my $i = 0; $i < @checkCount; $i += 2) { @@ -497,6 +498,27 @@ sub webguiBirthday { #---------------------------------------------------------------------------- +=head2 getSmokeLDAPProps ( ) + +Returns a hashref of properties for connecting to smoke's LDAP server. + +=cut + +sub getSmokeLDAPProps { + my $ldapProps = { + ldapLinkName => "Test LDAP Link", + ldapUrl => "ldaps://smoke.plainblack.com/ou=Convicts,o=shawshank", # Always test ldaps + connectDn => "cn=Samuel Norton,ou=Warden,o=shawshank", + identifier => "gooey", + ldapUserRDN => "dn", + ldapIdentity => "cn", + ldapLinkId => sprintf( '%022s', "testlink" ), + }; + return $ldapProps; +} + +#---------------------------------------------------------------------------- + =head2 prepareMailServer ( ) Prepare a Net::SMTP::Server to use for testing mail. @@ -772,6 +794,7 @@ were passed in. Currently able to destroy: WebGUI::Shop::ShipDriver WebGUI::Shop::Transaction WebGUI::DatabaseLink + WebGUI::LDAPLink Example call: @@ -865,6 +888,10 @@ Example call: $session->var->end; $session->close; }, + 'WebGUI::LDAPLink' => sub { + my $link = shift; + $link->session->db->write("delete from ldapLink where ldapLinkId=?", [$link->{ldapLinkId}]); + }, ); sub cleanupGuard {