PayPalStd resurrected

This commit is contained in:
Paul Driver 2009-07-20 21:04:12 +00:00
parent 9af746c7af
commit a632380882
8 changed files with 1159 additions and 292 deletions

View file

@ -11,6 +11,8 @@
- fixed #10656: Story: Photo caption doesn't appear
- fixed #10658: Delete in Story Archive doesn't delete in Story Topic
- fixed #10676: Settings>Account Tab: typos
- WebGUI::Shop::PayDriver::PayPal moved to WebGUI::Shop::PayDriver::PayPal::ExpressCheckout.
- WebGUI::Shop::PayDriver::PayPal::PayPalStd is back, now functional.
7.7.15
- fixed #10629: WebGUI::ProfileField create new field bug

View file

@ -7,6 +7,16 @@ upgrading from one version to the next, or even between multiple
versions. Be sure to heed the warnings contained herein as they will
save you many hours of grief.
7.6.16
--------------------------------------------------------------------
* There was some confusion about the state of
WebGUI::Shop::PayDriver::PayPal::PayPalStd. While it was in fact
dysfunctional, it was using the Paypal Website Standard API, while
the new Paypal module was using Express Checkout. Express checkout
is only available in the US, UK, and Canada. PayPalStd has
been repaired, and the newly written Express Checkout module is
available at WebGUI::Shop::PayDriver::PayPal::ExpressCheckout.
7.7.15
--------------------------------------------------------------------
* WebGUI::Shop::PayDriver::PayPal::PayPalStd has been replaced by

View file

@ -30,6 +30,7 @@ my $quiet; # this line required
my $session = start(); # this line required
replaceUsageOfOldTemplatesAgain($session);
updatePayPalDriversAgain($session);
# upgrade functions go here
@ -45,6 +46,24 @@ finish($session); # this line required
# print "DONE!\n" unless $quiet;
#}
#----------------------------------------------------------------------------
sub updatePayPalDriversAgain {
my $session = shift;
my $config = $session->config;
print "\tUpdating paypal drivers in config file..." unless $quiet;
my $old = 'WebGUI::Shop::PayDriver::PayPal';
my @new = qw(
WebGUI::Shop::PayDriver::PayPal::PayPalStd
WebGUI::Shop::PayDriver::PayPal::ExpressCheckout
);
$config->deleteFromArray('paymentDrivers', $old);
foreach my $n (@new) {
$config->deleteFromArray('paymentDrivers', $n);
$config->addToArray('paymentDrivers', $n) ;
}
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
sub replaceUsageOfOldTemplatesAgain {
my $session = shift;

View file

@ -1,329 +1,343 @@
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 LWP::UserAgent;
use Tie::IxHash;
use WebGUI::International;
use WebGUI::Form;
use URI::Escape;
use URI::Split;
use URI;
use Readonly;
use Data::Dumper;
use warnings;
=head1 NAME
WebGUI::Shop::PayDriver::PayPal
=head1 DESCRIPTION
=head1 DESCRIPTION
Payment driver that talks to PayPal
=head1 SYNOPSIS
# in webgui config file...
"paymentDrivers" : [
"WebGUI::Shop::PayDriver::Cash",
"WebGUI::Shop::PayDriver::PayPal",
...
],
Super class for PayPal payment drivers
=head1 METHODS
The following methods are available from this class:
These methods are available from this class:
=cut
Readonly my $I18N => 'PayDriver_PayPal';
=head2 getPaymentCurrencies
#-------------------------------------------------------------------
=head2 apiUrl
Returns the URL for the PayPal API (or the sandbox, if we are configured to
use the sandbox)
Returns a hash reference of currency codes and their full names.
=cut
sub apiUrl {
my $self = shift;
return $self->get( $self->get('testMode') ? 'apiSandbox' : 'api' );
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
=head2 definition
Standard definition method.
Returns a hash of credit card types
=cut
sub definition {
my ( $class, $session, $definition ) = @_;
my $i18n = WebGUI::International->new( $session, $I18N );
tie my %fields, 'Tie::IxHash';
my @fieldNames = qw(
paypal sandbox
api apiSandbox
user password
currency testMode
signature
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
#-------------------------------------------------------------------
=head2 getButton
Overridden, submits to www_sendToPaypal with the proper parameters.
=cut
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('name') } )
. 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 payPalUrl
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' );
}
#-------------------------------------------------------------------
=head2 processPayment ( transaction )
Implements the interface defined in WebGUI::Shop::PayDriver. Notably, on
error 'message' will be an HTML table representing the parameters that the
PayPal API spit back.
=cut
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 $i18n = WebGUI::International->new( $self->session, $I18N );
my $message = sprintf $i18n->get('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 = $i18n->get('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
=head1 LIMITATIONS
=over 4
=item
Doesn't handle recurring payments, although Paypal can do that.
=item
There is no itemization of the cart for Paypal's records, just one total
(could do taxes, shipping, each item as separate things).
=item
Paypal's shipping information is ignored; this could be changed to accept new
shipping info from PayPal, but that's somewhat fragile. We're currently just
pretending PayPal is a payment gateway.
=back
=cut
1;

View file

@ -0,0 +1,329 @@
package WebGUI::Shop::PayDriver::PayPal::ExpressCheckout;
use strict;
use base qw/WebGUI::Shop::PayDriver/;
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
WebGUI::Shop::PayDriver::PayPal
=head1 DESCRIPTION
Payment driver that talks to PayPal using the Express Checkout API
=head1 SYNOPSIS
# in webgui config file...
"paymentDrivers" : [
"WebGUI::Shop::PayDriver::Cash",
"WebGUI::Shop::PayDriver::PayPal",
...
],
=head1 METHODS
The following methods are available from this class:
=cut
Readonly my $I18N => 'PayDriver_ExpressCheckout';
#-------------------------------------------------------------------
=head2 apiUrl
Returns the URL for the PayPal API (or the sandbox, if we are configured to
use the sandbox)
=cut
sub apiUrl {
my $self = shift;
return $self->get( $self->get('testMode') ? 'apiSandbox' : 'api' );
}
#-------------------------------------------------------------------
=head2 definition
Standard definition method.
=cut
sub definition {
my ( $class, $session, $definition ) = @_;
my $i18n = WebGUI::International->new( $session, $I18N );
tie my %fields, 'Tie::IxHash';
my @fieldNames = qw(
paypal sandbox
api apiSandbox
user password
currency testMode
signature
);
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
#-------------------------------------------------------------------
=head2 getButton
Overridden, submits to www_sendToPaypal with the proper parameters.
=cut
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('name') } )
. WebGUI::Form::formFooter($session);
return $payForm;
}
#-------------------------------------------------------------------
=head2 payPalForm ( %fields )
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.
=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');
return $args;
}
#-------------------------------------------------------------------
=head2 payPalUrl
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' );
}
#-------------------------------------------------------------------
=head2 processPayment ( transaction )
Implements the interface defined in WebGUI::Shop::PayDriver. Notably, on
error 'message' will be an HTML table representing the parameters that the
PayPal API spit back.
=cut
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 $i18n = WebGUI::International->new( $self->session, $I18N );
my $message = sprintf $i18n->get('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 = $i18n->get('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
=head1 LIMITATIONS
=over 4
=item
Doesn't handle recurring payments, although Paypal can do that.
=item
There is no itemization of the cart for Paypal's records, just one total
(could do taxes, shipping, each item as separate things).
=item
Paypal's shipping information is ignored; this could be changed to accept new
shipping info from PayPal, but that's somewhat fragile. We're currently just
pretending PayPal is a payment gateway.
=back
=cut
1;

View file

@ -0,0 +1,298 @@
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 warnings;
use base qw/WebGUI::Shop::PayDriver::PayPal/;
use URI;
=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 { 0 }
#-------------------------------------------------------------------
# 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,
},
sandboxUrl => {
fieldType => 'text',
label => $i18n->get('sandbox url'),
hoverHelp => $i18n->get('sandbox url help'),
defaultValue => 'https://www.sandbox.paypal.com/cgi-bin/webscr',
},
liveUrl => {
fieldType => 'text',
label => $i18n->get('live url'),
hoverHelp => $i18n->get('live url help'),
defaultValue => 'https://www.paypal.com/cgi-bin/webscr',
},
buttonImage => {
fieldType => 'text',
label => $i18n->get('button image'),
hoverHelp => $i18n->get('button image help'),
defaultValue => '',
},
);
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 $header = WebGUI::Form::formHeader(
$session, {
action => $self->payPalUrl,
method => 'POST',
}
);
# All the API stuff is done in paymentVariables; we'll just turn it into
# hidden form fields here
my $v = $self->paymentVariables;
my $fields = join "\n", map {
WebGUI::Form::hidden( $session, { name => $_, value => $v->{$_} } )
} (keys %$v);
# Customized buttons are allowed; If they didn't give us one, we'll just
# do a submit button with i18n'd paypal text. If they did, we'll use an
# image submit.
my $button;
my $i18n = WebGUI::International->new( $session, 'PayDriver_PayPalStd' );
my $text = $i18n->get('PayPal');
if ( $self->get('buttonImage') ) {
my $raw = $self->get('buttonImage');
WebGUI::Macro::process( $session, \$raw );
$button = qq{
<input type='image'
src='$raw'
border='0'
name='submit'
alt='$text'>
};
}
else {
$button = WebGUI::Form::submit( $session, { value => $text } );
}
my $footer = WebGUI::Form::formFooter($session);
return join "\n", $header, $fields, $button, $footer;
}
#-------------------------------------------------------------------
=head2 paymentVariables
Returns a hashref of the payment variables to be used as hidden form fields
when clicking the getButton button.
=cut
sub paymentVariables {
my $self = shift;
my $url = $self->session->url;
my $base = $url->getSiteURL . $url->page;
my $cart = $self->getCart;
my $return = URI->new($base);
$return->query_form( {
shop => 'pay',
method => 'do',
do => 'completeTransaction',
paymentGatewayId => $self->getId,
}
);
my $cancel = URI->new($base);
$cancel->query_form({ shop => 'cart' });
my %params = (
cmd => '_cart',
upload => 1,
business => $self->get('vendorId'),
currency_code => $self->get('currency'),
no_shipping => 1,
rm => 2,
return => $return->as_string,
cancel_return => $cancel->as_string,
shipping => $cart->calculateShipping,
tax_cart => $cart->calculateTaxes,
discount_amount_cart => -($cart->calculateShopCreditDeduction),
);
my $counter = 0;
foreach my $item (@{ $cart->getItems}) {
my $n = ++$counter;
$params{"amount_$n"} = $item->getSku->getPrice;
$params{"quantity_$n"} = $item->get('quantity');
$params{"item_name_$n"} = $item->get('configuredTitle');
$params{"item_number_$n"} = $item->get('itemId');
}
return \%params;
}
#-------------------------------------------------------------------
=head2 payPalUrl
Returns the url of the paypal gateway, taking into account useSandbox.
=cut
sub payPalUrl {
my $self = shift;
my $field = $self->get('useSandbox') ? 'sandboxUrl' : 'liveUrl';
return $self->get($field);
}
#-------------------------------------------------------------------
=head2 processPayment ( transaction )
Implements the interface defined in WebGUI::Shop::PayDriver. Notably, in case
of an error, the error is rendered as an html table of the params that paypal
passed to us.
=cut
sub processPayment {
my ( $self, $transaction ) = @_;
my $session = $self->session;
my $params = $session->form->paramsHashRef;
my $status = $params->{payment_status};
my $tx = $params->{txn_id};
if ($status ne 'Completed') {
my $message = '<table><tr><th>Field</th><th>Value</th></tr>';
foreach my $key ( keys %$params ) {
$message .= "<tr><td>$key</td><td>$params->{$key}</td></tr>";
}
$message .= '</table>';
return ( 0, $tx, $status, $message );
}
return ( 1, $tx, $status, $status );
} ## end sub processPayment
#-------------------------------------------------------------------
=head2 www_completeTransaction
Where paypal comes back to when a transaction has been completed.
=cut
sub www_completeTransaction {
my $self = shift;
my $transaction = $self->processTransaction;
return $transaction->get('isSuccessful')
? $transaction->thankYou
: $self->displayPaymentError($transaction);
}
1;

View file

@ -1,4 +1,4 @@
package WebGUI::i18n::English::PayDriver_PayPal;
package WebGUI::i18n::English::PayDriver_ExpressCheckout;
use strict;
@ -38,7 +38,7 @@ our $I18N = {
context => q{Message to display when something goes wrong talking to PayPal},
},
'name' => {
message => q{PayPal},
message => q{PayPal Express Checkout},
lastUpdated => 1247256412,
context => q{The name of the payment driver},
},

View file

@ -0,0 +1,195 @@
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.|
},
'live url' => {
message => 'Live URL',
lastUpdated => 0,
},
'live url help' => {
message => 'URL to post to when live (not using sandbox)',
lastUpdated => 0,
},
'sandbox url' => {
message => 'Sandbox URL',
lastUpdated => 0,
},
'sandbox url help' => {
message => 'URL to post to when testing (using sandbox)',
lastUpdated => 0,
},
'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;