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

PayPalStd resurrected

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

594
lib/WebGUI/Shop/PayDriver/PayPal.pm
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;

329
lib/WebGUI/Shop/PayDriver/PayPal/ExpressCheckout.pm Normal file
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;

298
lib/WebGUI/Shop/PayDriver/PayPal/PayPalStd.pm Normal file
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;