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

Reverting 11777 due to lack of docs, upgrade script, and adding new

Browse source 
code during feature freeze.
This commit is contained in:
Colin Kuskie 2009-07-13 20:40:09 +00:00
parent 6c5885dd71
commit 0a3329d7be
7 changed files with 1052 additions and 328 deletions
Download patch file Download diff file Expand all files Collapse all files

59
docs/upgrades/upgrade_7.7.14-7.7.15.pl
View file

@ -22,6 +22,7 @@ use Getopt::Long;
use WebGUI::Session;
use WebGUI::Storage;
use WebGUI::Asset;
use List::MoreUtils qw/uniq/;
my $toVersion = '7.7.15';
@ -31,6 +32,7 @@ my $quiet; # this line required
my $session = start(); # this line required
# upgrade functions go here
replaceUsageOfOldTemplates($session);
finish($session); # this line required
@ -44,6 +46,63 @@ finish($session); # this line required
# print "DONE!\n" unless $quiet;
#}
#----------------------------------------------------------------------------
sub replaceUsageOfOldTemplates {
my $session = shift;
print "\tRemoving usage of outdated templates with new ones... " unless $quiet;
# and here's our code
print "\n\t\tUpgrading Navigation templates... " unless $quiet;
my @navigationPairs = (
## New Old
[ qw/PBnav00000000000bullet PBtmpl0000000000000048/ ] ##Bulleted List <- Vertical Menu
);
foreach my $pairs (@navigationPairs) {
my ($new, $old) = @{ $pairs };
$session->db->write('UPDATE Navigation SET templateId=? where templateId=?', [$new, $old])
}
print "\n\t\tUpgrading Article templates... " unless $quiet;
my @articlePairs = (
## New Old
[ qw/PBtmpl0000000000000103 PBtmpl0000000000000084/ ], ##Article with Image <- Center Image
[ qw/PBtmpl0000000000000123 PBtmpl0000000000000129/ ], ##Item <- Item w/pop-up Links
[ qw/PBtmpl0000000000000129 PBtmpl0000000000000207/ ], ##Default Article <- Article with Files
);
foreach my $pairs (@articlePairs) {
my ($new, $old) = @{ $pairs };
$session->db->write('UPDATE Article SET templateId=? where templateId=?', [$new, $old])
}
print "\n\t\tUpgrading Layout templates... " unless $quiet;
my @layoutPairs = (
## New Old
[ qw/PBtmpl0000000000000135 PBtmpl00000000table125/ ], ## Side By Side <- Left Column (Table)
[ qw/PBtmpl0000000000000094 PBtmpl00000000table094/ ], ## One over two <- News (Table)
[ qw/PBtmpl0000000000000131 PBtmpl00000000table131/ ], ## Right Column <- Right Column (Table)
[ qw/PBtmpl0000000000000135 PBtmpl00000000table135/ ], ## Side By Side <- Side By Side (Table)
[ qw/PBtmpl0000000000000054 PBtmpl00000000table118/ ], ## Default Page <- Three Over One (Table)
[ qw/PBtmpl0000000000000054 PBtmpl000000000table54/ ], ## Default Page <- Default Page (Table)
[ qw/PBtmpl0000000000000109 PBtmpl00000000table109/ ], ## One Over Three <- One Over Three (Table)
[ qw/PBtmpl0000000000000135 PBtmpl0000000000000125/ ], ## Side By Side <- Left Column
[ qw/PBtmpl0000000000000054 PBtmpl0000000000000118/ ], ## Default Page <- Three Over One
);
foreach my $pairs (@layoutPairs) {
my ($new, $old) = @{ $pairs };
$session->db->write('UPDATE Layout SET templateId=? where templateId=?', [$new, $old])
}
print "\n\t\tPurging old templates... " unless $quiet;
my @oldTemplates = uniq map { $_->[1] } (@navigationPairs, @articlePairs, @layoutPairs);
TEMPLATE: foreach my $templateId (@oldTemplates) {
my $template = eval { WebGUI::Asset->newPending($session, $templateId); };
if ($@) {
print "\n\t\t\tUnable to instanciate templateId: $templateId. Skipping...";
next TEMPLATE;
}
print "\n\t\t\tPurging ". $template->getTitle . " ..." unless $quiet;
$template->purge;
}
print "DONE!\n" unless $quiet;
}
# -------------- DO NOT EDIT BELOW THIS LINE --------------------------------

5
lib/WebGUI/AdminConsole.pm
View file

@ -19,6 +19,7 @@ use WebGUI::International;
use WebGUI::Asset::Template;
use WebGUI::Macro;
use WebGUI::VersionTag;
use WebGUI::HTMLForm;
=head1 NAME
@ -34,6 +35,7 @@ The admin console is a menuing system to manage webgui's administrative function
_formatFunction
addSubmenuItem
addConfirmedSubmenuItem
getAdminConsoleParams
getAdminFunction
getHelp
@ -301,6 +303,9 @@ sub render {
}
$var{"backtosite.url"} = $self->session->url->getBackToSiteURL();
$var{"formHeader"} = WebGUI::Form::formHeader($self->session)
. WebGUI::Form::hidden($self->session, { name=>'func', value=>'' });
$var{"formFooter"} = WebGUI::Form::formFooter($self->session);
my $template
= WebGUI::Asset::Template->new(
$self->session,

4
lib/WebGUI/Operation/User.pm
View file

@ -576,7 +576,7 @@ Allows an administrator to assume another user.
sub www_becomeUser {
my $session = shift;
return $session->privilege->adminOnly() unless canEdit($session) && $session->form->validToken;
return $session->privilege->adminOnly() unless canEdit($session);
return undef unless WebGUI::User->validUserId($session, $session->form->process("uid"));
$session->var->end($session->var->get("sessionId"));
$session->user({userId=>$session->form->process("uid")});
@ -595,7 +595,7 @@ after this.
sub www_deleteUser {
my $session = shift;
return $session->privilege->adminOnly() unless canEdit($session) && $session->form->validToken;
return $session->privilege->adminOnly() unless canEdit($session);
my ($u);
if ($session->form->process("uid") eq '1' || $session->form->process("uid") eq '3') {
return WebGUI::AdminConsole->new($session,"users")->render($session->privilege->vitalComponent());

566
lib/WebGUI/Shop/PayDriver/PayPal.pm
View file

@ -1,259 +1,363 @@
package WebGUI::Shop::PayDriver::PayPal;
=head1 LEGAL
-------------------------------------------------------------------
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
-------------------------------------------------------------------
=cut
## this holds some shared functionality, and MUST be overridden for a full payment driver
use strict;
use base qw/WebGUI::Shop::PayDriver/;
use warnings;
use LWP::UserAgent;
use Tie::IxHash;
use WebGUI::International;
use WebGUI::Form;
use URI::Escape;
use URI::Split;
use URI;
use Readonly;
use Data::Dumper;
=head1 NAME
Readonly my $I18N => 'PayDriver_PayPal';
WebGUI::Shop::PayDriver::PayPal
#-------------------------------------------------------------------
=head1 DESCRIPTION
=head2 apiUrl
Super class for PayPal payment drivers
Returns the URL for the PayPal API (or the sandbox, if we are configured to
use the sandbox)
=head1 METHODS
These methods are available from this class:
=cut
sub apiUrl {
my $self = shift;
return $self->get( $self->get('testMode') ? 'apiSandbox' : 'api' );
=head2 getPayPalSandboxUrl
Returns the URL for the PayPal sandbox
=cut
sub getPayPalSandboxUrl {
return ('https://www.sandbox.paypal.com/cgi-bin/webscr');
}
#-------------------------------------------------------------------
sub definition {
my ( $class, $session, $definition ) = @_;
my $i18n = WebGUI::International->new( $session, $I18N );
=head2 getPayPalUrl
tie my %fields, 'Tie::IxHash';
my @fieldNames = qw(
paypal sandbox
api apiSandbox
user password
currency testMode
signature
Returns the URL for PayPal.
=cut
sub getPayPalUrl {
return ('https://www.paypal.com/cgi-bin/webscr');
}
=head2 getPaymentCurrencies
Returns a hash reference of currency codes and their full names.
=cut
sub getPaymentCurrencies {
return {
"AUD" => "Australian Dollar",
"CAD" => "Canadian Dollar",
"CHF" => "Swiss Franc",
"CZK" => "Czech Koruna",
"DKK" => "Danish Krone",
"EUR" => "Euro",
"GBP" => "Pound Sterling",
"HKD" => "Hong Kong Dollar",
"HUF" => "Hungarian Forint",
"JPY" => "Japanese Yen",
"NOK" => "Norwegian Krone",
"NZD" => "New Zealand Dollar",
"PLN" => "Polish Zloty",
"SEK" => "Swedish Krona",
"SGD" => "Singapore Dollar",
"USD" => "U.S. Dollar"
};
}
=head2 getCardTypes
Returns a hash of credit card types
=cut
sub getCardTypes {
return (
'Visa' => 'Visa',
'MasterCard' => 'MasterCard',
'Discover' => 'Discover',
'Amex' => 'Amex'
);
foreach my $f (@fieldNames) {
$fields{$f} = {
fieldType => 'text',
label => $i18n->get($f),
hoverHelp => $i18n->get("$f help"),
};
}
$fields{currency}{defaultValue} = 'USD';
$fields{testMode}{fieldType} = 'YesNo';
$fields{sandbox}{defaultValue} = 'https://www.sandbox.paypal.com/webscr';
$fields{apiSandbox}{defaultValue} = 'https://api-3t.sandbox.payPal.com/nvp';
$fields{paypal}{defaultValue} = 'https://www.paypal.com/webscr';
$fields{api}{defaultValue} = 'https://api-3t.payPal.com/nvp';
push @{$definition}, {
name => $i18n->get('name'),
properties => \%fields,
};
return $class->SUPER::definition( $session, $definition );
} ## end sub definition
#-------------------------------------------------------------------
sub getButton {
my $self = shift;
my $session = $self->session;
my $payForm
= WebGUI::Form::formHeader($session)
. $self->getDoFormTags('sendToPayPal')
. WebGUI::Form::submit( $session, { value => $self->get('label') } )
. WebGUI::Form::formFooter($session);
return $payForm;
}
#-------------------------------------------------------------------
my %paypalCountries = (
"AFGHANISTAN" => "AF",
"ÅLAND ISLANDS" => "AX",
"ALBANIA" => "AL",
"ALGERIA" => "DZ",
"AMERICAN SAMOA" => "AS",
"ANDORRA" => "AD",
"ANGOLA" => "AO",
"ANGUILLA" => "AI",
"ANTARCTICA" => "AQ",
"ANTIGUA AND BAR­BUDA" => "AG",
"ARGENTINA" => "AR",
"ARMENIA" => "AM",
"ARUBA" => "AW",
"AUSTRALIA" => "AU",
"AUSTRIA" => "AT",
"AZERBAIJAN" => "AZ",
"BAHAMAS" => "BS",
"BAHRAIN" => "BH",
"BANGLADESH" => "BD",
"BARBADOS" => "BB",
"BELARUS" => "BY",
"BELGIUM" => "BE",
"BELIZE" => "BZ",
"BENIN" => "BJ",
"BERMUDA" => "BM",
"BHUTAN" => "BT",
"BOLIVIA" => "BO",
"BOSNIA AND HERZE­GOVINA" => "BA",
"BOTSWANA" => "BW",
"BOUVET ISLAND" => "BV",
"BRAZIL" => "BR",
"BRITISH INDIAN OCEAN TERRITORY" => "IO",
"BRUNEI DARUSSALAM" => "BN",
"BULGARIA" => "BG",
"BURKINA FASO" => "BF",
"BURUNDI" => "BI",
"CAMBODIA" => "KH",
"CAMEROON" => "CM",
"CANADA" => "CA",
"CAPE VERDE" => "CV",
"CAYMAN ISLANDS" => "KY",
"CENTRAL AFRICAN REPUBLIC" => "CF",
"CHAD" => "TD",
"CHILE" => "CL",
"CHINA" => "CN",
"CHRISTMAS ISLAND" => "CX",
"COCOS (KEELING) ISLANDS" => "CC",
"COLOMBIA" => "CO",
"COMOROS" => "KM",
"CONGO" => "CG",
"CONGO, THE DEMO­CRATIC REPUBLIC OF THE" => "CD",
"COOK ISLANDS" => "CK",
"COSTA RICA" => "CR",
"COTE D'IVOIRE" => "CI",
"CROATIA" => "HR",
"CUBA" => "CU",
"CYPRUS" => "CY",
"CZECH REPUBLIC" => "CZ",
"DENMARK" => "DK",
"DJIBOUTI" => "DJ",
"DOMINICA" => "DM",
"DOMINICAN REPUBLIC" => "DO",
"ECUADOR" => "EC",
"EGYPT" => "EG",
"EL SALVADOR" => "SV",
"EQUATORIAL GUINEA" => "GQ",
"ERITREA" => "ER",
"ESTONIA" => "EE",
"ETHIOPIA" => "ET",
"FALKLAND ISLANDS (MALVINAS)" => "FK",
"FAROE ISLANDS" => "FO",
"FIJI" => "FJ",
"FINLAND" => "FI",
"FRANCE" => "FR",
"FRENCH GUIANA" => "GF",
"FRENCH POLYNESIA" => "PF",
"FRENCH SOUTHERN TERRITORIES" => "TF",
"GABON" => "GA",
"GAMBIA" => "GM",
"GEORGIA" => "GE",
"GERMANY" => "DE",
"GHANA" => "GH",
"GIBRALTAR" => "GI",
"GREECE" => "GR",
"GREENLAND" => "GL",
"GRENADA" => "GD",
"GUADELOUPE" => "GP",
"GUAM" => "GU",
"GUATEMALA" => "GT",
"GUERNSEY" => "GG",
"GUINEA" => "GN",
"GUINEA-BISSAU" => "GW",
"GUYANA" => "GY",
"HAITI" => "HT",
"HEARD ISLAND AND MCDONALD ISLANDS" => "HM",
"HOLY SEE (VATICAN CITY STATE)" => "VA",
"HONDURAS" => "HN",
"HONG KONG" => "HK",
"HUNGARY" => "HU",
"ICELAND" => "IS",
"INDIA" => "IN",
"INDONESIA" => "ID",
"IRAN, ISLAMIC REPUB­LIC OF" => "IR",
"IRAQ" => "IQ",
"IRELAND" => "IE",
"ISLE OF MAN" => "IM",
"ISRAEL" => "IL",
"ITALY" => "IT",
"JAMAICA" => "JM",
"JAPAN" => "JP",
"JERSEY" => "JE",
"JORDAN" => "JO",
"KAZAKHSTAN" => "KZ",
"KENYA" => "KE",
"KIRIBATI" => "KI",
"KOREA, DEMOCRATIC PEOPLE'S REPUBLIC OF" => "KP",
"KOREA, REPUBLIC OF" => "KR",
"KUWAIT" => "KW",
"KYRGYZSTAN" => "KG",
"LAO PEOPLE'S DEMO­CRATIC REPUBLIC" => "LA",
"LATVIA" => "LV",
"LEBANON" => "LB",
"LESOTHO" => "LS",
"LIBERIA" => "LR",
"LIBYAN ARAB JAMA­HIRIYA" => "LY",
"LIECHTENSTEIN" => "LI",
"LITHUANIA" => "LT",
"LUXEMBOURG" => "LU",
"MACAO" => "MO",
"MACEDONIA, THE FORMER YUGOSLAV REPUBLIC OF" => "MK",
"MADAGASCAR" => "MG",
"MALAWI" => "MW",
"MALAYSIA" => "MY",
"MALDIVES" => "MV",
"MALI" => "ML",
"MALTA" => "MT",
"MARSHALL ISLANDS" => "MH",
"MARTINIQUE" => "MQ",
"MAURITANIA" => "MR",
"MAURITIUS" => "MU",
"MAYOTTE" => "YT",
"MEXICO" => "MX",
"MICRONESIA, FEDER­ATED STATES OF" => "FM",
"MOLDOVA, REPUBLIC OF" => "MD",
"MONACO" => "MC",
"MONGOLIA" => "MN",
"MONTSERRAT" => "MS",
"MOROCCO" => "MA",
"MOZAMBIQUE" => "MZ",
"MYANMAR" => "MM",
"NAMIBIA" => "NA",
"NAURU" => "NR",
"NEPAL" => "NP",
"NETHERLANDS" => "NL",
"NETHERLANDS ANTI­LLES" => "AN",
"NEW CALEDONIA" => "NC",
"NEW ZEALAND" => "NZ",
"NICARAGUA" => "NI",
"NIGER" => "NE",
"NIGERIA" => "NG",
"NIUE" => "NU",
"NORFOLK ISLAND" => "NF",
"NORTHERN MARIANA ISLANDS" => "MP",
"NORWAY" => "NO",
"OMAN" => "OM",
"PAKISTAN" => "PK",
"PALAU" => "PW",
"PALESTINIAN TERRI­TORY, OCCUPIED" => "PS",
"PANAMA" => "PA",
"PAPUA NEW GUINEA" => "PG",
"PARAGUAY" => "PY",
"PERU" => "PE",
"PHILIPPINES" => "PH",
"PITCAIRN" => "PN",
"POLAND" => "PL",
"PORTUGAL" => "PT",
"PUERTO RICO" => "PR",
"QATAR" => "QA",
"REUNION" => "RE",
"ROMANIA" => "RO",
"RUSSIAN FEDERATION" => "RU",
"RWANDA" => "RW",
"SAINT HELENA" => "SH",
"SAINT KITTS AND NEVIS" => "KN",
"SAINT LUCIA" => "LC",
"SAINT PIERRE AND MIQUELON" => "PM",
"SAINT VINCENT AND THE GRENADINES" => "VC",
"SAMOA" => "WS",
"SAN MARINO" => "SM",
"SAO TOME AND PRINC­IPE" => "ST",
"SAUDI ARABIA" => "SA",
"SENEGAL" => "SN",
"SERBIA AND MON­TENEGRO" => "CS",
"SEYCHELLES" => "SC",
"SIERRA LEONE" => "SL",
"SINGAPORE" => "SG",
"SLOVAKIA" => "SK",
"SLOVENIA" => "SI",
"SOLOMON ISLANDS" => "SB",
"SOMALIA" => "SO",
"SOUTH AFRICA" => "ZA",
"SOUTH GEORGIA AND THE SOUTH SANDWICH ISLANDS" => "GS",
"SPAIN" => "ES",
"SRI LANKA" => "LK",
"SUDAN" => "SD",
"SURINAME" => "SR",
"SVALBARD AND JAN MAYEN" => "SJ",
"SWAZILAND" => "SZ",
"SWEDEN" => "SE",
"SWITZERLAND" => "CH",
"SYRIAN ARAB REPUB­LIC" => "SY",
"TAIWAN, PROVINCE OF CHINA" => "TW",
"TAJIKISTAN" => "TJ",
"TANZANIA, UNITED REPUBLIC OF" => "TZ",
"THAILAND" => "TH",
"TIMOR-LESTE" => "TL",
"TOGO" => "TG",
"TOKELAU" => "TK",
"TONGA" => "TO",
"TRINIDAD AND TOBAGO" => "TT",
"TUNISIA" => "TN",
"TURKEY" => "TR",
"TURKMENISTAN" => "TM",
"TURKS AND CAICOS ISLANDS" => "TC",
"TUVALU" => "TV",
"UGANDA" => "UG",
"UKRAINE" => "UA",
"UNITED ARAB EMIR­ATES" => "AE",
"UNITED KINGDOM" => "GB",
"UNITED STATES" => "US",
"UNITED STATES MINOR OUTLYING ISLANDS" => "UM",
"URUGUAY" => "UY",
"UZBEKISTAN" => "UZ",
"VANUATU" => "VU",
"VENEZUELA" => "VE",
"VIET NAM" => "VN",
"VIRGIN ISLANDS, BRIT­ISH" => "VG",
"VIRGIN ISLANDS, U.S." => "VI",
"WALLIS AND FUTUNA" => "WF",
"WESTERN SAHARA" => "EH",
"YEMEN" => "YE",
"ZAMBIA" => "ZM",
"ZIMBABWE" => "ZW"
);
=head2 payPalForm ( %fields )
=head2 getPaypalCountry ( $country )
Returns a hashref representing a form (suitable for an LWP post) for talking
to the PayPal API. Fields can be either name value pairs or a hashref. If it
is a hashref, it will be modified in place.
Accepts a country name and returns the country code for it.
=head3 $country
The country to find the code for.
=cut
sub payPalForm {
my $self = shift;
my $args = ref $_[0] eq 'HASH' ? shift : {@_};
$args->{VERSION} = '58.0';
$args->{USER} = $self->get('user');
$args->{PWD} = $self->get('password');
$args->{SIGNATURE} = $self->get('signature');
sub getPaypalCountry {
my $self = shift;
my $longCountry = shift;
return $args;
my $retcode = $paypalCountries{ uc $longCountry };
return $retcode;
}
#-------------------------------------------------------------------
=head2 papPalUrl
Returns the URL for the PayPal site (or the sandbox, if we are configured to
use the sandbox)
=cut
sub payPalUrl {
my $self = shift;
return $self->get( $self->get('testMode') ? 'sandbox' : 'paypal' );
}
#-------------------------------------------------------------------
sub processPayment {
my ( $self, $transaction ) = @_;
my ( $isSuccess, $gatewayCode, $status, $message );
my $form = $self->payPalForm(
METHOD => 'DoExpressCheckoutPayment',
PAYERID => $self->session->form->process('PayerId'),
TOKEN => $self->session->form->process('token'),
AMT => $self->getCart->calculateTotal,
CURRENCYCODE => $self->get('currency'),
PAYMENTACTION => 'SALE',
);
my $response = LWP::UserAgent->new->post( $self->apiUrl, $form );
my $params = $self->responseHash($response);
if ($params) {
if ( $params->{ACK} !~ /^Success/ ) {
my $status = $params->{ACK};
my $message = '<table><tr><th>Field</th><th>Value</th></tr>';
foreach my $k ( keys %$params ) {
$message .= "<tr><td>$k</td><td>$params->{$k}</td></tr>";
}
$message .= '</table>';
return ( 0, undef, $status, $message );
}
my $status = $params->{PAYMENTSTATUS};
my $message = "Payment Status: $status";
return ( 1, $params->{TRANSACTIONID}, $status, $message );
}
return ( 0, undef, $response->status_code, $response->status_line );
} ## end sub processPayment
#-------------------------------------------------------------------
=head2 responseHash (response)
Chops up the body of a paypal response into a hashref (or undef if the request
failed)
=cut
sub responseHash {
my ( $self, $response ) = @_;
return undef unless $response->is_success;
local $_ = uri_unescape( $response->content );
return { map { split /=/ } split /[&;]/ };
}
#-------------------------------------------------------------------
=head2 www_payPalCallback
Handler that PayPal redirects to once payment has been confirmed on their end
=cut
sub www_payPalCallback {
my $self = shift;
my $transaction = $self->processTransaction;
return $transaction->get('isSuccessful')
? $transaction->thankYou
: $self->displayPaymentError($transaction);
}
#-------------------------------------------------------------------
=head2 www_sendToPayPal
Sets up payPal transaction and redirects the user off to payPal land
=cut
sub www_sendToPayPal {
my $self = shift;
my $session = $self->session;
my $url = $session->url;
my $base = $url->getSiteURL . $url->page;
my $returnUrl = URI->new($base);
$returnUrl->query_form( {
shop => 'pay',
method => 'do',
do => 'payPalCallback',
paymentGatewayId => $self->getId,
}
);
my $cancelUrl = URI->new($base);
$cancelUrl->query_form( { shop => 'cart' } );
my $form = $self->payPalForm(
METHOD => 'SetExpressCheckout',
AMT => $self->getCart->calculateTotal,
CURRENCYCODE => $self->get('currency'),
RETURNURL => $returnUrl->as_string,
CANCELURL => $cancelUrl->as_string,
PAYMENTACTION => 'SALE',
);
my $testMode = $self->get('testMode');
my $response = LWP::UserAgent->new->post( $self->apiUrl, $form );
my $params = $self->responseHash($response);
my $i18n = WebGUI::International->new( $self->session, $I18N );
my $error;
if ($params) {
unless ( $params->{ACK} =~ /^Success/ ) {
my $log = sprintf "Paypal error: Request/response below: %s\n%s\n", Dumper($form), Dumper($params);
$session->log->error($log);
$error = 'Internal Paypal Error';
}
}
else {
$error = $response->status_line;
}
if ($error) {
my $message = sprintf $i18n->get('api error'), $error;
return $session->style->userStyle($message);
}
my $dest = URI->new( $self->payPalUrl );
$dest->query_form( {
cmd => '_express-checkout',
token => $params->{TOKEN},
}
);
return $session->http->setRedirect($dest);
} ## end sub www_sendToPayPal
1;

475
lib/WebGUI/Shop/PayDriver/PayPal/PayPalStd.pm Normal file
View file

@ -0,0 +1,475 @@
package WebGUI::Shop::PayDriver::PayPal::PayPalStd;
=head1 LEGAL
-------------------------------------------------------------------
PayPal Standard payment driver for WebGUI.
Copyright (C) 2009 Invicta Services, LLC.
-------------------------------------------------------------------
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License along
with this program; if not, write to the Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
-------------------------------------------------------------------
=cut
use strict;
use LWP::UserAgent;
use Crypt::SSLeay;
use base qw/WebGUI::Shop::PayDriver::PayPal/;
=head1 NAME
PayPal Website payments standard
=head1 DESCRIPTION
A PayPal Website payments standard handler for WebGUI. Provides an interface to PayPal with cart contents
and transaction information on return.
=head1 SYNOPSIS
Add "WebGUI::Shop::PayDriver::PayPal::PayPalStd" to the paymentDrivers list in your WebGUI site config file.
Re-start the WebGUI modperl and modproxy web servers.
=cut
#-------------------------------------------------------------------
# local subs
#-------------------------------------------------------------------
=head2 handlesRecurring
Tells the commerce system that this payment plugin can handle recurring payments.
1 = yes, 0 = no. This module == no.
=cut
sub handlesRecurring {
return 0;
}
#-------------------------------------------------------------------
=head2 canCheckoutCart ( )
Returns whether the cart can be checked out by this plugin.
=cut
sub canCheckoutCart {
my $self = shift;
my $cart = $self->getCart;
return 0 unless $cart->readyForCheckout;
return 0 if $cart->requiresRecurringPayment;
return 1;
}
#-------------------------------------------------------------------
# Recurring TX stuff removed, for now.
#-------------------------------------------------------------------
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, 'PayDriver_PayPalStd' );
tie my %fields, 'Tie::IxHash';
%fields = (
vendorId => {
fieldType => 'text',
label => $i18n->get('vendorId'),
hoverHelp => $i18n->get('vendorId help'),
},
signature => {
fieldType => 'textarea',
label => $i18n->get('signature'),
hoverHelp => $i18n->get('signature help'),
},
currency => {
fieldType => 'selectBox',
label => $i18n->get('currency'),
hoverHelp => $i18n->get('currency help'),
defaultValue => 'USD',
options => $class->getPaymentCurrencies(),
},
useSandbox => {
fieldType => 'yesNo',
label => $i18n->get('use sandbox'),
hoverHelp => $i18n->get('use sandbox help'),
defaultValue => 1,
},
buttonImage => {
fieldType => 'text',
label => $i18n->get('button image'),
hoverHelp => $i18n->get('button image help'),
defaultValue => '',
},
emailMessage => {
fieldType => 'textarea',
label => $i18n->get('emailMessage'),
hoverHelp => $i18n->get('emailMessage help'),
},
);
push @{$definition},
{
name => $i18n->get('PayPal'),
properties => \%fields,
};
return $class->SUPER::definition( $session, $definition );
}
#-------------------------------------------------------------------
=head2 getButton
Extends the base class to add a user configurable button image.
=cut
sub getButton {
my $self = shift;
my $session = $self->session;
my $i18n = WebGUI::International->new( $session, 'PayDriver_PayPalStd' );
my $payForm = WebGUI::Form::formHeader($session) . $self->getDoFormTags('pay');
if ( $self->get('buttonImage') ) {
my $button = $self->get('buttonImage');
WebGUI::Macro::process( $session, \$button );
$payForm
.= '<input type="image" src="'
. $button
. '" border="0" name="submit" alt="'
. $i18n->get('PayPal') . '"> ';
}
else {
$payForm .= WebGUI::Form::submit( $session, { value => $i18n->get('PayPal') } );
}
$payForm .= WebGUI::Form::formFooter($session);
return $payForm;
}
#-------------------------------------------------------------------
=head2 processTransaction ( [ paymentAddress ] )
This method is responsible for handling success or failure from the payment processor, completing or denying the transaction, and sending out notification and receipt emails. Returns a WebGUI::Shop::Transaction object.
This method is overridden from the parent class to allow asynchronous completion / denial of PayPal payments.
=head3 paymentAddress
A reference to a WebGUI::Shop::Address object that should be attached as payment information. Not required.
=cut
sub processTransaction {
my ( $self, $paymentAddress ) = @_;
my $cart = $self->getCart;
# Setup tranasction properties
my $transactionProperties;
$transactionProperties->{paymentMethod} = $self;
$transactionProperties->{cart} = $cart;
$transactionProperties->{paymentAddress} = $paymentAddress if defined $paymentAddress;
$transactionProperties->{isRecurring} = $cart->requiresRecurringPayment;
# Create a transaction...
my $transaction = WebGUI::Shop::Transaction->create( $self->session, $transactionProperties );
# And handle the payment for it
my $session = $self->session;
my $config = $session->config;
my $f = WebGUI::HTMLForm->new(
$session,
action => ( $self->get('useSandbox') ? $self->getPayPalSandboxUrl() : $self->getPayPalUrl() ),
extras => 'name="paypal_form"'
);
$f->hidden( name => 'business', value => $self->get('vendorId') );
$f->hidden( name => 'cmd', value => '_cart' );
$f->hidden( name => 'site_url', value => $session->setting->get("companyURL") );
$f->hidden( name => 'image_url', value => '' );
$f->hidden(
name => 'return',
value =>
$session->url->page( "shop=pay;method=do;do=completeTransaction;paymentGatewayId=" . $self->getId, 1 )
); ## PayPal says OK for now
$f->hidden(
name => 'cancel_return',
value =>
$session->url->page( "shop=pay;method=do;do=cancelTransaction;paymentGatewayId=" . $self->getId, 1 )
); ## Error / user cancel
# $f->hidden(name=>'notify_url', value=>$session->url->page("shop=pay;method=do;do=IPNnotifyTransaction;paymentGatewayId=".$self->getId, 1));
$f->hidden( name => 'notify_url', value => '' ); ##no IPN for now, get OK from PDT auto-return
$f->hidden( name => 'rm', value => '2' ); ## use POST
$f->hidden( name => 'currency_code', value => $self->get('currency') );
$f->hidden( name => 'lc', value => 'US' );
$f->hidden( name => 'bn', value => 'toolkit-perl' );
$f->hidden( name => 'cbt', value => 'Continue >>' );
# <!-- Payment Page Information -->
$f->hidden( name => 'no_shipping', value => '1' ); # do not display shipping addr
$f->hidden( name => 'no_note', value => '0' );
$f->hidden( name => 'cn', value => 'Comments' );
$f->hidden( name => 'cs', value => '' );
# <!-- Cart Information -->
# does not get used for uploaded carts
$f->hidden( name => 'item_name', value => 'WebGUI cart' );
$f->hidden(
name => 'amount',
value => $transaction->get('amount') - $transaction->get('taxes') - $transaction->get('shippingPrice')
);
# <!-- Product Information for each item in our cart -->
$f->hidden( name => 'upload', value => '1' );
my $itemList = $transaction->getItems;
my $itemNum = 0;
foreach my $item ( @{$itemList} ) {
# items numbered 1++
$itemNum++;
# glue item number to WebGUI itemId
$f->hidden( name => 'item_number_' . $itemNum, value => $item->get('itemId') );
$f->hidden( name => 'item_name_' . $itemNum, value => $item->get('configuredTitle') );
$f->hidden( name => 'quantity_' . $itemNum, value => $item->get('quantity') );
$f->hidden( name => 'amount_' . $itemNum, value => $item->get('price') );
}
# <!-- Shipping and Misc Information -->
$f->hidden( name => 'shipping', value => $transaction->get('shippingPrice') );
$f->hidden( name => 'shipping2', value => '' ); # no individual shipping
$f->hidden( name => 'handling_cart', value => '0.00' ); # no separate handling
$f->hidden( name => 'tax_cart', value => $transaction->get('taxes') ); # no separate taxes
$f->hidden( name => 'custom', value => '' );
$f->hidden( name => 'invoice', value => $transaction->getId )
; # need to identify OUR TX so we can update it later
# <!-- Customer Information -->
$f->hidden( name => 'address_override', value => 1 );
$f->hidden(
name => 'first_name',
value => substr(
$transaction->get('shippingAddressName'), 0,
rindex( $transaction->get('shippingAddressName'), ' ' )
)
);
$f->hidden(
name => 'last_name',
value => substr(
$transaction->get('shippingAddressName'),
rindex( $transaction->get('shippingAddressName'), ' ' ) + 1
)
);
$f->hidden( name => 'address1', value => $transaction->get('shippingAddress1') );
$f->hidden( name => 'address2', value => $transaction->get('shippingAddress2') );
$f->hidden( name => 'city', value => $transaction->get('shippingCity') );
$f->hidden( name => 'state', value => $transaction->get('shippingState') );
$f->hidden( name => 'zip', value => $transaction->get('shippingCode') );
$f->hidden( name => 'country', value => $self->getPaypalCountry( $transaction->get('shippingCountry') ) );
if ( $session->user->profileField('email') ) {
$f->hidden( name => 'email', value => $session->user->profileField('email') );
}
$f->hidden( name => 'night_phone_a', value => $transaction->get('shippingPhoneNumber') );
$f->hidden( name => 'night_phone_b', value => '' );
$f->hidden( name => 'night_phone_c', value => '' );
return
$f->print
. '<center><font face="Verdana, Arial, Helvetica, sans-serif" size="2">Processing Transaction . . . </font></center>'
. '<script>document.paypal_form.submit();</script>';
}
#-------------------------------------------------------------------
=head2 www_cancelTransaction
Cancels the transaction defined by the C<invoice> form variable.
=cut
sub www_cancelTransaction {
my $self = shift;
my $session = $self->session;
my %pdt;
my $retstr = '';
foreach my $input_name ( $self->session->request->param ) {
$pdt{$input_name} = $self->session->request->param($input_name);
$retstr .= $input_name . ":" . $self->session->request->param($input_name) . "<br />";
}
my $transaction = eval { WebGUI::Shop::Transaction->newByGatewayId( $session, $pdt{invoice}, $self->getId ) };
# First check whether the original transaction actualy exists
if ( WebGUI::Error->caught || !( defined $transaction ) ) {
$session->errorHandler->warn("PayPal Standard: No transaction ID: $pdt{invoice}");
return;
}
$transaction->denyPurchase( $pdt{invoice}, 0, $pdt{payment_status} );
return $self->displayPaymentError($transaction);
}
#-------------------------------------------------------------------
=head2 www_completeTransaction
Finishes the transaction for this driver.
=cut
sub www_completeTransaction {
my $self = shift;
my $session = $self->session;
my $paypal_url;
my %paypal; ## return variables from PDT
## find TX key from PayPal PDT
my $tx = $self->session->form->get("tx");
if ($tx) {
# found a tx, re-present it for all the TX details
$paypal_url = $self->get('useSandbox') ? $self->getPayPalSandboxUrl() : $self->getPayPalUrl();
my $query = join( "&", "cmd=_notify-synch", "tx=" . $tx, "at=" . $self->get('signature') );
my $user_agent = new LWP::UserAgent;
my $request = new HTTP::Request( "POST", $paypal_url );
$request->content_type("application/x-www-form-urlencoded");
$request->content($query);
# Make the request
my $result = $user_agent->request($request);
if ( $result->is_error ) {
$session->errorHandler->warn("PayPal Standard: PayPal server seems offline.");
return;
}
# Decode the response into individual lines and unescape any HTML escapes
my @response = split( "\n", $self->session->url->unescape( $result->content ) );
# The status is always the first line of the response.
my $status = shift @response;
foreach my $response_line (@response) {
my ( $key, $value ) = split "=", $response_line;
$paypal{$key} = $value;
}
my $transaction = eval { WebGUI::Shop::Transaction->new( $session, $paypal{invoice} ) };
# First check whether the original transaction actualy exists
if ( WebGUI::Error->caught || !( defined $transaction ) ) {
$session->errorHandler->warn(
"PayPal Standard: No WebGUI transaction ID: $paypal{invoice}," . $self->getId );
return;
}
if ( $status eq "SUCCESS" ) {
$transaction->completePurchase( $paypal{invoice}, 1, $paypal{payment_status} );
my $cart = $self->getCart;
$cart->onCompletePurchase;
$self->sendNotifications($transaction);
}
elsif ( $status eq "FAIL" ) {
$transaction->denyPurchase( $paypal{invoice}, 0, $paypal{payment_status} );
}
if ( $transaction->get('isSuccessful') ) {
return $transaction->thankYou();
}
else {
return $self->displayPaymentError($transaction);
}
}
else { ## no tx from paypal
$session->errorHandler->warn("PayPal Standard: No transaction ID");
}
}
#-------------------------------------------------------------------
=head2 www_edit ( )
Generates an edit form.
=cut
sub www_edit {
my $self = shift;
my $session = $self->session;
my $admin = WebGUI::Shop::Admin->new($session);
my $i18n = WebGUI::International->new( $session, 'PayDriver_PayPalStd' );
return $session->privilege->insufficient() unless $admin->canManage;
my $form = $self->getEditForm;
$form->submit;
# adds instructions for IPN etc.
my $output = '<br />';
$output
.= $i18n->get('extra info')
. '<br /><br />'
. '<b>https://'
. $session->config->get("sitename")->[0]
. '/?shop=pay;method=do;do=completeTransaction;paymentGatewayId='
. $self->getId . '</b>';
return $admin->getAdminConsole->render( $form->print . $output, $i18n->get( 'payment methods', 'PayDriver' ) );
}
#-------------------------------------------------------------------
=head2 www_pay
Web facing wrapper method for C<processTransaction>.
=cut
sub www_pay {
my $self = shift;
my $session = $self->session;
# Payment time!
return $self->processTransaction();
}
1;

95
lib/WebGUI/i18n/English/PayDriver_PayPal.pm
View file

@ -1,95 +0,0 @@
package WebGUI::i18n::English::PayDriver_PayPal;
use strict;
our $I18N = {
'api' => {
message => q{API URL},
lastUpdated => 1247254043,
},
'api error' => {
message => q{Error communicating with PayPal API: %s},
lastUpdated => 1247496228,
context => q{Error message to display on internal error talking to paypal},
},
'api help' => {
message => q{Base URL for PayPal's NVP api},
lastUpdated => 1247254068,
},
'apiSandbox' => {
message => q{API Sandbox URL},
lastUpdated => 1247499398,
},
'apiSandbox help' => {
message => q{URL for Paypal API in test mode},
lastUpdated => 1247499415,
},
'currency' => {
message => q{Currency Code},
lastUpdated => 1247253894,
},
'currency help' => {
message => q{Paypal currency code to use (e.g. USD)},
lastUpdated => 1247253924,
},
'label' => {
message => q{NewPal},
lastUpdated => 1247256659,
},
'name' => {
message => q{NewPal},
lastUpdated => 1247256412,
},
'password' => {
message => q{Password},
lastUpdated => 1247254156,
},
'password help' => {
message => q{Password from PayPal credentials},
lastUpdated => 1247254172,
},
'paypal' => {
message => q{Paypal URL},
lastUpdated => 1247498678,
},
'paypal help' => {
message => q{URL to use when redirecting to paypal},
lastUpdated => 1247498700,
},
'sandbox' => {
message => q{Sandbox URL},
lastUpdated => 1247498780,
},
'sandbox help' => {
message => q{URL to use for redirecting to paypal in test mode},
lastUpdated => 1247498766,
},
'signature' => {
message => q{Signature},
lastUpdated => 1247254180,
},
'signature help' => {
message => q{Signature from PayPal credentials},
lastUpdated => 1247254195,
},
'testMode' => {
message => q{Test Mode},
lastUpdated => 1247253942,
},
'testMode help' => {
message => q{Whether to use PayPal's sandbox},
lastUpdated => 1247253981,
},
'user' => {
message => q{Username},
lastUpdated => 1247254097,
},
'user help' => {
message => q{Username from Paypal credentials},
lastUpdated => 1247254128,
},
};
1;
#vim:ft=perl

176
lib/WebGUI/i18n/English/PayDriver_PayPalStd.pm Normal file
View file

@ -0,0 +1,176 @@
package WebGUI::i18n::English::PayDriver_PayPalStd;
=head1 LEGAL
-------------------------------------------------------------------
PayPal Standard payment driver for WebGUI.
Copyright (C) 2009 Invicta Services, LLC.
-------------------------------------------------------------------
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License along
with this program; if not, write to the Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
-------------------------------------------------------------------
=cut
use strict;
our $I18N = {
'error occurred message' => {
message => q|The following errors occurred:|,
lastUpdated => 0,
context => q|The message that tell the user that there were some errors in their submitted credentials.|,
},
'PayPal' => {
message => q|PayPal|,
lastUpdated => 0,
context => q|The name of the PayPal Website Payments Standard plugin|,
},
'label' => {
message => q|PayPal|,
lastUpdated => 0,
context => q|Default PayPal payment gateway label|
},
'vendorId' => {
message => q|PayPal Account|,
lastUpdated => 0,
context => q|Form label in the configuration form of the PayPal module.|
},
'vendorId help' => {
message => q|Fill in the email address that identifies your PayPal account.|,
lastUpdated => 0,
context => q|Hover help for vendor id in the configuration form of the PayPal module.|
},
'emailMessage' => {
message => q|Email message|,
lastUpdated => 0,
context => q|Form label in the configuration form of the PayPal module.|
},
'emailMessage help' => {
message => q|The message that will be appended to the email user will receive from PayPal.|,
lastUpdated => 0,
context => q|Hover help for the email message field in the configuration form of the PayPal module.|
},
'password' => {
message => q|Password|,
lastUpdated => 0,
context => q|Form label in the configuration form of the PayPal module.|
},
'password help' => {
message => q|The password for your PayPal account.|,
lastUpdated => 0,
context => q|Hover help for the password field in the configuration form of the PayPal module.|
},
'signature' => {
message => q|Signature|,
lastUpdated => 0,
context => q|Form label in the configuration form of the PayPal module.|
},
'signature help' => {
message => q|The account signature for your PayPal account.|,
lastUpdated => 0,
context => q|Hover help for the signature field in the configuration form of the PayPal module.|
},
'currency' => {
message => q|Currency|,
lastUpdated => 0,
context => q|Form label in the configuration form of the PayPal module.|
},
'currency help' => {
message => q|The currency for your transactions with your PayPal account.|,
lastUpdated => 0,
context => q|Hover help for the signature field in the configuration form of the PayPal module.|
},
'use sandbox' => {
message => q|Use Sandbox|,
lastUpdated => 0,
context => q|Form label in the configuration form of the PayPal module.|
},
'use sandbox help' => {
message =>
q|Set this option to yes if you want to use the PayPal SANDBOX development (i.e. NOT production) environment. Recommended for testing.|,
lastUpdated => 0,
context => q|Form label in the configuration form of the PayPal module.|
},
'button image' => {
message => q|PayPal Button image URL|,
lastUpdated => 1241986933,
context => q|Form label in the configuration form of the PayPal module.|
},
'button image help' => {
message => q|Set this option to use PayPal images for checkout buttons.|,
lastUpdated => 1241986933,
context => q|Form label in the configuration form of the PayPal module.|
},
'module name' => {
message => q|PayPal|,
lastUpdated => 0,
context => q|The displayed name of the payment module.|
},
'invalid firstName' => {
message => q|You have to enter a valid first name.|,
lastUpdated => 0,
context => q|An error indicating that an invalid first name has been entered.|
},
'invalid lastName' => {
message => q|You have to enter a valid last name.|,
lastUpdated => 0,
context => q|An error indicating that an invalid last name has been entered.|
},
'invalid address' => {
message => q|You have to enter a valid address.|,
lastUpdated => 0,
context => q|An error indicating that an invalid street has been entered.|
},
'invalid city' => {
message => q|You have to enter a valid city.|,
lastUpdated => 0,
context => q|An error indicating that an invalid city has been entered.|
},
'invalid zip' => {
message => q|You have to enter a valid zipcode.|,
lastUpdated => 0,
context => q|An error indicating that an invalid zipcode has been entered.|
},
'invalid email' => {
message => q|You have to enter a valid email address.|,
lastUpdated => 0,
context => q|An error indicating that an invalid email address has been entered.|
},
'PayPal' => {
message => q|PayPal|,
lastUpdated => 0,
context => q|Name of the gateway from the definition|
},
'no description' => {
message => q|No description|,
lastUpdated => 0,
context => q|The default description of purchase of users.|
},
'extra info' => {
message =>
q|Remember to set both &quot;Payment Data Transfer&quot; and &quot;Auto Return&quot; <b>ON</b> in the <a href="https://www.paypal.com/us/cgi-bin/webscr?cmd=_profile-website-payments">Website Payments</a> section of your PayPal Profile.<br />
Additionally, set the &quot;Return URL&quot; to:|,
lastUpdated => 1245364211,
context => q|An informational message that's shown in the configuration form of this plugin.|
},
};
1;