Merge commit 'v7.10.17' into 8
Conflicts: docs/upgrades/upgrade_7.9.13-7.10.0.pl lib/WebGUI.pm lib/WebGUI/Asset/Template/TemplateToolkit.pm lib/WebGUI/Asset/Wobject/AssetReport.pm lib/WebGUI/Asset/Wobject/Thingy.pm lib/WebGUI/Form/Captcha.pm lib/WebGUI/Macro/AdminBar.pm lib/WebGUI/Shop/Cart.pm lib/WebGUI/Shop/PayDriver.pm lib/WebGUI/Shop/PayDriver/PayPal/ExpressCheckout.pm lib/WebGUI/Shop/PayDriver/PayPal/PayPalStd.pm lib/WebGUI/Shop/Transaction.pm lib/WebGUI/Workflow/Instance.pm lib/WebGUI/Workflow/Spectre.pm lib/WebGUI/i18n/English/PayDriver.pm t/Asset/Asset.t t/Asset/AssetExportHtml.t t/Asset/AssetLineage.t t/Asset/Wobject/Thingy.t
This commit is contained in:
Doug Bell
commit
795d88e7e5
69 changed files with 972 additions and 170 deletions
|
|
@ -566,6 +566,10 @@ The "turn admin on" group which is group id 12.
|
|||
|
||||
sub canAdd {
|
||||
my $className = shift;
|
||||
|
||||
# just in case we get called as object method
|
||||
$className = $className->get('className') if blessed $className;
|
||||
|
||||
my $session = shift;
|
||||
my $userId = shift || $session->user->userId;
|
||||
my $user = WebGUI::User->new($session, $userId);
|
||||
|
|
|
|||
|
|
@ -169,10 +169,13 @@ sub getTemplateVars {
|
|||
#Build the data for all the assets on the page
|
||||
$var->{'asset_loop'} = [];
|
||||
my $data = $p->getPageData;
|
||||
ROW: foreach my $row (@{$data}) {
|
||||
foreach my $row (@{$data}) {
|
||||
my $returnAsset = eval { WebGUI::Asset->newById($session, $row->{assetId}); };
|
||||
next ROW if Exception::Class->caught();
|
||||
push(@{$var->{'asset_loop'}}, $returnAsset->get);
|
||||
push(@{$var->{'asset_loop'}}, {
|
||||
%{$returnAsset->get},
|
||||
%{$returnAsset->getMetaDataAsTemplateVariables}
|
||||
});
|
||||
}
|
||||
|
||||
#Append template variables
|
||||
|
|
|
|||
|
|
@ -650,6 +650,17 @@ sub editThingDataSave {
|
|||
$fieldValue = $field->{defaultValue};
|
||||
#WebGUI::Macro::process($self->session,\$fieldValue);
|
||||
}
|
||||
|
||||
if ($field->{isUnique}) {
|
||||
|
||||
unless ( $self->isUniqueEntry($thingId,$fieldName,$fieldValue,$thingDataId)) {
|
||||
push (@errors,{
|
||||
"error_message"=>$field->{label}. $i18n->get('needs to be unique error'),
|
||||
});
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
$thingData{$fieldName} = $fieldValue;
|
||||
}
|
||||
|
||||
|
|
@ -836,6 +847,15 @@ sub getEditFieldForm {
|
|||
options=>\@fieldTypes,
|
||||
id=>$dialogPrefix."_fieldType_formId",
|
||||
);
|
||||
|
||||
$f->addField( "yesNo",
|
||||
name=>'isUnique',
|
||||
label=>$i18n->get('unique label'),
|
||||
hoverHelp=>$i18n->get('unique description'),
|
||||
value=>$field->{isUnique},
|
||||
id=>$dialogPrefix."_isUnique_formId",
|
||||
);
|
||||
|
||||
$f->addField( "ReadOnly",
|
||||
name => "${dialogPrefix}_fieldInThing_module",
|
||||
value => $self->getHtmlWithModuleWrapper($dialogPrefix."_fieldInThing_module")
|
||||
|
|
@ -1377,6 +1397,68 @@ sub hasEnteredMaxPerUser {
|
|||
}
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 hasEnteredMaxEntries
|
||||
|
||||
Check whether the the maximum number of entries allowed for this thing has been reached.
|
||||
|
||||
=head3 thingId
|
||||
|
||||
The unique id of a thing.
|
||||
|
||||
=cut
|
||||
|
||||
sub hasEnteredMaxEntries {
|
||||
my ($self,$thingId) = @_;
|
||||
my $session = $self->session;
|
||||
my $db = $session->db;
|
||||
|
||||
my $maxEntriesTotal = $db->quickScalar("select maxEntriesTotal from Thingy_things where thingId=?",[$thingId]);
|
||||
|
||||
return 0 unless $maxEntriesTotal;
|
||||
|
||||
my $numberOfEntries = $session->db->quickScalar("select count(*) "
|
||||
."from ".$session->db->dbh->quote_identifier("Thingy_".$thingId));
|
||||
|
||||
if($numberOfEntries < $maxEntriesTotal){
|
||||
return 0;
|
||||
}
|
||||
else{
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 isUniqueEntry ( thingId,fieldName,fieldValue, thingDataId )
|
||||
|
||||
Checks if the data entered in thingy record is unique
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
sub isUniqueEntry {
|
||||
|
||||
my ($self,$thingId,$fieldName,$fieldValue,$thingDataId) = @_;
|
||||
my $session = $self->session;
|
||||
my $db = $session->db;
|
||||
|
||||
my $nrOfEntries = $session->db->quickScalar("select count(*) "
|
||||
."from ".$session->db->dbh->quote_identifier("Thingy_".$thingId)." where " .
|
||||
$session->db->dbh->quote_identifier($fieldName) ."=? and thingDataId !=?",[$fieldValue,$thingDataId]);
|
||||
if ($nrOfEntries > 0) { return 0; }
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 hasPrivileges ( groupId )
|
||||
|
|
@ -1991,8 +2073,9 @@ sub www_editThing {
|
|||
thingsPerPage=>25,
|
||||
exportMetaData=>undef,
|
||||
maxEntriesPerUser=>undef,
|
||||
maxEntriesTotal=>undef,
|
||||
);
|
||||
$thingId = "new";
|
||||
$thingId = $self->addThing(\%properties,0);
|
||||
}
|
||||
else{
|
||||
%properties = %{$self->getThing($thingId)};
|
||||
|
|
@ -2197,6 +2280,14 @@ sub www_editThing {
|
|||
-hoverHelp=> $i18n->get('max entries per user description'),
|
||||
-label => $i18n->get('max entries per user label')
|
||||
);
|
||||
|
||||
$tab->integer(
|
||||
-name=> "maxEntriesTotal",
|
||||
-value=> $properties{maxEntriesTotal},
|
||||
-hoverHelp => $i18n->get('max entries total description'),
|
||||
-label => $i18n->get('max entries total label')
|
||||
);
|
||||
|
||||
$tab->group(
|
||||
-name=> "groupIdAdd",
|
||||
-value=> $properties{groupIdAdd},
|
||||
|
|
@ -2429,9 +2520,10 @@ sub www_editThingSave {
|
|||
sortBy => $form->process("sortBy") || '',
|
||||
exportMetaData => $form->process("exportMetaData") || '',
|
||||
maxEntriesPerUser => $form->process("maxEntriesPerUser") || '',
|
||||
maxEntriesTotal => $form->process("maxEntriesTotal") || '',
|
||||
};
|
||||
$self->setCollateral("Thingy_things", "thingId", $thing, 0, 1);
|
||||
|
||||
|
||||
if($fields->rows < 1){
|
||||
$self->session->log->warn("Thing failed to create because it had no fields");
|
||||
my $i18n = WebGUI::International->new($self->session, "Asset_Thingy");
|
||||
|
|
@ -2465,7 +2557,6 @@ sub www_editField {
|
|||
return $session->privilege->insufficient() unless $self->canEdit;
|
||||
$fieldId = $session->form->process("fieldId");
|
||||
$thingId = $session->form->process("thingId");
|
||||
|
||||
%properties = $session->db->quickHash("select * from Thingy_fields where thingId=? and fieldId=? and assetId=?",
|
||||
[$thingId,$fieldId,$self->getId]);
|
||||
if($session->form->process("copy")){
|
||||
|
|
@ -2502,12 +2593,12 @@ sub www_editFieldSave {
|
|||
my $log = $session->log;
|
||||
my $defaultValue = $session->form->process("defaultValue");
|
||||
my $fieldType = $session->form->process("fieldType") || "ReadOnly";
|
||||
my $uniqueField = $session->form->process("isUnique");
|
||||
|
||||
|
||||
if ($fieldType =~ m/^otherThing/){
|
||||
$defaultValue = $session->form->process("defaultFieldInThing");
|
||||
}
|
||||
|
||||
$thingId = $self->addThing({ thingId => 'new' },0) if $thingId eq 'new';
|
||||
|
||||
$fieldId = $session->form->process("fieldId");
|
||||
%properties = (
|
||||
|
|
@ -2515,6 +2606,7 @@ sub www_editFieldSave {
|
|||
thingId => $thingId,
|
||||
label => $label,
|
||||
fieldType => $fieldType,
|
||||
isUnique => $uniqueField,
|
||||
defaultValue => $defaultValue,
|
||||
possibleValues => $session->form->process("possibleValues"),
|
||||
pretext => $session->form->process("pretext"),
|
||||
|
|
@ -2572,7 +2664,7 @@ sub www_editFieldSave {
|
|||
# Make sure we send debug information along with the field.
|
||||
$log->preventDebugOutput;
|
||||
|
||||
$session->output->print($thingId.$newFieldId.$listItemHTML);
|
||||
$session->output->print($newFieldId.$listItemHTML);
|
||||
return "chunked";
|
||||
}
|
||||
|
||||
|
|
@ -2732,7 +2824,7 @@ sub editThingData {
|
|||
$var->{"delete_confirm"} = "onclick=\"return confirm('".$i18n->get("delete thing data warning")."')\"";
|
||||
}
|
||||
|
||||
if($self->hasPrivileges($thingProperties->{groupIdAdd}) && !$self->hasEnteredMaxPerUser($thingId)){
|
||||
if($self->hasPrivileges($thingProperties->{groupIdAdd}) && !$self->hasEnteredMaxPerUser($thingId) && !$self->hasEnteredMaxEntries($thingId)){
|
||||
$var->{"add_url"} = $session->url->append($url,'func=editThingData;thingId='.$thingId.';thingDataId=new');
|
||||
}
|
||||
if($self->hasPrivileges($thingProperties->{groupIdSearch})){
|
||||
|
|
@ -2798,6 +2890,15 @@ sub editThingData {
|
|||
delete $var->{field_loop};
|
||||
$var->{editInstructions} = $i18n->get("has entered max per user message");
|
||||
}
|
||||
if($thingDataId eq 'new' && $self->hasEnteredMaxEntries($thingId)){
|
||||
delete $var->{form_start};
|
||||
delete $var->{form_end};
|
||||
delete $var->{form_submit};
|
||||
delete $var->{field_loop};
|
||||
$var->{editInstructions} = $i18n->get("has entered max total message");
|
||||
}
|
||||
|
||||
|
||||
return $self->processTemplate($var,$thingProperties->{editTemplateId});
|
||||
}
|
||||
|
||||
|
|
@ -2827,6 +2928,10 @@ sub www_editThingDataSave {
|
|||
if($thingDataId eq 'new' && $self->hasEnteredMaxPerUser($thingId)){
|
||||
return $i18n->get("has entered max per user message");
|
||||
}
|
||||
if($thingDataId eq 'new' && $self->hasEnteredMaxEntries($thingId)){
|
||||
return $i18n->get("has entered max total message");
|
||||
}
|
||||
|
||||
|
||||
($newThingDataId,$errors) = $self->editThingDataSave($thingId,$thingDataId);
|
||||
|
||||
|
|
@ -2897,6 +3002,10 @@ sub www_editThingDataSaveViaAjax {
|
|||
$session->response->status(400);
|
||||
return JSON->new->encode({message => $i18n->get("has entered max per user message")});
|
||||
}
|
||||
if($thingDataId eq 'new' && $self->hasEnteredMaxEntries($thingId)){
|
||||
$session->http->setStatus("400", "Bad Request");
|
||||
return JSON->new->encode({message => $i18n->get("has entered max total message")});
|
||||
}
|
||||
|
||||
my ($newThingDataId,$errors) = $self->editThingDataSave($thingId,$thingDataId);
|
||||
|
||||
|
|
@ -3083,6 +3192,9 @@ sub www_import {
|
|||
my ($sql,$fields,@fields,$fileName,@insertColumns);
|
||||
my ($handleDuplicates,$newThingDataId);
|
||||
|
||||
my $i18n = WebGUI::International->new($self->session, "Asset_Thingy");
|
||||
|
||||
|
||||
my $thingId = $session->form->process('thingId');
|
||||
my $thingProperties = $self->getThing($thingId);
|
||||
return $session->privilege->insufficient() unless $self->hasPrivileges($thingProperties->{groupIdImport});
|
||||
|
|
@ -3183,9 +3295,27 @@ sub www_import {
|
|||
$log->info("Skipping line");
|
||||
next;
|
||||
}
|
||||
$thingData{lastUpdated} = time();
|
||||
$thingData{updatedByName} = $session->user->username;
|
||||
$thingData{updatedById} = $session->user->userId;
|
||||
|
||||
# Is this a new record or are we updating an existing record?
|
||||
if ($thingData{thingDataId} eq 'new') {
|
||||
$thingData{dateCreated} = time();
|
||||
$thingData{createdById} = $session->user->userId;
|
||||
}
|
||||
else {
|
||||
$thingData{lastUpdated} = time();
|
||||
$thingData{updatedByName} = $session->user->username;
|
||||
$thingData{updatedById} = $session->user->userId;
|
||||
}
|
||||
|
||||
$thingData{ipAddress} = $session->request->address;
|
||||
|
||||
if($thingData{thingDataId} eq 'new' && $self->hasEnteredMaxPerUser($thingId)){
|
||||
last;
|
||||
}
|
||||
if($thingData{thingDataId} eq 'new' && $self->hasEnteredMaxEntries($thingId)){
|
||||
last;
|
||||
}
|
||||
|
||||
$self->setCollateral("Thingy_".$thingId,"thingDataId",\%thingData,0,0) if ($thingData{thingDataId});
|
||||
}
|
||||
close $importFile;
|
||||
|
|
@ -3509,7 +3639,7 @@ sub getSearchTemplateVars {
|
|||
if ($self->hasPrivileges($thingProperties->{groupIdImport})){
|
||||
$var->{"import_url"} = $session->url->append($url, 'func=importForm;thingId='.$thingId);
|
||||
}
|
||||
if ($self->hasPrivileges($thingProperties->{groupIdAdd}) && !$self->hasEnteredMaxPerUser($thingId)){
|
||||
if ($self->hasPrivileges($thingProperties->{groupIdAdd}) && !$self->hasEnteredMaxPerUser($thingId) && !$self->hasEnteredMaxEntries($thingId) ){
|
||||
$var->{"add_url"} = $session->url->append($url,'func=editThingData;thingId='.$thingId.';thingDataId=new');
|
||||
}
|
||||
$var->{searchScreenTitle} = $thingProperties->{searchScreenTitle};
|
||||
|
|
@ -3810,7 +3940,7 @@ sub www_viewThingData {
|
|||
.$thingId.';thingDataId='.$thingDataId);
|
||||
$var->{"delete_confirm"} = "onclick=\"return confirm('".$i18n->get("delete thing data warning")."')\"";
|
||||
}
|
||||
if($self->hasPrivileges($thingProperties->{groupIdAdd}) && !$self->hasEnteredMaxPerUser($thingId)){
|
||||
if($self->hasPrivileges($thingProperties->{groupIdAdd}) && !$self->hasEnteredMaxPerUser($thingId) && !$self->hasEnteredMaxEntries($thingId) ){
|
||||
$var->{"add_url"} = $session->url->append($url, 'func=editThingData;thingId='.$thingId.';thingDataId=new');
|
||||
}
|
||||
if($self->hasPrivileges($thingProperties->{groupIdSearch})){
|
||||
|
|
@ -3823,8 +3953,10 @@ sub www_viewThingData {
|
|||
my $template;
|
||||
if( $templateId )
|
||||
{
|
||||
$template = WebGUI::Asset::Template->newByUrl( $session, $templateId ) ||
|
||||
WebGUI::Asset::Template->newById( $session, $templateId );
|
||||
$template = eval { WebGUI::Asset::Template->newByUrl( $session, $templateId ) };
|
||||
if ( $@ ) {
|
||||
$template = eval { WebGUI::Asset::Template->newById( $session, $templateId ) };
|
||||
}
|
||||
}
|
||||
|
||||
return $self->processStyle(
|
||||
|
|
|
|||
|
|
@ -519,9 +519,13 @@ sub exportGetAssetIds {
|
|||
my $session = $self->session;
|
||||
my $ids = $self->exportGetDescendants( undef, $options->{depth} );
|
||||
return $ids unless $options->{exportRelated};
|
||||
# We want the ids in a descendant order, but we don't want to repeat
|
||||
# assetIds, so we're using Tie::IxHash to get an ordered set.
|
||||
tie my %set, 'Tie::IxHash';
|
||||
|
||||
# We don't particularly care about the order of the assetIds. The only
|
||||
# thing that might care is the ProgressTree page, and it computes the tree
|
||||
# by looking at asset lineage anyway. We do want to follow chains of
|
||||
# related assets though, so we'll use $ids as a queue and push related
|
||||
# assets onto the end (unless, of course, they're already in the set).
|
||||
my %set;
|
||||
while (my $id = shift @$ids) {
|
||||
my $asset = WebGUI::Asset->newById($session, $id);
|
||||
undef $set{$id};
|
||||
|
|
@ -616,21 +620,25 @@ sub exportGetDescendants {
|
|||
|
||||
=head2 exportGetRelatedAssetIds
|
||||
|
||||
Normally all an asset's shorcuts, but override if exporting your asset would
|
||||
invalidate other exported assets. If exportRelated is checked, this will be
|
||||
called and any assetIds it returns will be exported when your asset is
|
||||
exported.
|
||||
Normally all an asset's shorcuts and its container (via $asset->getContainer),
|
||||
but override if exporting your asset would invalidate other exported assets.
|
||||
If exportRelated is checked, this will be called and any assetIds it returns
|
||||
will be exported when your asset is exported.
|
||||
|
||||
Note: You should NOT include parents as related assets simply because they're
|
||||
your parents. If the user wants to export your parent, he can do that. This is
|
||||
for assets that aren't necessarily in your ancestry. If parents were always
|
||||
related, exporting anything would export everything.
|
||||
This method returns an arrayref, and IS ALLOWED to contain the same assetId
|
||||
more than once. Anyone calling this function should check for duplicates. No
|
||||
particular order should be assumed.
|
||||
|
||||
=cut
|
||||
|
||||
sub exportGetRelatedAssetIds {
|
||||
my $self = shift;
|
||||
WebGUI::Asset::Shortcut->getShortcutsForAssetId($self->session, $self->getId);
|
||||
my $related = WebGUI::Asset::Shortcut->getShortcutsForAssetId(
|
||||
$self->session,
|
||||
$self->getId
|
||||
);
|
||||
push @$related, $self->getContainer->getId;
|
||||
return $related;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -109,7 +109,7 @@ sub getValue {
|
|||
my $response = $self->session->form->param('recaptcha_response_field');
|
||||
|
||||
my $ua = LWP::UserAgent->new;
|
||||
my $res = $ua->post('http://api-verify.recaptcha.net/verify', {
|
||||
my $res = $ua->post('http://www.google.com/recaptcha/api/verify', {
|
||||
privatekey => $privKey,
|
||||
remoteip => $self->session->request->env->{REMOTE_ADDR},
|
||||
challenge => $challenge,
|
||||
|
|
@ -159,9 +159,9 @@ sub toHtml {
|
|||
|
||||
if ($self->session->setting->get('useRecaptcha')) {
|
||||
my $pubKey = $self->session->setting->get('recaptchaPublicKey');
|
||||
my $server = "http://api.recaptcha.net";
|
||||
my $server = "http://www.google.com/recaptcha/api";
|
||||
if ($self->session->request->secure) {
|
||||
$server = "https://api-secure.recaptcha.net";
|
||||
$server = "https://www.google.com/recaptcha/api";
|
||||
}
|
||||
return
|
||||
'<script type="text/javascript" src="' . $server . '/challenge?k=' . $pubKey . '"></script>'
|
||||
|
|
|
|||
43
lib/WebGUI/Macro/AssetProperty.pm
Normal file
43
lib/WebGUI/Macro/AssetProperty.pm
Normal file
|
|
@ -0,0 +1,43 @@
|
|||
package WebGUI::Macro::AssetProperty;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# 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
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
WebGUI::Macro::AssetProperty
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
^AssetProperty(sf76sd8f5s7f5s7618, title);
|
||||
^AssetProperty(root/import, assetId);
|
||||
|
||||
=head2 process( $session, $url_or_assetId, $propertyName )
|
||||
|
||||
Equivalent to calling $asset->get($propertyName)
|
||||
|
||||
=cut
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub process {
|
||||
my ($session, $id, $name) = @_;
|
||||
my $asset = WebGUI::Asset->new($session, $id) if $session->id->valid($id);
|
||||
$asset ||= WebGUI::Asset->newByUrl($session, $id);
|
||||
|
||||
return $asset->get($name) if $asset;
|
||||
|
||||
$session->log->error("Invalid assetId or URL in AssetProperty: $id");
|
||||
return '';
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -11,8 +11,8 @@ package WebGUI::Macro::RenderThingData;
|
|||
#-------------------------------------------------------------------
|
||||
|
||||
use strict;
|
||||
use WebGUI::Group;
|
||||
use WebGUI::Asset::Template;
|
||||
use WebGUI::International;
|
||||
use WebGUI::Asset::Wobject::Thingy;
|
||||
|
||||
=head1 NAME
|
||||
|
|
@ -39,6 +39,8 @@ Optional. Specifies the templateId or template url to use. If omitted, the def
|
|||
#-------------------------------------------------------------------
|
||||
sub process {
|
||||
my ($session, $thingDataUrl, $templateHint ) = @_;
|
||||
my $i18n = WebGUI::International->new($session, 'Macro_RenderThingData');
|
||||
return $i18n->get('no template') if !$templateHint;
|
||||
|
||||
my $uri = URI->new( $thingDataUrl );
|
||||
|
||||
|
|
@ -55,7 +57,6 @@ sub process {
|
|||
my $output = $thing->www_viewThingData( $thingId, $thingDataId, $templateHint );
|
||||
|
||||
# FIX: Temporary solution (broken map due to template rendering <script> tags)
|
||||
return "RenderThingData: Please specify a template." if !$templateHint;
|
||||
return "RenderThingData: Contained bad tags!" if $output =~ /script>/;
|
||||
|
||||
return $output;
|
||||
|
|
|
|||
|
|
@ -343,7 +343,7 @@ sub create {
|
|||
}
|
||||
}
|
||||
}
|
||||
my $from = $headers->{from} || $session->setting->get('comanyName') . " <".$session->setting->get("companyEmail").">";
|
||||
my $from = $headers->{from} || $session->setting->get('companyName') . " <".$session->setting->get("companyEmail").">";
|
||||
my $type = $headers->{contentType} || "multipart/mixed";
|
||||
my $replyTo = $headers->{replyTo} || $session->setting->get("mailReturnPath");
|
||||
|
||||
|
|
|
|||
|
|
@ -986,7 +986,7 @@ sub www_checkout {
|
|||
my $total = $self->calculateTotal;
|
||||
##Handle rounding errors, and checkout immediately if the amount is 0 since
|
||||
##at least the ITransact driver won't accept $0 checkout.
|
||||
if (sprintf('%.2f', $total + $self->calculateShopCreditDeduction($total)) eq '0.00') {
|
||||
if (sprintf('%.2f', abs($total + $self->calculateShopCreditDeduction($total))) eq '0.00') {
|
||||
my $transaction = WebGUI::Shop::Transaction->new({session => $session, cart => $self});
|
||||
$transaction->write;
|
||||
$transaction->completePurchase('zero', 'success', 'success');
|
||||
|
|
@ -1032,9 +1032,6 @@ sub www_lookupPosUser {
|
|||
Updates the cart totals, addresses, shipping driver and payment gateway. If requested, and the
|
||||
cart is ready, calls the www_getCredentials method from the selected payment gateway.
|
||||
|
||||
If the cart total, after taxes, shipping, coupons and shop credit is zero, does the checkout
|
||||
immediately without calling a payment gateway.
|
||||
|
||||
Otherwise, returns the user back to the cart.
|
||||
|
||||
=cut
|
||||
|
|
|
|||
|
|
@ -129,8 +129,13 @@ around BUILDARGS => sub {
|
|||
|
||||
=head2 appendCartVariables ( $var )
|
||||
|
||||
Append the subtotal, shipping, tax, and shop credeductions to a set of template
|
||||
variables.
|
||||
Append the subtotal, shipping, tax, and shop credit deductions to a set of template
|
||||
variables. Returns the modified hashreference of variables.
|
||||
|
||||
=head3 $var
|
||||
|
||||
A hashref. Template variables will be added to it. If $var is not passed, a new
|
||||
hashref is created, and that is returned.
|
||||
|
||||
=cut
|
||||
|
||||
|
|
@ -148,7 +153,7 @@ sub appendCartVariables {
|
|||
$var->{inShopCreditAvailable} = $credit->getSum;
|
||||
$var->{inShopCreditDeduction} = $credit->calculateDeduction($totalPrice);
|
||||
$var->{totalPrice } = $cart->formatCurrency($totalPrice + $var->{inShopCreditDeduction});
|
||||
return $self;
|
||||
return $var;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -259,10 +264,14 @@ sub displayPaymentError {
|
|||
my ($self, $transaction) = @_;
|
||||
my $i18n = WebGUI::International->new($self->session, "PayDriver");
|
||||
my $output = q{<h1>} . $i18n->get('error processing payment') . q{</h1>}
|
||||
. q{<p>} . $i18n->get('error processing payment message') . q{</p>}
|
||||
. q{<p>} . $transaction->get('statusMessage') . q{</p>}
|
||||
. q{<p><a href="?shop=cart;method=checkout">} . $i18n->get( 'try again' ) . q{</a></p>}
|
||||
;
|
||||
. q{<p>} . $i18n->get('error processing payment message') . q{</p>};
|
||||
if ($transaction) {
|
||||
$output .= q{<p>} . $transaction->get('statusMessage') . q{</p>};
|
||||
}
|
||||
else {
|
||||
$output .= q{<p>} . $i18n->get('unable to finish transaction') . q{</p>};
|
||||
}
|
||||
$output .= q{<p><a href="?shop=cart;method=checkout">} . $i18n->get( 'try again' ) . q{</a></p>};
|
||||
return $self->session->style->userStyle($output);
|
||||
}
|
||||
|
||||
|
|
@ -540,7 +549,7 @@ sub processTransaction {
|
|||
$transactionProperties->{ cart } = $cart;
|
||||
$transactionProperties->{ isRecurring } = $cart->requiresRecurringPayment;
|
||||
$transactionProperties->{ session } = $self->session;
|
||||
|
||||
|
||||
# Create a transaction...
|
||||
$transaction = WebGUI::Shop::Transaction->new( $transactionProperties );
|
||||
$transaction->write;
|
||||
|
|
|
|||
|
|
@ -121,7 +121,7 @@ sub processPayment {
|
|||
my $self = shift;
|
||||
# Since we'll have to create a transaction before doing the actual tranasction, we let it fail
|
||||
# initially with a message that it is pending.
|
||||
# Unless the transaction result with _setPaymentStatus the transaction will fail.
|
||||
# Unless the transaction result is updated via _setPaymentStatus the transaction will fail.
|
||||
|
||||
my $success = $self->{_transactionSuccessful} || 0;
|
||||
my $id = $self->{_ogoneId} || undef;
|
||||
|
|
@ -129,7 +129,6 @@ sub processPayment {
|
|||
my $message = $self->{_statusMessage} || 'Waiting for checkout';
|
||||
|
||||
return ( $success, $id, $status, $message );
|
||||
return (0, undef, 1, 'Pending');
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -172,7 +172,7 @@ is a hashref, it will be modified in place.
|
|||
sub payPalForm {
|
||||
my $self = shift;
|
||||
my $args = ref $_[0] eq 'HASH' ? shift : {@_};
|
||||
$args->{VERSION} = '58.0';
|
||||
$args->{VERSION} = '2.3';
|
||||
$args->{USER} = $self->user;
|
||||
$args->{PWD} = $self->password;
|
||||
$args->{SIGNATURE} = $self->signature;
|
||||
|
|
@ -206,7 +206,6 @@ PayPal API spit back.
|
|||
|
||||
sub processPayment {
|
||||
my ( $self, $transaction ) = @_;
|
||||
my ( $isSuccess, $gatewayCode, $status, $message );
|
||||
|
||||
my $form = $self->payPalForm(
|
||||
METHOD => 'DoExpressCheckoutPayment',
|
||||
|
|
@ -317,6 +316,7 @@ sub www_sendToPayPal {
|
|||
if ($params) {
|
||||
unless ( $params->{ACK} =~ /^Success/ ) {
|
||||
my $log = sprintf "Paypal error: Request/response below: %s\n%s\n", Dumper($form), Dumper($params);
|
||||
$log .= $response->request->as_string;
|
||||
$session->log->error($log);
|
||||
$error = $i18n->get('internal paypal error');
|
||||
}
|
||||
|
|
|
|||
|
|
@ -20,6 +20,8 @@ use URI;
|
|||
use URI::Escape;
|
||||
use LWP::UserAgent;
|
||||
use Readonly;
|
||||
use WebGUI::Shop::Transaction;
|
||||
|
||||
Readonly my $I18N => 'PayDriver_PayPalStd';
|
||||
|
||||
use Moose;
|
||||
|
|
@ -145,7 +147,9 @@ sub getButton {
|
|||
|
||||
# All the API stuff is done in paymentVariables; we'll just turn it into
|
||||
# hidden form fields here
|
||||
my $v = $self->paymentVariables;
|
||||
my $v = $self->paymentVariables;
|
||||
my $transaction = $self->processTransaction();
|
||||
$v->{custom} = $transaction->getId;
|
||||
my $fields = join "\n", map {
|
||||
WebGUI::Form::hidden( $session, { name => $_, value => $v->{$_} } )
|
||||
} (keys %$v);
|
||||
|
|
@ -177,6 +181,38 @@ sub getButton {
|
|||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getPayPalParams
|
||||
|
||||
Using the tx form variable, dial up PayPal and ask them for details about the transaction.
|
||||
Return a hashreference of name/value pairs, along with PAYPAL_TX, the transactionId and
|
||||
PAYPAL_REQUEST_STATUS, the HTTP code from the response from PayPal.
|
||||
|
||||
=cut
|
||||
|
||||
sub getPayPalParams {
|
||||
my $self = shift;
|
||||
my $session = $self->session;
|
||||
# instead of relying on what was passed to us.
|
||||
return $self->{_params} if $self->{_params};
|
||||
my $tx = $session->form->process('tx');
|
||||
|
||||
my %form = (
|
||||
cmd => '_notify-synch',
|
||||
tx => $tx,
|
||||
at => $self->identityToken,
|
||||
);
|
||||
my $response = LWP::UserAgent->new->post($self->payPalUrl, \%form);
|
||||
my ($status, @lines) = split("\n", $response->content);
|
||||
my %params = map { split /=/ }
|
||||
map { uri_unescape($_) } @lines;
|
||||
$params{PAYPAL_REQUEST_STATUS} = $status;
|
||||
$params{PAYPAL_TX} = $tx;
|
||||
$self->{_params} = \%params;
|
||||
return $self->{_params};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 paymentVariables
|
||||
|
||||
Returns a hashref of the payment variables to be used as hidden form fields
|
||||
|
|
@ -225,9 +261,9 @@ sub paymentVariables {
|
|||
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');
|
||||
$params{"quantity_$n"} = $item->quantity;
|
||||
$params{"item_name_$n"} = $item->configuredTitle;
|
||||
$params{"item_number_$n"} = $item->itemId;
|
||||
}
|
||||
|
||||
return \%params;
|
||||
|
|
@ -258,49 +294,49 @@ passed to us.
|
|||
=cut
|
||||
|
||||
sub processPayment {
|
||||
my ( $self, $transaction ) = @_;
|
||||
my $session = $self->session;
|
||||
my ( $self ) = @_;
|
||||
|
||||
# To prevent a spoofed post to this url, we'll get the info from paypal
|
||||
# instead of relying on what was passed to us.
|
||||
my $tx = $session->form->process('tx');
|
||||
my $success = $self->{_transactionSuccessful} || 0;
|
||||
my $id = $self->{_tx} || undef;
|
||||
my $status = $self->{_statusCode} || undef;
|
||||
my $message = $self->{_statusMessage} || 'Waiting for checkout';
|
||||
|
||||
my %form = (
|
||||
cmd => '_notify-synch',
|
||||
tx => $tx,
|
||||
at => $self->identityToken,
|
||||
);
|
||||
my $response = LWP::UserAgent->new->post($self->payPalUrl, \%form);
|
||||
my ($status, @lines) = split("\n", $response->content);
|
||||
my %params = map { split /=/ }
|
||||
map { uri_unescape($_) } @lines;
|
||||
return ( $success, $id, $status, $message );
|
||||
}
|
||||
|
||||
if ($status =~ /FAIL/) {
|
||||
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 );
|
||||
}
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
# Make sure the transaction is for this cart to prevent spoofing
|
||||
my $cartId = $self->getCart->getId;
|
||||
if ($params{custom} ne $cartId) {
|
||||
my $user = $session->user;
|
||||
my $name = $user->username;
|
||||
my $id = $user->userId;
|
||||
$session->log->warn("SECURITY WARNING: $name (id: $id) tried to " .
|
||||
"checkout cart $cartId with PayPal transaction $tx, which " .
|
||||
"did not match the cart we passed ($params{custom})");
|
||||
=head2 _setPaymentStatus ( transactionSuccessful, ogoneId, statusCode, statusMessage )
|
||||
|
||||
my $i18n = WebGUI::International->new( $session, $I18N );
|
||||
return ( 0, $tx, 'FAIL', $i18n->get('cart transaction mismatch') );
|
||||
}
|
||||
Update the internal status of a payment, so that the next call to processPayment
|
||||
returns the correct data.
|
||||
|
||||
$status = $params{payment_status};
|
||||
return ( 1, $tx, $status, $status, $status );
|
||||
} ## end sub processPayment
|
||||
=head3 transactionSuccessful
|
||||
|
||||
A boolean indicating whether or not the payment was successful.
|
||||
|
||||
=head3 tx
|
||||
|
||||
The PayPal issued transaction ID.
|
||||
|
||||
=head3 statusCode
|
||||
|
||||
The PayPal issued status code.
|
||||
|
||||
=head3 statusMessage
|
||||
|
||||
An updates status message
|
||||
|
||||
=cut
|
||||
|
||||
sub _setPaymentStatus {
|
||||
my ( $self ) = @_;
|
||||
|
||||
$self->{_transactionSuccessful} = shift || 0;
|
||||
$self->{_tx} = shift || undef;
|
||||
$self->{_statusCode} = shift || undef;
|
||||
$self->{_statusMessage} = shift || undef;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
|
|
@ -311,11 +347,26 @@ Where paypal comes back to when a transaction has been completed.
|
|||
=cut
|
||||
|
||||
sub www_completeTransaction {
|
||||
my $self = shift;
|
||||
my $self = shift;
|
||||
my $session = $self->session;
|
||||
|
||||
my $transaction = $self->processTransaction;
|
||||
my $params = $self->getPayPalParams;
|
||||
if ($params->{PAYPAL_REQUEST_STATUS} =~ /FAIL/) {
|
||||
my $message = "<table><tr><th>Field</th><th>Value</th></tr>\n";
|
||||
foreach my $key ( keys %{ $params } ) {
|
||||
$message .= sprintf "<tr><td>%s</td><td>%s</td></tr>\n", $key, $params->{key};
|
||||
}
|
||||
$message .= "</table>\n";
|
||||
return ( 0, $params->{PAYPAL_TX}, $params->{PAYPAL_REQUEST_STATUS}, $message );
|
||||
}
|
||||
my $transaction = eval { WebGUI::Shop::Transaction->new($session, $params->{custom}); };
|
||||
if (my $e = Exception::Class->caught) {
|
||||
return $self->displayPaymentError();
|
||||
}
|
||||
$self->_setPaymentStatus(1, $params->{PAYPAL_TX}, $params->{payment_status}, 'Complete');
|
||||
$self->processTransaction($transaction);
|
||||
|
||||
return $transaction->get('isSuccessful')
|
||||
return $transaction->isSuccessful
|
||||
? $transaction->thankYou
|
||||
: $self->displayPaymentError($transaction);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -293,10 +293,16 @@ sub _mine_cart {
|
|||
$self->paymentDriverId($pay->getId);
|
||||
$self->paymentDriverLabel($pay->get('label'));
|
||||
|
||||
##Clear out current transaction items before adding new ones.
|
||||
foreach my $item (@{$self->getItems}) {
|
||||
$item->delete;
|
||||
}
|
||||
foreach my $item (@{$cart->getItems}) {
|
||||
$self->addItem({item=>$item});
|
||||
}
|
||||
|
||||
$self->isRecurring( $cart->requiresRecurringPayment );
|
||||
|
||||
$self->cashierUserId($cart->getPosUser->userId);
|
||||
|
||||
}
|
||||
|
|
|
|||
|
|
@ -676,14 +676,9 @@ sub start {
|
|||
# hand off the workflow to spectre
|
||||
$log->info('Could not complete workflow instance '.$self->getId.' in realtime, handing off to Spectre.');
|
||||
my $spectre = WebGUI::Workflow::Spectre->new($self->session);
|
||||
$spectre->notify("workflow/addInstance", {cookieName=>$self->session->config->getCookieName, gateway=>$self->session->request->base->path, sitename=>$self->session->config->get("sitename")->[0], instanceId=>$self->getId, priority=>$self->{_data}{priority}});
|
||||
my $success = $spectre->notify("workflow/addInstance", {cookieName=>$self->session->config->getCookieName, gateway=>$self->session->config->get("gateway"), sitename=>$self->session->config->get("sitename")->[0], instanceId=>$self->getId, priority=>$self->{_data}{priority}});
|
||||
|
||||
my $spectreTest = WebGUI::Operation::Spectre::spectreTest($self->session);
|
||||
if($spectreTest ne "success"){
|
||||
return WebGUI::International->new($self->session, "Macro_SpectreCheck")->get($spectreTest);
|
||||
}
|
||||
|
||||
return undef;
|
||||
return $success ? undef : 'Could not connect to spectre';
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
|
|||
|
|
@ -41,7 +41,8 @@ These methods are available from this class:
|
|||
|
||||
=head2 notify ( module, params )
|
||||
|
||||
Sends a message to Spectre.
|
||||
Sends a message to Spectre. Returns true iff the message was successfully
|
||||
sent.
|
||||
|
||||
=head3 module
|
||||
|
||||
|
|
@ -65,15 +66,13 @@ sub notify {
|
|||
timeout=>10
|
||||
);
|
||||
if (defined $remote) {
|
||||
my $result = $remote->post($module, $params);
|
||||
unless (defined $result) {
|
||||
$log->warn("Couldn't send command to Spectre because ".$POE::Component::IKC::ClientLite::error);
|
||||
}
|
||||
$remote->disconnect;
|
||||
undef $remote;
|
||||
my $result = $remote->post($module, $params);
|
||||
return 1 if defined $result;
|
||||
$log->warn("Couldn't send command to Spectre because ".$POE::Component::IKC::ClientLite::error);
|
||||
} else {
|
||||
$log->warn("Couldn't connect to Spectre because ".$POE::Component::IKC::ClientLite::error);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -242,8 +242,8 @@ our $I18N = {
|
|||
},
|
||||
|
||||
'templateIdEditPoint' => {
|
||||
message => "The GUID of the template for addding or editing a point.",
|
||||
lastUpdated => 0,
|
||||
message => "The GUID of the template for adding or editing a point.",
|
||||
lastUpdated => 1304717948,
|
||||
context => "template variable help",
|
||||
},
|
||||
|
||||
|
|
|
|||
18
lib/WebGUI/i18n/English/Macro_RenderThingData.pm
Normal file
18
lib/WebGUI/i18n/English/Macro_RenderThingData.pm
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
package WebGUI::i18n::English::Macro_RenderThingData;
|
||||
use strict;
|
||||
|
||||
our $I18N = {
|
||||
|
||||
'bad tags' => {
|
||||
message => q||,
|
||||
lastUpdated => 1306275259,
|
||||
},
|
||||
|
||||
'no template' => {
|
||||
message => q|RenderThingData: Please specify a template.|,
|
||||
lastUpdated => 1149177662,
|
||||
},
|
||||
|
||||
};
|
||||
|
||||
1;
|
||||
|
|
@ -124,6 +124,12 @@ our $I18N = {
|
|||
context => q|Name of the base Payment Driver|,
|
||||
},
|
||||
|
||||
'unable to finish transaction' => {
|
||||
message => q|We are unable to lookup the transaction to finish checking out.|,
|
||||
lastUpdated => 0,
|
||||
context => q|Error message when the transaction cannot be looked up.|,
|
||||
},
|
||||
|
||||
};
|
||||
|
||||
1;
|
||||
|
|
|
|||
|
|
@ -43,7 +43,7 @@ our $I18N = {
|
|||
context => q{The name of the payment driver},
|
||||
},
|
||||
'password' => {
|
||||
message => q{Password},
|
||||
message => q{API Password},
|
||||
lastUpdated => 1247254156,
|
||||
},
|
||||
'password help' => {
|
||||
|
|
@ -88,7 +88,7 @@ our $I18N = {
|
|||
lastUpdated => 1247253981,
|
||||
},
|
||||
'user' => {
|
||||
message => q{Username},
|
||||
message => q{API Username},
|
||||
lastUpdated => 1247254097,
|
||||
},
|
||||
'user help' => {
|
||||
|
|
@ -104,20 +104,9 @@ our $I18N = {
|
|||
'summary template help' => {
|
||||
message => q|Pick a template to display the screen where the user confirms the cart summary info and agrees to pay.|,
|
||||
lastUpdated => 0,
|
||||
context => q|Hover help for the summary template field in the configuration form of the Cash module.|
|
||||
context => q|Hover help for the summary template field in the configuration form.|
|
||||
},
|
||||
|
||||
'password' => {
|
||||
message => q|Password|,
|
||||
lastUpdated => 0,
|
||||
context => q|Form label in the configuration form of the iTransact module.|
|
||||
},
|
||||
'password help' => {
|
||||
message => q|The password for your ITransact account.|,
|
||||
lastUpdated => 0,
|
||||
context => q|Hover help for the password field in the configuration form of the iTransact module.|
|
||||
},
|
||||
|
||||
'Pay' => {
|
||||
message => q|Pay|,
|
||||
lastUpdated => 0,
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue