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

Merge with HEAD, 10472

Browse source
This commit is contained in:
Colin Kuskie 2009-04-24 17:12:17 +00:00
commit 19f703dc9b
102 changed files with 5700 additions and 2269 deletions
Download patch file Download diff file Expand all files Collapse all files

72
lib/WebGUI/Account.pm
View file

@ -29,10 +29,78 @@ These subroutines are available from this package:
=cut
#-------------------------------------------------------------------
=head2 session ()
Returns a reference to the current WebGUI::Session object.
=cut
readonly session => my %session;
#-------------------------------------------------------------------
=head2 module ()
Returns the string representation of the name of the last Account module called.
=cut
readonly module => my %module;
#-------------------------------------------------------------------
=head2 method ()
Returns the string representation of the name of the last method called on the module().
=cut
public method => my %method;
#-------------------------------------------------------------------
=head2 uid ( [ userId ] )
Returns the userId of the WebGUI::User who's account is being interacted with.
=head3 userId
Optionally set the userId. Normally this is never needed, but is provided for completeness.
=cut
public uid => my %uid;
#-------------------------------------------------------------------
=head2 bare ( [ flag ] )
Returns whether or not the Account system should return a method's content
without the layout and style templates. This would normally be used for
returning JSON or XML data out of the account system.
=head3 flag
Optionally set bare to be true, or false.
=cut
public bare => my %bare;
#-------------------------------------------------------------------
=head2 store ( [ hashRef ] )
Returns a hash reference attached to this account object that contains arbitrary data.
=head2 hashRef
A hash reference of data to store.
=cut
public store => my %store; #This is an all purpose hash to store stuff in: $self->store->{something} = "something"
#-------------------------------------------------------------------
@ -53,6 +121,7 @@ sub appendCommonVars {
my $session = $self->session;
my $user = $self->getUser;
$var->{'profile_user_id' } = $user->userId;
$var->{'user_full_name' } = $user->getWholeName;
$var->{'user_member_since'} = $user->dateCreated;
$var->{'view_profile_url' } = $user->getProfileUrl;
@ -139,6 +208,9 @@ sub displayContent {
my $noStyle = shift;
my $session = $self->session;
##Don't do any templating if we're sending back data like JSON or XML.
return $content if $self->bare;
#Wrap content into the layout
my $var = {};
$var->{content} = $content;

4
lib/WebGUI/Account/Friends.pm
View file

@ -379,7 +379,7 @@ sub www_sendFriendsRequest {
my $self = shift;
my $session = $self->session;
my $var = {};
my $uid = $self->uid;
my $uid = $self->uid || $session->form->get('uid');
my $user = WebGUI::User->new($session,$uid);
my $i18n = WebGUI::International->new($session,'Account_Friends');
@ -538,7 +538,7 @@ sub www_view {
# TODO Move this into a sub that can be more easily overridden
$hash->{'friend_full_name' } = $friend->getWholeName;
$hash->{'isViewable' } = $friend->profileIsViewable;
$hash->{'friend_id' } = $friend->userId;
$hash->{'friend_id' } = $friendId;
$hash->{'friend_member_since' } = $friend->dateCreated;
$hash->{'friend_member_since_human'} = $session->datetime->epochToHuman($friend->dateCreated);
$hash->{'friend_isOnline' } = $friend->isOnline;

26
lib/WebGUI/Account/Shop.pm
View file

@ -53,6 +53,9 @@ sub appendCommonVars {
$var->{ 'view_sales_url' } = $self->getUrl( 'module=shop;do=viewSales' );
$var->{ 'viewSalesIsActive' } = $method eq 'viewSales';
$var->{ 'manage_tax_url' } = $self->getUrl( 'module=shop;do=manageTaxData' );
$var->{ 'manageTaxIsActive' } = $method eq 'manageTaxData';
}
#-------------------------------------------------------------------
@ -201,6 +204,17 @@ sub www_managePurchases {
return $self->processTemplate($var,$session->setting->get("shopMyPurchasesTemplateId"));
}
#-------------------------------------------------------------------
sub www_manageTaxData {
my $self = shift;
my $session = $self->session;
my $userScreen = WebGUI::Shop::Tax->new( $session )->getDriver->getUserScreen;
return $userScreen;
}
#-------------------------------------------------------------------
=head2 www_view ( )
@ -324,12 +338,24 @@ sub www_viewTransaction {
phoneNumber => $item->get('shippingPhoneNumber'),
});
}
# Post purchase actions
my $actionsLoop = [];
my $actions = $item->getSku->getPostPurchaseActions( $item );
for my $label ( keys %{$actions} ) {
push @{$actionsLoop}, {
label => $label,
url => $actions->{$label},
}
}
push @items, {
%{$item->get},
viewItemUrl => $url->page('shop=transaction;method=viewItem;transactionId='.$transaction->getId.';itemId='.$item->getId),
price => sprintf("%.2f", $item->get('price')),
itemShippingAddress => $address,
orderStatus => $i18n->get($item->get('orderStatus')),
actionsLoop => $actionsLoop,
};
}
$var{items} = \@items;

23
lib/WebGUI/Asset.pm
View file

@ -2165,7 +2165,15 @@ The content to wrap up.
sub processStyle {
my ($self, $output) = @_;
$self->session->style->setRawHeadTags($self->getExtraHeadTags);
my $session = $self->session;
my $style = $session->style;
$style->setRawHeadTags($self->getExtraHeadTags);
if ($self->get('synopsis')) {
$style->setMeta({
name => 'Description',
content => $self->get('synopsis'),
});
}
return $output;
}
@ -2674,12 +2682,7 @@ sub www_editSave {
# Handle "saveAndReturn" button
if ( $self->session->form->process( "saveAndReturn" ) ne "" ) {
if ($isNewAsset) {
return $object->www_edit;
}
else {
return $self->www_edit;
}
return $object->www_edit;
}
# Handle "proceed" form parameter
@ -2739,12 +2742,6 @@ sub www_view {
return $check if (defined $check);
# if all else fails
if ($self->get('synopsis')) {
$self->session->style->setMeta({
name => 'Description',
content => $self->get('synopsis'),
});
}
$self->prepareView;
$self->session->output->print($self->view);
return undef;

50
lib/WebGUI/Asset/MatrixListing.pm
View file

@ -247,7 +247,11 @@ By specifying this method, you activate this feature.
sub getAutoCommitWorkflowId {
my $self = shift;
return $self->getParent->get("submissionApprovalWorkflowId");
if($self->session->form->process("assetId") eq "new"){
return $self->getParent->get("submissionApprovalWorkflowId");
}
return undef;
}
#-------------------------------------------------------------------
@ -312,6 +316,19 @@ sub getEditForm {
hoverHelp =>$i18n->get('maintainer description'),
);
}
else{
my $userId;
if ($func eq "add"){
$userId = $session->user->userId;
}
else{
$userId = $self->get('ownerUserId');
}
$form->hidden(
-name =>'ownerUserId',
-value =>$userId,
);
}
$form->text(
-name =>'version',
-defaultValue =>undef,
@ -492,6 +509,34 @@ sub processPropertiesFromFormPost {
}
$self->update({score => $score});
if ( $self->get('screenshots') ) {
my $fileObject = WebGUI::Form::File->new($self->session,{ value=>$self->get('screenshots') });
my $storage = $fileObject->getStorageLocation;
my @files;
@files = @{ $storage->getFiles } if (defined $storage);
foreach my $file (@files) {
unless ($file =~ m/^thumb-/){
my ($resizeWidth,$resizeHeight);
my ($width, $height) = $storage->getSizeInPixels($file);
my $maxWidth = $self->getParent->get('maxScreenshotWidth');
my $maxHeight = $self->getParent->get('maxScreenshotHeight');
if ($width > $maxWidth){
my $newHeight = $height * ($maxWidth / $width);
if ($newHeight > $maxHeight){
# Heigth requires more resizing so use maxHeight
$storage->resize($file, 0, $maxHeight);
}
else{
$storage->resize($file, $maxWidth);
}
}
elsif($height > $maxHeight){
$storage->resize($file, 0, $maxHeight);
}
}
}
}
$self->requestAutoCommit;
return undef;
}
@ -962,6 +1007,7 @@ sub www_getScreenshots {
@files = @{ $storage->getFiles } if (defined $storage);
foreach my $file (@files) {
unless ($file =~ m/^thumb-/){
my ($width, $height) = $storage->getSizeInPixels($file);
my $thumb = 'thumb-'.$file;
$xml .= "
<slide>
@ -970,6 +1016,8 @@ sub www_getScreenshots {
<image_source>".$storage->getUrl($file)."</image_source>
<duration>5</duration>
<thumb_source>".$storage->getUrl($thumb)."</thumb_source>
<width>".$width."</width>
<height>".$height."</height>
</slide>
";
}

1
lib/WebGUI/Asset/Post.pm
View file

@ -970,6 +970,7 @@ sub postProcess {
my $spamStopWords = $self->session->config->get('spamStopWords');
if (ref $spamStopWords eq 'ARRAY') {
my $spamRegex = join('|',@{$spamStopWords});
$spamRegex =~ s/\s/\\ /g;
if ($data{content} =~ m/$spamRegex/xmsi) {
$data{skipNotification} = 1;
$self->trash;

117
lib/WebGUI/Asset/Sku.pm
View file

@ -20,7 +20,7 @@ use base 'WebGUI::Asset';
use WebGUI::International;
use WebGUI::Inbox;
use WebGUI::Shop::Cart;
use JSON qw{ from_json to_json };
=head1 NAME
@ -41,7 +41,6 @@ use WebGUI::Asset::Sku;
$hashRef = $self->getOptions;
$integer = $self->getMaxAllowedInCart;
$float = $self->getPrice;
$float = $self->getTaxRate;
$boolean = $self->isShippingRequired;
$html = $self->processStyle($output);
@ -102,6 +101,7 @@ sub definition {
my $definition = shift;
my %properties;
tie %properties, 'Tie::IxHash';
my $i18n = WebGUI::International->new($session, "Asset_Sku");
%properties = (
description => {
@ -125,20 +125,6 @@ sub definition {
label => $i18n->get("display title"),
hoverHelp => $i18n->get("display title help")
},
overrideTaxRate => {
tab => "shop",
fieldType => "yesNo",
defaultValue => 0,
label => $i18n->get("override tax rate"),
hoverHelp => $i18n->get("override tax rate help")
},
taxRateOverride => {
tab => "shop",
fieldType => "float",
defaultValue => 0.00,
label => $i18n->get("tax rate override"),
hoverHelp => $i18n->get("tax rate override help")
},
vendorId => {
tab => "shop",
fieldType => "vendor",
@ -146,6 +132,11 @@ sub definition {
label => $i18n->get("vendor"),
hoverHelp => $i18n->get("vendor help")
},
taxConfiguration => {
noFormPost => 1,
fieldType => 'hidden',
defaultValue => '{}',
},
);
push(@{$definition}, {
assetName=>$i18n->get('assetName'),
@ -206,6 +197,31 @@ sub getConfiguredTitle {
return $self->getTitle;
}
#-------------------------------------------------------------------
sub getEditForm {
my $self = shift;
my $session = $self->session;
my $tabform = $self->SUPER::getEditForm;
# Let the tax system add the form fields that are required by the active tax plugin for configuring the sku tax.
# WebGUI::Shop::Tax->new( $session )->appendSkuForm( $self->getId, $tabform->getTab('shop') );
my $taxDriver = WebGUI::Shop::Tax->getDriver( $session );
my $definition = $taxDriver->skuFormDefinition;
my $config = $self->getTaxConfiguration( $taxDriver->className );
my $shop = $tabform->getTab( 'shop' );
foreach my $fieldName ( keys %{ $definition } ) {
$shop->dynamicField(
%{ $definition->{ $fieldName } },
name => $fieldName,
value => $config->{ $fieldName },
);
}
return $tabform;
}
#-------------------------------------------------------------------
@ -264,6 +280,22 @@ sub getPrice {
#-------------------------------------------------------------------
=head2 getPostPurchaseActions ( item )
Get a hash reference of LABEL => URL pairs of actions we can do on
this Sku after it is purchased. These will show up in the Transaction
screen. C<item> is the WebGUI::Shop::TransactionItem that was
purchased.
=cut
sub getPostPurchaseActions {
my ( $self, $item ) = @_;
return {};
}
#-------------------------------------------------------------------
=head2 getQuantityAvailable ( )
Returns 99999999. Needs to be overriden by subclasses. Tells the commerce system how many of this item is on hand.
@ -288,16 +320,17 @@ sub getRecurInterval {
}
#-------------------------------------------------------------------
sub getTaxConfiguration {
my $self = shift;
my $namespace = shift;
=head2 getTaxRate ( )
my $configs = eval { from_json( $self->getValue('taxConfiguration') ) };
if ($@) {
$self->session->log->error( 'Tax configuration of asset ' . $self->getId . ' appears to be corrupt. :' . $@ );
return undef;
}
Returns undef unless the "Override tax rate?" switch is set to yes. If it is, then it returns the value of the "Tax Rate Override" field.
=cut
sub getTaxRate {
my $self = shift;
return ($self->get("overrideTaxRate")) ? $self->get("taxRateOverride") : undef;
return $configs->{ $namespace }
}
#-------------------------------------------------------------------
@ -528,6 +561,20 @@ sub onRemoveFromCart {
return undef;
}
#-------------------------------------------------------------------
sub processPropertiesFromFormPost {
my $self = shift;
my $output = $self->SUPER::processPropertiesFromFormPost( @_ );
my $taxDriver = WebGUI::Shop::Tax->new( $self->session )->getDriver;
$self->session->log->fatal( 'Could not instanciate tax driver.' ) unless $taxDriver;
$self->setTaxConfiguration( $taxDriver->className, $taxDriver->processSkuFormPost );
return $output;
}
#-------------------------------------------------------------------
=head2 processStyle ( output )
@ -546,6 +593,28 @@ sub processStyle {
return $self->getParent->processStyle($output);
}
#-------------------------------------------------------------------
sub setTaxConfiguration {
my $self = shift;
my $namespace = shift;
my $configuration = shift;
# Fetch current tax configurations
my $configs = eval { from_json( $self->getValue('taxConfiguration') ) };
if ($@) {
$self->session->log->error( 'Tax configuration of asset ' . $self->getId . ' is corrupt.' );
return undef;
}
# Apply the new configuration for the given driver...
$configs->{ $namespace } = $configuration;
# ...and persist it to the db.
$self->update( {
taxConfiguration => to_json( $configs ),
} );
}
#-------------------------------------------------------------------
=head2 www_view ( )

708
lib/WebGUI/Asset/Sku/ThingyRecord.pm Normal file
View file

@ -0,0 +1,708 @@
package WebGUI::Asset::Sku::ThingyRecord;
=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
use strict;
use Tie::IxHash;
use base 'WebGUI::Asset::Sku';
use WebGUI::Utility;
# Collateral data class... very long name. Zoffix eat your heart out.
my $RECORD_CLASS = 'WebGUI::AssetCollateral::Sku::ThingyRecord::Record';
=head1 NAME
Package WebGUI::Asset::Sku::ThingyRecord
=head1 DESCRIPTION
Purchase a record in a thingy.
=head1 SYNOPSIS
use WebGUI::Asset::ThingyRecord;
=head1 METHODS
These methods are available from this class:
=cut
#-------------------------------------------------------------------
=head2 definition ( session, definition )
=head3 session
=head3 definition
A hash reference passed in from a subclass definition.
=cut
sub definition {
my $class = shift;
my $session = shift;
my $definition = shift;
my $i18n = WebGUI::International->new( $session, "Asset_ThingyRecord" );
tie my %properties, 'Tie::IxHash', (
templateIdView => {
tab => "display",
fieldType => "template",
namespace => "ThingyRecord/View",
label => $i18n->get('templateIdView label'),
hoverHelp => $i18n->get('templateIdView description'),
},
thingId => {
tab => "properties",
fieldType => "selectBox",
options => $class->getThingOptions($session),
label => $i18n->get('thingId label'),
hoverHelp => $i18n->get('thingId description'),
extras => q{onchange="WebGUI.ThingyRecord.getThingFields(this.options[this.selectedIndex].value,'thingFields_formId')"},
},
thingFields => {
tab => "properties",
fieldType => "selectList",
options => {}, # populated by ajax call
label => $i18n->get('thingFields label'),
hoverHelp => $i18n->get('thingFields description'),
},
thankYouText => {
tab => "properties",
fieldType => "HTMLArea",
defaultValue=> $i18n->get('default thank you message','Asset_Product') . " ^ViewCart;",
label => $i18n->get("thank you message",'Asset_Product'),
hoverHelp => $i18n->get("thank you message help",'Asset_Product'),
},
price => {
tab => "properties",
fieldType => "float",
label => $i18n->get('10',"Asset_Product"), #Price
hoverHelp => $i18n->get('price','Asset_Product'),
},
duration => {
tab => "properties",
fieldType => "interval",
defaultValue=> 60*60*24*7, # One week
label => $i18n->get('duration label'),
hoverHelp => $i18n->get('duration description'),
},
);
push @{$definition}, {
assetName => $i18n->get('assetName'),
icon => 'ThingyRecord.gif',
autoGenerateForms => 1,
tableName => 'ThingyRecord',
className => __PACKAGE__,
properties => \%properties,
};
return $class->SUPER::definition( $session, $definition );
} ## end sub definition
#----------------------------------------------------------------------------
=head2 appendVarsEditRecord ( var, recordId )
Get the template variables for the form to edit the record. Does not include
the header or footer!
=cut
sub appendVarsEditRecord {
my ( $self, $var, $recordId ) = @_;
my $session = $self->session;
my $thingy = $self->getThingy;
my $record = {};
if ( $recordId ) {
# Get an existing record
$record = $self->getThingRecord( $self->get('thingId'), $recordId );
if ( !%$record ) { # Record is hidden
$record = JSON->new->decode(
$RECORD_CLASS->new( $session, $recordId )->get('fields')
);
}
}
my $fields = $self->getThingFields( $self->get('thingId') );
my @allowed = split "\n", $self->get('thingFields');
for my $field ( @{$fields} ) {
next unless grep { $_ eq $field->{fieldId} } @allowed;
$field->{value} = $record->{'field_'.$field->{fieldId}} || $field->{defaultValue};
my %fieldProperties = (
"input" => $thingy->getFormElement($field),
"value" => $thingy->getFieldValue($field->{value}, $field),
"label" => $field->{label},
"isHidden" => ($field->{status} eq 'hidden'),
"isVisible" => ($field->{status} eq "visible"),
"isRequired" => ($field->{status} eq "required"),
"pretext" => $field->{pretext},
"subtext" => $field->{subtext},
);
push @{$var->{form_fields}}, {
map { "field_" . $_ => $fieldProperties{$_} } keys %fieldProperties
};
# Add a way to get the field outside of the loop
# TODO
}
return $var;
}
#-------------------------------------------------------------------
=head2 deleteThingRecord ( thingId, recordId )
Delete a record from a thing
=cut
sub deleteThingRecord {
my ( $self, $thingId, $recordId ) = @_;
my $db = $self->session->db;
my $dbh = $self->session->db->dbh;
my $tableName = $dbh->quote_identifier( 'Thingy_' . $thingId );
$db->write(
"DELETE FROM $tableName WHERE thingDataId=?",
[$recordId]
);
}
#-------------------------------------------------------------------
=head2 getEditForm ( )
Add the javascript needed for the edit form
=cut
sub getEditForm {
my ( $self ) = @_;
$self->session->style->setScript(
$self->session->url->extras('yui/build/yahoo-dom-event/yahoo-dom-event.js'),
{ type => "text/javascript" },
);
$self->session->style->setScript(
$self->session->url->extras('yui/build/connection/connection-min.js'),
{ type => "text/javascript" },
);
$self->session->style->setScript(
$self->session->url->extras('yui/build/json/json-min.js'),
{ type => "text/javascript" },
);
$self->session->style->setScript(
$self->session->url->extras('yui-webgui/build/thingyRecord/thingyRecord.js'),
{ type => "text/javascript" },
);
return $self->SUPER::getEditForm;
}
#----------------------------------------------------------------------------
=head2 getMaxAllowedInCart ( )
One only!
=cut
sub getMaxAllowedInCart {
my ( $self ) = @_;
return 1;
}
#----------------------------------------------------------------------------
=head2 getPostPurchaseActions ( item )
Return a hash reference of "label" => "url" to do things with this item after
it is purchased. C<item> is the WebGUI::Shop::TransactionItem for this item
=cut
sub getPostPurchaseActions {
my ( $self, $item ) = @_;
my $session = $self->session;
my $opts = $self->SUPER::getPostPurchaseActions();
my $i18n = WebGUI::International->new( $session, "Asset_ThingyRecord" );
my $recordId = $item->get('options')->{recordId};
$opts->{ $i18n->get('renew') }
= $self->getUrl('func=renew;recordId='.$recordId);
$opts->{ $i18n->get('575', 'WebGUI') } # edit
= $self->getUrl('func=editRecord;recordid='.$recordId);
return $opts;
}
#----------------------------------------------------------------------------
=head2 getPrice ( )
Get the price
=cut
sub getPrice {
my ( $self ) = @_;
return $self->get('price');
}
#----------------------------------------------------------------------------
=head2 getTemplateVars ( )
Get common template vars for this asset.
=cut
sub getTemplateVars {
my $self = shift;
my $var = $self->get;
$var->{ url } = $self->getUrl;
return $var;
}
#----------------------------------------------------------------------------
=head2 getThingFields ( thingId )
Get the fields for a thing.
=cut
sub getThingFields {
my ( $self, $thingId ) = @_;
my $fields = $self->session->db->buildArrayRefOfHashRefs(
'SELECT * FROM Thingy_fields WHERE thingId = ? ORDER BY sequenceNumber',
[$thingId]
);
return $fields;
}
#----------------------------------------------------------------------------
=head2 getThingOptions ( session )
Get all the thingys and all the things in them.
=cut
sub getThingOptions {
my ( $class, $session ) = @_;
tie my %options, 'Tie::IxHash', ( "" => "" );
my $thingyIter = WebGUI::Asset->getRoot( $session )
->getLineageIterator( ['descendants'], {
includeOnlyClasses => ['WebGUI::Asset::Wobject::Thingy'],
} );
while ( my $thingy = $thingyIter->() ) {
tie my %things, 'Tie::IxHash', (
$session->db->buildHash(
"SELECT thingId, label FROM Thingy_things WHERE assetId=?",
[$thingy->getId]
)
);
$options{$thingy->get('title')} = \%things;
}
return \%options;
}
#----------------------------------------------------------------------------
=head2 getThingRecord ( thingId, recordId )
Get a row of data from a thing. Returns a hashref
=cut
sub getThingRecord {
my ( $self, $thingId, $recordId ) = @_;
my $table = $self->session->db->dbh->quote_identifier( "Thingy_" . $thingId );
return $self->session->db->quickHashRef(
"SELECT * FROM " . $table . " WHERE thingDataId=?",
[$recordId]
);
}
#----------------------------------------------------------------------------
=head2 getThingy ( )
Get the thingy associated with this ThingyRecord
=cut
sub getThingy {
my ( $self ) = @_;
my $thingyId = $self->session->db->quickScalar(
"SELECT assetId FROM Thingy_things WHERE thingId=?",
[$self->get('thingId')],
);
return WebGUI::Asset->newByDynamicClass( $self->session, $thingyId );
}
#-------------------------------------------------------------------
=head2 onCompletePurchase ( )
Purchase completed, add the record.
=cut
sub onCompletePurchase {
my ( $self, $item ) = @_;
my $option = $self->getOptions;
my $record = $RECORD_CLASS->new( $self->session, $option->{recordId} );
my $now = time;
if ( $option->{action} eq "buy" ) {
# Update record
$record->update({
expires => $now + $self->get('duration'),
transactionId => $item->transaction->getId,
isHidden => 0,
});
# Add to thingy data
my $data = JSON->new->decode( $record->get('fields') );
$self->updateThingRecord( $self->get('thingId'), $record->getId, $data );
}
elsif ( $option->{action} eq "renew" ) {
# Renew a currently active record
if ( $record->get('expires') > $now ) {
$record->update({
expires => $record->get('expires') + $self->get('duration'),
});
}
# Renew an expired but not deleted record
else {
$record->update({
expires => $now + $self->get('duration'),
isHidden => 0,
});
# Add to thingy data
my $data = JSON->new->decode( $record->get('fields') );
$self->updateThingRecord( $self->get('thingId'), $record->getId, $data );
}
}
}
#-------------------------------------------------------------------
=head2 onRemoveFromCart ( )
Removed from cart, remove all knowledge
=cut
sub onRemoveFromCart {
my ( $self, $item ) = @_;
# Remove from cart
my $option = $self->getOptions;
if ( $option->{action} eq "buy" ) {
my $record = $RECORD_CLASS->new($self->session,$option->{recordId});
if ( $record ) {
$record->delete;
}
}
}
#-------------------------------------------------------------------
=head2 prepareView ( )
See WebGUI::Asset::prepareView() for details.
=cut
sub prepareView {
my $self = shift;
$self->SUPER::prepareView();
my $template = WebGUI::Asset::Template->new( $self->session, $self->get("templateIdView") );
$template->prepare($self->getMetaDataAsTemplateVariables);
$self->{_viewTemplate} = $template;
}
#-------------------------------------------------------------------
=head2 processEditRecordForm ( )
Process the edit record form and return the record
=cut
sub processEditRecordForm {
my ( $self ) = @_;
my $var = {};
my $fields = $self->getThingFields( $self->get('thingId') );
for my $field ( @{$fields} ) {
my $fieldName = 'field_'.$field->{fieldId};
my $fieldType = $field->{fieldType};
$fieldType = "" if ($fieldType =~ m/^otherThing/x);
$var->{ $fieldName }
= $self->session->form->get($fieldName,$fieldType,$field->{defaultValue},$field);
}
return $var;
}
#-------------------------------------------------------------------
=head2 purge ( )
Remove all collateral associated with the ThingyRecord sku
=cut
sub purge {
my $self = shift;
my $options = {
constraints => {
'assetId = ?' => $self->getId,
},
};
my $iter = $RECORD_CLASS->getAllIterator($self->session,$options);
while ( my $item = $iter->() ) {
$item->delete;
}
# Should we also remove the records from the Thingy?
return $self->SUPER::purge;
}
#-------------------------------------------------------------------
=head2 updateThingRecord ( thingId, data )
Update data in a thing
=cut
sub updateThingRecord {
my ( $self, $thingId, $recordId, $data ) = @_;
my $db = $self->session->db;
my $dbh = $self->session->db->dbh;
my $tableName = $dbh->quote_identifier('Thingy_'.$thingId);
$data->{ thingDataId } = $recordId;
my $columns = join ",", map { $dbh->quote_identifier( $_ ) } keys %{$data};
my $values = [ values %{$data} ];
my $places = join ",", ('?') x @{$values};
$self->session->db->write(
"REPLACE INTO $tableName ($columns) VALUES ($places)",
$values,
);
}
#-------------------------------------------------------------------
=head2 view ( options )
method called by the container www_view method.
=cut
sub view {
my ( $self, $options ) = @_;
my $session = $self->session;
my $i18n = WebGUI::International->new( $session, "Asset_ThingyRecord" );
my $var = $self->getTemplateVars;
$self->appendVarsEditRecord( $var );
$var->{ isNew } = 1;
$var->{ message } = $options->{addedToCart}
? $self->get('thankYouText')
: $options->{message}
;
# Add form header, footer, and submit button
$var->{ form_header }
= WebGUI::Form::formHeader( $session, {
action => $self->getUrl('func=buy'),
} );
$var->{ form_footer }
= WebGUI::Form::formFooter( $session );
$var->{ form_submit }
= WebGUI::Form::submit( $session, {
value => $i18n->get('add to cart','Shop'),
} );
return $self->processTemplate( $var, undef, $self->{_viewTemplate} );
}
#----------------------------------------------------------------------------
=head2 www_buy ( )
Create a new record and add it to the cart
=cut
sub www_buy {
my ( $self ) = @_;
my $session = $self->session;
# Get data for row
my $recordFields = $self->processEditRecordForm;
my $recordData = {
userId => $session->user->userId,
assetId => $self->getId,
fields => JSON->new->encode( $recordFields ),
};
# Add row to cart collateral
my $record = $RECORD_CLASS->create( $session, $recordData );
# Add item to cart with appropriate action and recordId
$self->addToCart({
action => "buy",
recordId => $record->getId,
});
# Return thank you screen
$self->prepareView;
return $self->processStyle(
$self->view({ addedToCart => 1 })
);
}
#----------------------------------------------------------------------------
=head2 www_editRecord ( options )
Edit the record after is has been purchased. Allow the user to show/hide the
record while it is still active.
=cut
sub www_editRecord {
my ( $self, $options ) = @_;
my $session = $self->session;
my $recordId = $session->form->get( 'recordId' );
my $record = $RECORD_CLASS->new( $session, $recordId );
return $self->session->privilege->insufficient
unless $self->session->user->userId eq $record->get('userId');
my $i18n = WebGUI::International->new( $session, "Asset_ThingyRecord" );
my $var = $self->getTemplateVars;
$self->appendVarsEditRecord( $var, $recordId );
$var->{ message } = $options->{message};
# Add form header, footer, and submit button
$var->{ form_header }
= WebGUI::Form::formHeader( $session, {
action => $self->getUrl('func=editRecordSave;recordId=' . $recordId),
} );
$var->{ form_footer }
= WebGUI::Form::formFooter( $session );
$var->{ form_submit }
= WebGUI::Form::submit( $session, {
value => $i18n->get('save','WebGUI'),
} );
# Add record information
my $recordData = $record->get;
for my $key ( keys %{$recordData} ) {
$var->{ "record_" . $key } = $recordData->{ $key };
}
# Add field to hide/show
# Don't allow user to show expired record
if ( time < $record->get('expires') ) {
$var->{ form_hide }
= WebGUI::Form::yesNo( $session, {
name => "hide",
value => $record->get('isHidden'),
} );
}
return $self->processStyle(
$self->processTemplate( $var, $self->get('templateIdView') )
);
}
#----------------------------------------------------------------------------
=head2 www_editRecordSave ( )
Save the record
=cut
sub www_editRecordSave {
my ( $self ) = @_;
my $session = $self->session;
my $form = $self->session->form;
my $recordId = $form->get('recordId');
my $record = $RECORD_CLASS->new( $session, $recordId );
return $self->session->privilege->insufficient
unless $self->session->user->userId eq $record->get('userId');
my $i18n = WebGUI::International->new( $session, "Asset_ThingyRecord" );
my $hide = $form->get('hide');
my $recordData = $self->processEditRecordForm;
$record->update({
fields => JSON->new->encode( $recordData ),
isHidden => $hide,
});
if ( $hide ) {
$self->deleteThingRecord( $self->get('thingId'), $recordId );
}
else {
$self->updateThingRecord( $self->get('thingId'), $recordId, $recordData );
}
return $self->www_editRecord({ message => $i18n->get('saved') });
}
#----------------------------------------------------------------------------
=head2 www_renew ( )
Add more time to an existing record.
=cut
sub www_renew {
my ( $self ) = @_;
my $session = $self->session;
my $i18n = WebGUI::International->new( $session, "Asset_ThingyRecord" );
my $recordId = $self->session->form->get('recordId');
my $record = $RECORD_CLASS->new( $session, $recordId );
return $session->privilege->insufficient
unless $session->user->userId eq $record->get('userId');
$self->addToCart({
action => "renew",
recordId => $recordId,
});
return $self->www_editRecord({ message => $i18n->get('renewal added to cart') . ' ^ViewCart;' });
}
1;
#vim:ft=perl

17
lib/WebGUI/Asset/WikiPage.pm
View file

@ -125,6 +125,22 @@ sub getAutoCommitWorkflowId {
my $self = shift;
my $wiki = $self->getWiki;
if ($wiki->hasBeenCommitted) {
# delete spam
my $spamStopWords = $self->session->config->get('spamStopWords');
if (ref $spamStopWords eq 'ARRAY') {
my $spamRegex = join('|',@{$spamStopWords});
$spamRegex =~ s/\s/\\ /g;
if ($self->get('content') =~ m{$spamRegex}xmsi) {
my $tag = WebGUI::VersionTag->new($self->session, $self->get('tagId'));
$self->purgeRevision;
if ($tag->getAssetCount == 0) {
$tag->rollback;
}
return undef;
}
}
return $wiki->get('approvalWorkflow')
|| $self->session->setting->get('defaultVersionTagWorkflow');
}
@ -276,7 +292,6 @@ sub processPropertiesFromFormPost {
}
}
}
}
#-------------------------------------------------------------------

15
lib/WebGUI/Asset/Wobject.pm
View file

@ -380,10 +380,17 @@ An HTML blob to be parsed into the current style.
=cut
sub processStyle {
my $self = shift;
my $output = shift;
$self->session->style->setRawHeadTags($self->getExtraHeadTags);
return $self->session->style->process($output,$self->get("styleTemplateId"));
my ($self, $output) = @_;
my $session = $self->session;
my $style = $session->style;
$style->setRawHeadTags($self->getExtraHeadTags);
if ($self->get('synopsis')) {
$style->setMeta({
name => 'Description',
content => $self->get('synopsis'),
});
}
return $style->process($output,$self->get("styleTemplateId"));
}

15
lib/WebGUI/Asset/Wobject/DataForm.pm
View file

@ -1532,11 +1532,26 @@ sub www_process {
my $default = $field->{defaultValue};
WebGUI::Macro::process($self->session, \$default);
my $value = $entry->field( $field->{name} ) || $default;
# WebGUI::Form::Integer::getValue() returns 0 even if no number is passed in.
# Not really a suitable default if we want to trigger the error message
if ($field->{status} eq "required" || $field->{status} eq "editable") {
# get the raw value (by sending field type as blank)
my $rawValue = $session->form->process($field->{name}, '');
$value = $session->form->process($field->{name}, $field->{type}, undef, {
defaultValue => $default,
value => $value,
});
# this is a hack, but it's better than changing the default getValue() of Integer, which
# could have massive effects downstream in other uses.
if(($field->{type} =~ /integer/i) && defined($rawValue) && ($rawValue eq '') && ($value eq "0")) {
$value = $rawValue;
}
WebGUI::Macro::filter(\$value);
}
if ($field->{status} eq "required" && (! defined($value) || $value =~ /^\s*$/)) {

12
lib/WebGUI/Asset/Wobject/Layout.pm
View file

@ -175,6 +175,7 @@ sub prepareView {
}
my %vars;
$vars{showAdmin} = ($session->var->isAdminOn && $self->canEdit && $self->canEditIfLocked);
my $splitter = $self->{_viewSplitter} = $self->getSeparator;
@ -194,9 +195,12 @@ sub prepareView {
$child->prepareView;
$placeHolder{$assetId} = $child;
push @children, {
id => $assetId,
isUncommitted => $child->get('status') eq 'pending',
content => $splitter . $assetId . '~~',
id => $assetId,
isUncommitted => $child->get('status') eq 'pending',
content => $splitter . $assetId . '~~',
};
if ($vars{showAdmin}) {
$children[-1]->{'dragger.icon'} = sprintf '<div id="td%s_handle" class="dragable"><div class="dragTrigger dragTriggerWrap">%s</div></div>', $assetId, $session->icon->drag('class="dragTrigger"');
};
}
@ -230,7 +234,6 @@ sub prepareView {
unshift @{ $vars{"position1_loop"} }, reverse @children;
}
$vars{showAdmin} = ($session->var->isAdminOn && $self->canEdit && $self->canEditIfLocked);
if ($vars{showAdmin}) {
# under normal circumstances we don't put HTML stuff in our code, but this will make it much easier
# for end users to work with our templates
@ -247,7 +250,6 @@ sub prepareView {
}
</style>
');
$vars{"dragger.icon"} = '<div class="dragTrigger dragTriggerWrap">'.$session->icon->drag('class="dragTrigger"').'</div>';
$vars{"dragger.init"} = '
<iframe id="dragSubmitter" style="display: none;" src="'.$session->url->extras('spacer.gif').'"></iframe>
<script type="text/javascript">

14
lib/WebGUI/Asset/Wobject/Matrix.pm
View file

@ -194,6 +194,20 @@ sub definition {
hoverHelp =>$i18n->get('compare color yes description'),
label =>$i18n->get('compare color yes label'),
},
maxScreenshotWidth=>{
fieldType =>"integer",
tab =>"display",
defaultValue =>"800",
hoverHelp =>$i18n->get('max screenshot width description'),
label =>$i18n->get('max screenshot width label'),
},
maxScreenshotHeight=>{
fieldType =>"integer",
tab =>"display",
defaultValue =>"600",
hoverHelp =>$i18n->get('max screenshot height description'),
label =>$i18n->get('max screenshot height label'),
},
categories=>{
fieldType =>"textarea",
tab =>"properties",

68
lib/WebGUI/Asset/Wobject/Survey.pm
View file

@ -197,8 +197,6 @@ sub definition {
fieldType => 'workflow',
label => 'Survey End Workflow',
hoverHelp => 'Workflow to run when user completes the Survey',
# label => $i18n->get('editForm workflowIdAddEntry label'),
# hoverHelp => $i18n->get('editForm workflowIdAddEntry description'),
none => 1,
},
quizModeSummary => {
@ -207,13 +205,16 @@ sub definition {
tab => 'properties',
label => $i18n->get('Quiz mode summaries'),
hoverHelp => $i18n->get('Quiz mode summaries help'),
}
},
allowBackBtn => {
fieldType => 'yesNo',
defaultValue => 0,
tab => 'properties',
label => $i18n->get('Allow back button'),
hoverHelp => $i18n->get('Allow back button help'),
},
);
#my $defaultMC = $session->
#%properties = ();
push @{$definition}, {
assetName => $i18n->get('assetName'),
icon => 'survey.gif',
@ -800,7 +801,7 @@ sub www_loadSurvey {
elsif ( $lastType eq 'question' ) {
$q = 1;
}
$html .= "<li id='$scount' class='section'>S" . ( $scount + 1 ) . ": $_->{text}<\/li><br>\n";
$html .= "<li id='$scount' class='section'>S" . ( $scount + 1 ) . ": $_->{text}<\/li>\n";
push( @ids, $scount );
}
elsif ( $_->{type} eq 'question' ) {
@ -808,7 +809,7 @@ sub www_loadSurvey {
if ( $lastType eq 'answer' ) {
$a = 1;
}
$html .= "<li id='$scount-$qcount' class='question'>Q" . ( $qcount + 1 ) . ": $_->{text}<\/li><br>\n";
$html .= "<li id='$scount-$qcount' class='question'>Q" . ( $qcount + 1 ) . ": $_->{text}<\/li>\n";
push @ids, "$scount-$qcount";
$lastType = 'question';
$acount = -1;
@ -818,12 +819,12 @@ sub www_loadSurvey {
$html
.= "<li id='$scount-$qcount-$acount' class='answer'>A"
. ( $acount + 1 )
. ": $_->{text}<\/li><br>\n";
. ": $_->{text}<\/li>\n";
push @ids, "$scount-$qcount-$acount";
$lastType = 'answer';
}
}
$html = "<ul class='draglist'>$html</ul>";
my $warnings = $self->surveyJSON->validateSurvey();
my $return = {
@ -1154,6 +1155,41 @@ sub www_submitQuestions {
}
#-------------------------------------------------------------------
=head2 www_goBack
Handles the Survey back button
=cut
sub www_goBack {
my $self = shift;
if ( !$self->canTakeSurvey() ) {
$self->session->log->debug('canTakeSurvey false, surveyEnd');
return $self->surveyEnd();
}
my $responseId = $self->responseId();
if ( !$responseId ) {
$self->session->log->debug('No response id, surveyEnd');
return $self->surveyEnd();
}
if ( !$self->get('allowBackBtn') ) {
$self->session->log->debug('allowBackBtn false, delegating to www_loadQuestions');
return $self->www_loadQuestions();
}
$self->responseJSON->pop;
$self->persistResponseJSON;
return $self->www_loadQuestions();
}
#-------------------------------------------------------------------
=head2 getSummary
@ -1305,15 +1341,8 @@ Sends the processed template and questions structure to the client
sub prepareShowSurveyTemplate {
my ( $self, $section, $questions ) = @_;
# my %multipleChoice = (
# 'Multiple Choice', 1, 'Gender', 1, 'Yes/No', 1, 'True/False', 1, 'Ideology', 1,
# 'Race', 1, 'Party', 1, 'Education', 1, 'Scale', 1, 'Agree/Disagree', 1,
# 'Oppose/Support', 1, 'Importance', 1, 'Likelihood', 1, 'Certainty', 1, 'Satisfaction', 1,
# 'Confidence', 1, 'Effectiveness', 1, 'Concern', 1, 'Risk', 1, 'Threat', 1,
# 'Security', 1
# );
my %textArea = ( 'TextArea', 1 );
my %text = ( 'Text', 1, 'Email', 1, 'Phone Number', 1, 'Text Date', 1, 'Currency', 1 );
my %text = ( 'Text', 1, 'Email', 1, 'Phone Number', 1, 'Text Date', 1, 'Currency', 1, 'Number', 1 );
my %slider = ( 'Slider', 1, 'Dual Slider - Range', 1, 'Multi Slider - Allocate', 1 );
my %dateType = ( 'Date', 1, 'Date Range', 1 );
my %dateShort = ( 'Year Month', 1 );
@ -1379,6 +1408,7 @@ sub prepareShowSurveyTemplate {
if(scalar @{$questions} == ($section->{totalQuestions} - $section->{questionsAnswered})){
$section->{isLastPage} = 1
}
$section->{allowBackBtn} = $self->get('allowBackBtn');
my $out = $self->processTemplate( $section, $self->get('surveyQuestionsId') );

8
lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm
View file

@ -54,7 +54,7 @@ sub value {
if (my $other_instance = $other_instances->{$asset_spec}) {
my $values = $other_instance->{values};
my $value = $values->{$key};
$session->log->debug("[$asset_spec, $key] resolves to [$value]");
$session->log->debug("value($asset_spec, $key) resolves to [$value]");
return $value;
} else {
# Throw an exception, triggering run() to resolve the external reference and re-run
@ -63,7 +63,7 @@ sub value {
}
my $key = shift;
my $value = $values->{$key};
$session->log->debug("[$key] resolves to [$value]");
$session->log->debug("value($key) resolves to [$value]");
return $value; # scalar variable, so no need to clone
}
@ -85,7 +85,7 @@ sub score {
if (my $other_instance = $other_instances->{$asset_spec}) {
my $scores = $other_instance->{scores};
my $score = $scores->{$key};
$session->log->debug("[$asset_spec, $key] resolves to [$score]");
$session->log->debug("score($asset_spec, $key) resolves to [$score]");
return $score;
} else {
# Throw an exception, triggering run() to resolve the external reference and re-run
@ -94,7 +94,7 @@ sub score {
}
my $key = shift;
my $score = $scores->{$key};
$session->log->debug("[$key] resolves to [$score]");
$session->log->debug("score($key) resolves to [$score]");
return $score; # scalar variable, so no need to clone
}

239
lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm
View file

@ -39,59 +39,6 @@ number of questions answered (L<"questionsAnswered">) and the Survey start time
This package is not intended to be used by any other Asset in WebGUI.
=head2 surveyOrder
This data strucutre is an array (reference) of Survey addresses (see
L<WebGUI::Asset::Wobject::Survey::SurveyJSON/Address Parameter>), stored in the order
in which items are presented to the user.
By making use of L<WebGUI::Asset::Wobject::Survey::SurveyJSON> methods which expect address params as
arguments, you can access Section/Question/Answer items in order by iterating over surveyOrder.
For example:
# Access sections in order..
for my $address (@{ $self->surveyOrder }) {
my $section = $self->survey->section( $address );
# etc..
}
In general, the surveyOrder data structure looks like:
[ $sectionIndex, $questionIndex, [ $answerIndex1, $answerIndex2, ....]
There is one array element for every section and address in the survey. If there are
no questions, or no addresses, those array elements will not be present.
=head2 responses
This data structure stores a snapshot of all question responses. Both question data and answer data
is stored in this hash reference.
Questions keys are constructed by hypenating the relevant L<"sIndex"> and L<"qIndex">.
Answer keys are constructed by hypenating the relevant L<"sIndex">, L<"qIndex"> and L<aIndex|"aIndexes">.
Question entries only contain a comment field:
{
...
questionId => {
comment => "question comment",
}
...
}
Answers entries contain: value (the recorded value), time and comment fields.
{
...
answerId => {
value => "recorded answer value",
time => time(),
comment => "answer comment",
},
...
}
=cut
use strict;
@ -252,7 +199,7 @@ sub hasTimedOut{
=head2 lastResponse ([ $responseIndex ])
Mutator. The lastResponse property represents the index of the most recent surveyOrder entry shown.
Mutator. The lastResponse property represents the surveyOrder index of the most recent item shown.
This method returns (and optionally sets) the value of lastResponse.
@ -325,8 +272,32 @@ sub startTime {
=head2 surveyOrder
Accessor for surveyOrder (see L<"surveyOrder">).
Initialized on first access via L<"initSurveyOrder">.
Accessor. Initialized on first access via L<"initSurveyOrder">.
This data strucutre represents the list of items that are shown to the user, in the order
that they will be shown (ignoring jumps and jump expressions).
Typically each item will correspond to a question, and contains enough information to look
up both the corresponding section and all contained answers (if any).
Empty sections also appear in the list.
Each element of the array is an address, similar in structure to
L<WebGUI::Asset::Wobject::Survey::SurveyJSON/Address Parameter>,
except that instead of an answerIndex in the third slot, we have a sub-array of all contained answer indicies.
[ $sectionIndex, $questionIndex, [ $answerIndex1, $answerIndex2, ....]
By making use of L<WebGUI::Asset::Wobject::Survey::SurveyJSON> methods which expect address params as
arguments, you can access Section/Question/Answer items in order by iterating over surveyOrder.
For example:
# Access sections in order..
for my $address (@{ $self->surveyOrder }) {
my $section = $self->survey->section( $address );
# etc..
}
=cut
@ -489,7 +460,6 @@ sub recordResponses {
$gotoExpression = $section->{gotoExpression};
}
# Handle empty Section..
if ( !@questions ) {
# No questions to process, so increment lastResponse and return
@ -526,9 +496,22 @@ sub recordResponses {
# Pluck the values out of the responses hash that we want to record..
my $submittedAnswerResponse = $submittedResponses->{ $answer->{id} };
my $submittedAnswerComment = $submittedResponses->{ $answer->{id} . 'comment' };
my $submittedAnswerVerbatim = $submittedResponses->{ $answer->{id} . 'verbatim' };
# Proceed if we're satisfied that the submitted answer response is valid..
if ( defined $submittedAnswerResponse && $submittedAnswerResponse =~ /\S/ ) {
#Validate answers met question criteria
if($question->{questionType} eq 'Number'){
if($answer->{max} =~ /\d/ and $submittedAnswerResponse > $answer->{max}){
next;
}elsif($answer->{min} =~ /\d/ and $submittedAnswerResponse < $answer->{min}){
next;
}elsif($answer->{step} =~ /\d/ and $submittedAnswerResponse % $answer->{step} != 0){
next;
}
}
$aAnswered = 1;
# Now, decide what to record. For multi-choice questions, use recordedAnswer.
@ -537,9 +520,10 @@ sub recordResponses {
= $knownTypes{ $question->{questionType} }
? $submittedAnswerResponse
: $answer->{recordedAnswer};
$self->responses->{ $answer->{id} }->{time} = time;
$self->responses->{ $answer->{id} }->{comment} = $submittedAnswerComment;
$self->responses->{ $answer->{id} }->{verbatim} = $answer->{verbatim} ? $submittedAnswerVerbatim : undef;
$self->responses->{ $answer->{id} }->{time} = time;
$self->responses->{ $answer->{id} }->{comment} = $submittedAnswerComment;
# Handle terminal Answers..
if ( $answer->{terminal} ) {
@ -609,6 +593,23 @@ A variable name to match against all section and question variable names.
sub processGoto {
my $self = shift;
my ($goto) = validate_pos(@_, {type => SCALAR});
if ($goto eq 'NEXT_SECTION') {
$self->session->log->debug("NEXT_SECTION jump target encountered");
my $lastResponseSectionIndex = $self->lastResponseSectionIndex;
# Increment lastRepsonse until nextResponseSectionIndex moves
while ($self->nextResponseSectionIndex == $lastResponseSectionIndex) {
$self->lastResponse( $self->lastResponse + 1);
}
return;
}
if ($goto eq 'END_SURVEY') {
$self->session->log->debug("END_SURVEY jump target encountered");
$self->lastResponse( scalar( @{ $self->surveyOrder} ) - 1 );
return;
}
# Iterate over items in order..
my $itemIndex = 0;
@ -714,17 +715,31 @@ sub recordedResponses{
#-------------------------------------------------------------------
=head2 responseValuesByVariableName
=head2 responseValuesByVariableName ( $options )
Returns a lookup table to question variable names and recorded response values.
Only questions with a defined variable name set are included. Values come from
the L<responses> hash.
=head3 options
The following options are supported:
=over 3
=item * useText
For multiple choice questions, use the answer text instead of the recorded value
(useful for doing [[var]] text substitution
=back
=cut
sub responseValuesByVariableName {
my $self = shift;
my %options = validate(@_, { useText => 0 });
my %lookup;
while (my ($address, $response) = each %{$self->responses}) {
@ -742,14 +757,23 @@ sub responseValuesByVariableName {
# Filter out questions without defined variable names
next if !$question || !defined $question->{variable};
#Test if question is a multiple choice type so we can use the answer text instead
my $answerText;
if($self->survey->getMultiChoiceBundle($question->{questionType})){
$answerText = $self->survey->answer([@address])->{text};
my $value = $response->{value};
if ($options{useText}) {
# Test if question is a multiple choice type so we can use the answer text instead
if($self->survey->getMultiChoiceBundle($question->{questionType})){
my $answer = $self->survey->answer([@address]);
my $answerText = $answer->{text};
# For verbatim mc answers, combine answer text and recorded value
if ($answer->{verbatim}) {
$answerText = "$answerText - \"$response->{verbatim}\"";
}
$value = $answerText ? $answerText : $value;
}
}
# Add variable => value to our hash
$lookup{$question->{variable}} = $answerText ? $answerText : $response->{value};
$lookup{$question->{variable}} = $value;
}
return \%lookup;
}
@ -885,7 +909,7 @@ sub nextQuestions {
my $questionsPerPage = $self->survey->section( [ $self->nextResponseSectionIndex ] )->{questionsPerPage};
# Get all of the existing question responses (so that we can do Section and Question [[var]] replacements
my $responseValuesByVariableName = $self->responseValuesByVariableName();
my $responseValuesByVariableName = $self->responseValuesByVariableName( { useText => 1 } );
# Do text replacement
$section->{text} = $self->getTemplatedText($section->{text}, $responseValuesByVariableName);
@ -1230,11 +1254,32 @@ sub response {
return $self->{_response};
}
#-------------------------------------------------------------------
=head2 responses
Mutator for the L<"responses"> property.
Mutator. Note, this is an unsafe reference.
Note, this is an unsafe reference.
This data structure stores a snapshot of all question responses. Both question data and answer data
is stored in this hash reference.
Questions keys are constructed by hypenating the relevant L<"sIndex"> and L<"qIndex">.
Answer keys are constructed by hypenating the relevant L<"sIndex">, L<"qIndex"> and L<aIndex|"aIndexes">.
{
# Question entries only contain a comment field, e.g.
'0-0' => {
comment => "question comment",
},
# ...
# Answers entries contain: value (the recorded value), time and comment fields.
'0-0-0' => {
value => "recorded answer value",
time => time(),
comment => "answer comment",
},
# ...
}
=cut
@ -1247,6 +1292,62 @@ sub responses {
return $self->response->{responses};
}
=head2 pop
=cut
sub pop {
my $self = shift;
my %responses = %{ $self->responses };
# Iterate over responses first time to determine time of most recent response(s)
my $lastResponseTime;
for my $r ( values %responses ) {
if ( $r->{time} ) {
$lastResponseTime
= !$lastResponseTime || $r->{time} > $lastResponseTime
? $r->{time}
: $lastResponseTime
;
}
}
return unless $lastResponseTime;
my $popped;
my $poppedQuestions;
# Iterate again, removing most recent responses
while (my ($address, $r) = each %responses ) {
if ( $r->{time} == $lastResponseTime) {
$popped->{$address} = $r;
delete $self->responses->{$address};
# Remove associated question/comment entry
my ($sIndex, $qIndex, $aIndex) = split /-/, $address;
my $qAddress = "$sIndex-$qIndex";
$popped->{$qAddress} = $responses{$qAddress};
delete $self->responses->{$qAddress};
# while we're here, build lookup table of popped question ids
$poppedQuestions->{$qAddress} = 1;
}
}
# Now, nextResponse should be set to index of the first popped question we can find in surveyOrder
my $nextResponse = 0;
for my $address (@{ $self->surveyOrder }) {
my $questionId = "$address->[0]-$address->[1]";
if ($poppedQuestions->{$questionId} ) {
$self->session->log->debug("setting nextResponse to $nextResponse");
$self->nextResponse($nextResponse);
last;
}
$nextResponse++;
}
return $popped;
}
#-------------------------------------------------------------------
=head2 survey

41
lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm
View file

@ -117,6 +117,7 @@ sub loadTypes {
'Slider',
'Currency',
'Email',
'Number',
'Phone Number',
'Text',
'Text Date',
@ -413,16 +414,17 @@ Generates the list of valid goto targets
sub getGotoTargets {
my $self = shift;
# Valid goto targets are all of the section variable names..
my @section_vars = map {$_->{variable}} @{$self->sections};
# Valid goto targets are all of the non-empty section variable names..
my @section_vars = grep { $_ ne q{} } map {$_->{variable}} @{$self->sections};
# ..and all of the question variable names..
my @question_vars = map {$_->{variable}} @{$self->questions};
# ..and all of the non-empty question variable names..
my @question_vars = grep { $_ ne q{} } map {$_->{variable}} @{$self->questions};
# ..excluding the ones that are empty
my @grep = grep { $_ ne q{} } (@section_vars, @question_vars);
return \@grep;
#return grep { $_ ne q{} } (@section_vars, @question_vars);
# ..plus some special vars
my @special_vars = qw(NEXT_SECTION END_SURVEY);
# ..all combined
return [ @section_vars, @question_vars, @special_vars ];
}
=head2 getSectionEditVars ( $address )
@ -665,16 +667,32 @@ sub update {
}
}
$self->_handleSpecialAnswerUpdates($address,$properties);
# Update $object with all of the data in $properties
while (my ($key, $value) = each %{$properties}) {
if (defined $value) {
$object->{$key} = $value;
}
}
return;
}
sub _handleSpecialAnswerUpdates{
my $self = shift;
my $address = shift;
my $properties = shift;
my $question = $self->question($address);
if($question->{questionType} =~ /^Slider|Multi Slider - Allocate|Dual Slider - Range$/){
for my $answer(@{$self->answers($address)}){
$answer->{max} = $properties->{max};
$answer->{min} = $properties->{min};
$answer->{step} = $properties->{step};
}
}
}
=head2 insertObject ( $object, $address )
Rearrange existing objects in the current data structure.
@ -1036,10 +1054,9 @@ sub addAnswersToQuestion {
# when updating answer text without causing side-effects for the caller's $address
my @address_copy = @{$address};
for my $answer_index ( 0 .. $#{$answers} ) {
for my $answer (@$answers) {
# Add a new answer to question
push @{ $self->question( \@address_copy )->{answers} }, $answers->[$answer_index];
push @{ $self->question( \@address_copy )->{answers} }, $answer;
}
return;

2
lib/WebGUI/Asset/Wobject/SyndicatedContent.pm
View file

@ -153,7 +153,7 @@ sub generateFeed {
# care of any encoding specified in the XML prolog
utf8::downgrade($value, 1);
eval {
my $singleFeed = XML::FeedPP->new($value, utf8_flag => 1);
my $singleFeed = XML::FeedPP->new($value, utf8_flag => 1, -type => 'string');
$feed->merge($singleFeed);
};
if ($@) {

31
lib/WebGUI/Asset/Wobject/Thingy.pm
View file

@ -292,19 +292,44 @@ sub duplicate {
my $assetId = $self->get("assetId");
my $fields;
my $otherThingFields = $db->buildHashRefOfHashRefs(
"select fieldType, fieldId, right(fieldType,22) as otherThingId, fieldInOtherThingId from Thingy_fields
where fieldType like 'otherThing_%' and assetId = ?",
[$assetId],'fieldInOtherThingId'
);
my $things = $self->getThings;
while ( my $thing = $things->hashRef) {
my $oldThingId = $thing->{thingId};
my $newThingId = $newAsset->addThing($thing,0);
my $oldSortBy = $thing->{sortBy};
my $oldThingId = $thing->{thingId};
my $newThingId = $newAsset->addThing($thing,0);
$fields = $db->buildArrayRefOfHashRefs('select * from Thingy_fields where assetId=? and thingId=?'
,[$assetId,$oldThingId]);
foreach my $field (@$fields) {
# set thingId to newly created thing's id.
$field->{thingId} = $newThingId;
my $originalFieldId = $field->{fieldId};
$newAsset->addField($field,0);
my $newFieldId = $newAsset->addField($field,0);
if ($originalFieldId eq $oldSortBy){
$self->session->db->write( "update Thingy_things set sortBy = ? where thingId = ?",
[ $newFieldId, $newThingId ] );
}
if ($otherThingFields->{$originalFieldId}){
$otherThingFields->{$originalFieldId}->{newFieldType} = 'otherThing_'.$newThingId;
$otherThingFields->{$originalFieldId}->{newFieldId} = $newFieldId;
}
}
}
foreach my $otherThingField (keys %$otherThingFields){
$db->write('update Thingy_fields set fieldType = ?, fieldInOtherThingId = ?
where fieldInOtherThingId = ? and assetId = ?',
[$otherThingFields->{$otherThingField}->{newFieldType},
$otherThingFields->{$otherThingField}->{newFieldId},
$otherThingFields->{$otherThingField}->{fieldInOtherThingId}, $newAsset->get('assetId')]);
}
return $newAsset;
}

4
lib/WebGUI/Asset/Wobject/UserList.pm
View file

@ -61,7 +61,7 @@ sub getAlphabetSearchLoop {
my $htmlEncodedLetter = encode_entities($letter);
my $searchURL = "?searchExact_".$fieldName."=".$letter."%25";
my $hasResults;
my $users = $self->session->db->read("select userId from userProfileData where lastName like '".$letter."%'");
my $users = $self->session->db->read("select userId from userProfileData where `$fieldName` like '".$letter."%'");
while (my $user = $users->hashRef){
my $showGroupId = $self->get("showGroupId");
if ($showGroupId eq '0' || ($showGroupId && $self->isInGroup($showGroupId,$user->{userId}))){
@ -535,7 +535,7 @@ sub view {
my $users = $p->getPageData($paginatePage);
foreach my $user (@$users){
my $userObject = WebGUI::User->new($self->session,$user->{userId});
if ($self->get('overridePublicProfile') || $userObject->profileIsViewable($userObject)){
if ($self->get('overridePublicProfile') || $userObject->profileIsViewable()) {
my (@profileFieldValues);
my %userProperties;
foreach my $profileField (@profileFields){

27
lib/WebGUI/AssetAspect/RssFeed.pm
View file

@ -143,6 +143,24 @@ sub definition {
#-------------------------------------------------------------------
=head2 _httpBasicLogin ( )
Set header values and content to show the HTTP Basic Auth login box.
=cut
sub _httpBasicLogin {
my ( $self ) = @_;
$self->session->request->headers_out->set(
'WWW-Authenticate' => 'Basic realm="'.$self->session->setting->get('companyName').'"'
);
$self->session->http->setStatus(401,'Unauthorized');
$self->session->http->sendHeader;
return '';
}
#-------------------------------------------------------------------
=head2 exportAssetCollateral ()
Extended from WebGUI::Asset and exports the www_viewRss() and
@ -161,6 +179,10 @@ particular asset.
A hashref with the quiet, userId, depth, and indexFileName parameters from
L<WebGUI::Asset/exportAsHtml>.
=head3 session
The session doing the full export. Can be used to report status messages.
=cut
sub exportAssetCollateral {
@ -220,8 +242,8 @@ sub exportAssetCollateral {
# next, get the contents, open the file, and write the contents to the file.
my $fh = eval { $dest->open('>:utf8') };
if($@) {
WebGUI::Error->throw(error => "can't open " . $dest->absolute->stringify . " for writing: $!");
$exportSession->close;
WebGUI::Error->throw(error => "can't open " . $dest->absolute->stringify . " for writing: $!");
}
$exportSession->asset($selfdupe);
$exportSession->output->setHandle($fh);
@ -490,6 +512,7 @@ Return Atom view of the syndicated items.
sub www_viewAtom {
my $self = shift;
return $self->_httpBasicLogin unless $self->canView;
$self->session->http->setMimeType('application/atom+xml');
return $self->getFeed( XML::FeedPP::Atom->new )->to_string;
}
@ -504,6 +527,7 @@ Return Rdf view of the syndicated items.
sub www_viewRdf {
my $self = shift;
return $self->_httpBasicLogin unless $self->canView;
$self->session->http->setMimeType('application/rdf+xml');
return $self->getFeed( XML::FeedPP::RDF->new )->to_string;
}
@ -518,6 +542,7 @@ Return RSS view of the syndicated items.
sub www_viewRss {
my $self = shift;
return $self->_httpBasicLogin unless $self->canView;
$self->session->http->setMimeType('application/rss+xml');
return $self->getFeed( XML::FeedPP::RSS->new )->to_string;
}

19
lib/WebGUI/AssetCollateral/Sku/Ad/Ad.pm
View file

@ -12,17 +12,29 @@ package WebGUI::AssetCollateral::Sku::Ad::Ad;
http://www.plainblack.com info@plainblack.com
-------------------------------------------------------------------
=cut
=head1 NAME
Package WebGUI::AssetCollateral::Sku::Ad::Ad
=head1 DESCRIPTION
Package to manipulate collateral for WebGUI::Asset::Sku::Ad.
=head1 METHODS
This packages is a subclass of L<WebGUI::Crud>. Please refer to that module
for a list of base methods that are available.
=cut
use strict;
use base 'WebGUI::Crud';
#------------------------------------------------
=head1 crud_definition
=head1 crud_definition ($session)
defines the field this crud will contain
Defines the fields this CRUD will contain.
userID = the id of the user that purchased the ad
transactionItemid = the id if the transaction item that completes this purchase
@ -78,4 +90,3 @@ sub crud_definition {
}
1;

84
lib/WebGUI/AssetCollateral/Sku/ThingyRecord/Record.pm Normal file
View file

@ -0,0 +1,84 @@
package WebGUI::AssetCollateral::Sku::ThingyRecord::Record;
=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
use strict;
=head1 NAME
Package WebGUI::AssetCollateral::Sku::ThingyRecord::Record
=head1 DESCRIPTION
Package to manipulate collateral for WebGUI::Asset::Sku::ThingyRecord.
There should be a list of data that this module uses and a description of how
they relate and function.
=head1 METHODS
This packages is a subclass of L<WebGUI::Crud>. Please refer to that module
for a list of base methods that are available.
=cut
use base 'WebGUI::Crud';
#----------------------------------------------------------------
=head2 crud_definition ($session)
Defintion subroutine to set up CRUD.
=cut
sub crud_definition {
my ($class, $session) = @_;
my $definition = $class->SUPER::crud_definition($session);
$definition->{tableName} = 'ThingyRecord_record';
$definition->{tableKey} = 'recordId';
my $properties = $definition->{properties};
$properties->{transactionId} = {
fieldType => "hidden",
defaultValue => undef,
};
$properties->{assetId} = {
fieldType => "hidden",
defaultValue => undef,
};
$properties->{expires} = {
fieldType => "DateTime",
defaultValue => 0,
};
$properties->{userId} = {
fieldType => "hidden",
defaultValue => undef,
};
$properties->{fields} = {
fieldType => 'textarea',
defaultValue => '',
};
$properties->{isHidden} = {
fieldType => 'yesNo',
defaultValue => 0,
};
$properties->{sentExpiresNotice} = {
fieldType => 'yesNo',
defaultValue => 0,
};
return $definition;
}
1;

2
lib/WebGUI/AssetExportHtml.pm
View file

@ -368,6 +368,8 @@ sub exportAsHtml {
$session->db->write( "UPDATE asset SET lastExportedAs = ? WHERE assetId = ?",
[ $fullPath, $asset->getId ] );
$self->updateHistory("exported");
# tell the user we did this asset correctly
unless( $quiet ) {
$session->output->print($i18n->get('done'));

1
lib/WebGUI/Auth/LDAP.pm
View file

@ -66,7 +66,6 @@ sub _isValidLDAPUser {
# Create an LDAP object
if ($ldap = Net::LDAP->new($uri->host, (port=>$uri->port))) {
my $uri = $ldapLink->getURI;
# Bind as a proxy user to search for the user trying to login
if($connection->{connectDn}) {
$auth = $ldap->bind(dn=>$connection->{connectDn}, password=>$connection->{identifier});

4
lib/WebGUI/Crud.pm
View file

@ -639,6 +639,10 @@ Here's an example of this structure:
{ "color=? or color=?" => ['blue','black'] },
]
would yield
( price <= 44 ) AND ( color = 'blue' OR color = 'black' )
=head4 join
An array reference containing the tables you wish to join with this one, and the mechanisms to join them. Here's an example.

2
lib/WebGUI/DateTime.pm
View file

@ -513,6 +513,7 @@ A string representing the output format for the date. Defaults to '%z %Z'. You c
%P = An upper-case AM/PM.
%s = A two digit second.
%t = Time zone name.
%V = Week number.
%w = Day of the week.
%W = Day of the week abbreviated.
%y = A four digit year.
@ -555,6 +556,7 @@ sub webguiDate {
"p" => "P",
"P" => "p",
"s" => "S",
"V" => "V",
"w" => "A",
"W" => "a",
"y" => "Y",

29
lib/WebGUI/Form/SelectBox.pm
View file

@ -165,13 +165,28 @@ sub toHtml {
my $output = '<select name="'.($self->get("name")||'').'" size="'.($self->get("size")||'').'" id="'.($self->get('id')||'').'" '.($self->get("extras")||'').'>';
my $options = $self->getOptions;
my $value = $self->getOriginalValue();
foreach my $key (keys %{$options}) {
$output .= '<option value="'.$key.'"';
if ($value eq $key) {
$output .= ' selected="selected"';
}
$output .= '>'.$options->{$key}.'</option>';
}
# Recurse for <optgroups>
my $buildOptionsHtml;
$buildOptionsHtml = sub {
my $options = shift;
foreach my $key (keys %{$options}) {
if ( ref $options->{$key} eq 'HASH' ) {
$output .= qq{<optgroup label="$key">};
$buildOptionsHtml->($options->{$key});
$output .= qq{</optgroup>};
}
else {
$output .= '<option value="'.$key.'"';
if ($value eq $key) {
$output .= ' selected="selected"';
}
$output .= '>'.$options->{$key}.'</option>';
}
}
};
$buildOptionsHtml->($options);
$output .= '</select>'."\n";
return $output;
}

64
lib/WebGUI/Form/ThingFieldsList.pm Normal file
View file

@ -0,0 +1,64 @@
package WebGUI::Form::ThingFieldsList;
=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
use strict;
use base 'WebGUI::Form::SelectList';
=head1 NAME
Package WebGUI::Form::ThingyFieldsList
=head1 DESCRIPTION
Creates a content type selector which can be used in conjunction with the Thingy to pick a list
of fields in that thingy.
=head1 SEE ALSO
This is a subclass of WebGUI::Form::Selectlist.
=head1 METHODS
The following methods are specifically available from this class. Check the superclass for additional methods.
=cut
#----------------------------------------------------------------------------
=head2 www_getThingFields ($session)
Returns a JSON encoded hash which contains a list of fieldIds and labels
from the Thingy_fields table for the Thing given by the form variable 'thingId'.
=head3 $session
=cut
sub www_getThingFields {
my ( $session ) = @_;
my $thingId = $session->form->get('thingId');
my %fields
= $session->db->buildHash(
"SELECT fieldId, label FROM Thingy_fields WHERE thingId=?",
[$thingId]
);
$session->http->setMimeType( 'application/json' );
return JSON->new->encode( \%fields );
}
1;

2
lib/WebGUI/Group.pm
View file

@ -858,7 +858,7 @@ EOQ
=head2 getUserList ( [ withoutExpired ] )
Returns a hash reference with key of userId and value of username for users in the group
Returns a hash reference with key of userId and value of username for users in the group, sorted by username.
=head3 withoutExpired

10
lib/WebGUI/Help/Asset_Layout.pm
View file

@ -18,11 +18,15 @@ our $HELP = {
},
],
variables => [
{ 'name' => 'showAdmin' },
{ 'name' => 'dragger.icon' },
{ 'name' => 'showAdmin' },
{ 'name' => 'dragger.init' },
{ 'name' => 'position1_loop',
'variables' => [ { 'name' => 'id' }, { 'name' => 'content' }, { 'name' => 'isUncommitted' }, ]
'variables' => [
{ 'name' => 'id' },
{ 'name' => 'content' },
{ 'name' => 'isUncommitted' },
{ 'name' => 'dragger.icon' },
]
},
],
fields => [],

2
lib/WebGUI/Help/Asset_Sku.pm
View file

@ -17,8 +17,6 @@ our $HELP = {
{ 'name' => 'sku', description=>'sku help'},
{ 'name' => 'description', description=>'description help' },
{ 'name' => 'displayTitle', description=>'display title help' },
{ 'name' => 'overrideTaxRate', description=>'override tax rate help' },
{ 'name' => 'taxRateOverride', description=>'tax rate override help' },
{ 'name' => 'vendorId', description=>'vendor help' },
],
related => []

2
lib/WebGUI/Help/Asset_Survey.pm
View file

@ -119,6 +119,8 @@ our $HELP = {
{ 'name' => 'showProgress' },
{ 'name' => 'showTimeLimit' },
{ 'name' => 'minutesLeft' },
{ 'name' => 'isLastPage' },
{ 'name' => 'allowBackBtn' },
{ 'name' => 'questions',
'variables' => [
{ 'name' => 'id' },

61
lib/WebGUI/Help/Asset_WSClient.pm
View file

@ -1,61 +0,0 @@
package WebGUI::Help::Asset_WSClient;
use strict;
our $HELP = {
'ws client template' => {
title => '72',
body => '',
isa => [
{ tag => 'ws client asset template variables',
namespace => 'Asset_WSClient'
},
{ tag => 'pagination template variables',
namespace => 'WebGUI'
},
],
variables => [
{ 'name' => 'disableWobject' },
{ 'name' => 'numResults' },
{ 'name' => 'soapError' },
{ 'name' => 'results', },
],
fields => [],
related => [
{ tag => 'wobject template',
namespace => 'Asset_Wobject'
}
]
},
'ws client asset template variables' => {
private => 1,
title => 'ws client asset template variables title',
body => '',
isa => [
{ tag => "wobject template variables",
namespace => 'Asset_Wobject'
},
],
variables => [
{ 'name' => 'templateId' },
{ 'name' => 'callMethod' },
{ 'name' => 'debugMode' },
{ 'name' => 'execute_by_default' },
{ 'name' => 'paginateAfter' },
{ 'name' => 'paginateVar' },
{ 'name' => 'params' },
{ 'name' => 'preprocessMacros' },
{ 'name' => 'proxy' },
{ 'name' => 'uri' },
{ 'name' => 'decodeUtf8' },
{ 'name' => 'httpHeader' },
{ 'name' => 'cacheTTL' },
{ 'name' => 'sharedCache' },
],
fields => [],
related => []
},
};
1;

4
lib/WebGUI/Inbox.pm
View file

@ -309,7 +309,7 @@ Properties which can be set to determine how many rows are returned, etc
=head4 sortBy
Column to sort the inbox by. Valid values are subject, sentBy, and dateStamp. Defaults to
dateStamp if value is invalid. Defaults to status="pending" DESC, dateStamp DESC if value not set.
dateStamp if value is invalid. Defaults to status DESC, dateStamp DESC if value not set.
=head4 sortDir
@ -424,7 +424,7 @@ A where clause to use
=head4 limit
Column
A full limit clause, not just the number to limit.
=cut

11
lib/WebGUI/Keyword.pm
View file

@ -176,7 +176,16 @@ site.
=head3 maxKeywords
The maximum number of keywords to display in the cloud. Defaults to 50. Valid range between 1 and 50, inclusive.
The maximum number of keywords to display in the cloud. Defaults to 50. Valid range between 1 and 100, inclusive.
=head3 urlCallback
This is the name of a method that will be called on the displayAsset, or the startAsset to get the URL
that elements in the tag cloud will link to. The method will be passed the keyword as its first, and only argument.
=head3 includeOnlyKeywords
This is an arrayref of keywords. The generated cloud will only contain these keywords.
=cut

1
lib/WebGUI/Operation.pm
View file

@ -111,6 +111,7 @@ sub getOperations {
'listDatabaseLinks' => 'DatabaseLink',
'formHelper' => 'FormHelpers',
'activityHelper' => 'Workflow',
'addGroupsToGroupSave' => 'Group',
'addUsersToGroupSave' => 'Group',

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

@ -79,6 +79,8 @@ sub _submenu {
|| $userId eq "new") {
$ac->addSubmenuItem($session->url->page("op=editUser;uid=$userId"), $i18n->get(457));
$ac->addSubmenuItem($session->url->page("op=becomeUser;uid=$userId"), $i18n->get(751));
my $user = WebGUI::User->new($session, $userId);
$ac->addSubmenuItem($user->getProfileUrl(), $i18n->get('view profile'));
$ac->addConfirmedSubmenuItem($session->url->page("op=deleteUser;uid=$userId"), $i18n->get(750), $i18n->get(167));
if ($session->setting->get("useKarma")) {
$ac->addSubmenuItem($session->url->page("op=editUserKarma;uid=$userId"), $i18n->get(555));

2
lib/WebGUI/Session/DateTime.pm
View file

@ -287,6 +287,7 @@ A string representing the output format for the date. Defaults to '%z %Z'. You c
%P = An upper-case AM/PM.
%s = A two digit second.
%t = Time zone name.
%V = week number.
%w = Day of the week.
%W = Day of the week abbreviated.
%y = A four digit year.
@ -331,6 +332,7 @@ sub epochToHuman {
"p" => "P",
"P" => "p",
"s" => "S",
"V" => "V",
"w" => "A",
"W" => "a",
"y" => "Y",

14
lib/WebGUI/Shop/Address.pm
View file

@ -1,5 +1,19 @@
package WebGUI::Shop::Address;
=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
use strict;
use Class::InsideOut qw{ :std };
use WebGUI::Exception::Shop;

8
lib/WebGUI/Shop/Cart.pm
View file

@ -820,7 +820,7 @@ sub www_view {
$self->update({shippingAddressId=>''});
}
# if there is no shipping address we can't check out
if (WebGUI::Error->caught) {
$var{shippingPrice} = $var{tax} = $self->formatCurrency(0);
@ -830,7 +830,6 @@ sub www_view {
else {
$var{hasShippingAddress} = 1;
$var{shippingAddress} = $address->getHtmlFormatted;
$var{tax} = $self->calculateTaxes;
my $ship = WebGUI::Shop::Ship->new($self->session);
my $options = $ship->getOptions($self);
my %formOptions = ();
@ -843,7 +842,10 @@ sub www_view {
$var{shippingPrice} = ($self->get("shipperId") ne "") ? $options->{$self->get("shipperId")}{price} : $options->{$defaultOption}{price};
$var{shippingPrice} = $self->formatCurrency($var{shippingPrice});
}
# Tax variables
$var{tax} = $self->calculateTaxes;
# POS variables
$var{isCashier} = WebGUI::Shop::Admin->new($session)->isCashier;
$var{posLookupForm} = WebGUI::Form::email($session, {name=>"posEmail"})

17
lib/WebGUI/Shop/PayDriver.pm
View file

@ -13,6 +13,7 @@ use WebGUI::Macro;
use WebGUI::User;
use WebGUI::Shop::Cart;
use JSON;
use Scalar::Util qw/blessed/;
=head1 NAME
@ -20,13 +21,13 @@ Package WebGUI::Shop::PayDriver
=head1 DESCRIPTION
This package is the base class for all modules which implement a pyament driver.
This package is the base class for all modules which implement a payment driver.
=head1 SYNOPSIS
use WebGUI::Shop::PayDriver;
my $tax = WebGUI::Shop::PayDriver->new($session);
my $payDriver = WebGUI::Shop::PayDriver->new($session);
=head1 METHODS
@ -616,11 +617,13 @@ sub processTransaction {
# determine object type
my $transaction;
my $paymentAddress;
if ($object->isa('WebGUI::Shop::Transaction')) {
$transaction = $object;
}
elsif ($object->isa('WebGUI::Shop::Address')) {
$paymentAddress = $object;
if (blessed $object) {
if ($object->isa('WebGUI::Shop::Transaction')) {
$transaction = $object;
}
elsif ($object->isa('WebGUI::Shop::Address')) {
$paymentAddress = $object;
}
}
# Setup dynamic transaction

745
lib/WebGUI/Shop/Tax.pm
View file

@ -1,14 +1,25 @@
package WebGUI::Shop::Tax;
=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
use strict;
use Class::InsideOut qw{ :std };
use WebGUI::Text;
use WebGUI::Storage;
use WebGUI::Exception::Shop;
use WebGUI::Shop::Admin;
use WebGUI::Shop::Cart;
use WebGUI::Shop::CartItem;
use WebGUI::Pluggable;
use List::Util qw{sum};
=head1 NAME
@ -21,10 +32,6 @@ This package manages tax information, and calculates taxes on a shopping cart.
in that the only data it contains is a WebGUI::Session object, but it does provide several methods for
handling the information in the tax tables.
Taxes are accumulated through increasingly specific geographic information. For example, you can
specify the sales tax for a whole country, then the additional sales tax for a state in the country,
all the way down to a single code inside of a city.
=head1 SYNOPSIS
use WebGUI::Shop::Tax;
@ -39,65 +46,36 @@ These subroutines are available from this package:
readonly session => my %session;
#-------------------------------------------------------------------
=head2 add ( [$params] )
Add tax information to the table. Returns the taxId of the newly created tax information.
=head3 $params
A hash ref of the geographic and rate information. The country and taxRate parameters
must have defined values.
=head4 country
The country this tax information applies to.
=head4 state
The state this tax information applies to. state and country together are unique.
=head4 city
The ciy this tax information applies to. Cities are unique with state and country information.
=head4 code
The postal code this tax information applies to. codes are unique with state and country information.
=head4 taxRate
This is the tax rate for the location, as specified by the geographical
fields country, state, city and/or code. The tax rate is stored as
a percentage, like 5.5 .
=cut
sub add {
my $self = shift;
my $params = shift;
WebGUI::Error::InvalidParam->throw(error => 'Must pass in a hashref of params')
unless ref($params) eq 'HASH';
WebGUI::Error::InvalidParam->throw(error => "Missing required information.", param => 'country')
unless exists($params->{country}) and $params->{country};
WebGUI::Error::InvalidParam->throw(error => "Missing required information.", param => 'taxRate')
unless exists($params->{taxRate}) and defined $params->{taxRate};
$params->{taxId} = 'new';
my $id = $self->session->db->setRow('tax', 'taxId', $params);
return $id;
}
##-------------------------------------------------------------------
#sub appendSkuForm {
# my $self = shift;
# my $assetId = shift;
# my $form = shift;
# my $db = $self->session->db;
#
# my $values = $db->buildHashRef( 'select name, value from skuTaxConfiguration where assetId=?', [
# $assetId,
# ] );
#
# my $definition = $self->getDriver->skuFormDefinition;
# foreach my $fieldName (keys %{ $definition }) {
# $form->dynamicField(
# %{ $definition->{ $fieldName } },
# name => $fieldName,
# value => $values->{ $fieldName },
# );
# }
#}
#-------------------------------------------------------------------
=head2 calculate ( $cart )
Calculate the tax for the contents of the cart. The tax rate is calculated off
of the shipping address stored in the cart. If an item in the cart has an alternate
address, that is used instead. Finally, if the item in the cart has a Sku with a tax
rate override, that rate overrides all. Returns 0 if no shipping address has been attached to the cart yet.
Calculate the tax for the contents of the cart.
=head3 cart
An instanciated cart object.
=cut
@ -107,241 +85,63 @@ sub calculate {
WebGUI::Error::InvalidParam->throw(error => 'Must pass in a WebGUI::Shop::Cart object')
unless ref($cart) eq 'WebGUI::Shop::Cart';
my $book = $cart->getAddressBook;
return 0 if $cart->get('shippingAddressId') eq "";
my $address = $book->getAddress($cart->get('shippingAddressId'));
my $tax = 0;
##Fetch the tax data for the cart address so it doesn't have to look it up for every item
##in the cart with that address.
my $cartTaxables = $self->getTaxRates($address);
# Fetch the default shipping address for each item in the cart that hasn't set its own.
my $shippingAddress = $book->getAddress( $cart->get('shippingAddressId') ) if $cart->get('shippingAddressId');
my $driver = $self->getDriver;
my $tax = 0;
foreach my $item (@{ $cart->getItems }) {
my $sku = $item->getSku;
my $unitPrice = $sku->getPrice;
my $quantity = $item->get('quantity');
##Check for an item specific shipping address
my $taxables;
my $sku = $item->getSku;
my $quantity = $item->get('quantity');
my $unitPrice = $sku->getPrice;
# Check if this cart item overrides the shipping address. If it doesn't, use the default shipping address.
my $itemAddress = $shippingAddress;
if (defined $item->get('shippingAddressId')) {
my $itemAddress = $book->getAddress($item->get('shippingAddressId'));
$taxables = $self->getTaxRates($itemAddress);
$itemAddress = $book->getAddress($item->get('shippingAddressId'));
}
else {
$taxables = $cartTaxables;
}
##Check for a SKU specific tax override rate
my $skuTaxRate = $sku->getTaxRate();
my $itemTax;
if (defined $skuTaxRate) {
$itemTax = $skuTaxRate;
}
else {
$itemTax = sum(@{$taxables});
}
$itemTax /= 100;
$tax += $unitPrice * $quantity * $itemTax;
my $taxRate = $driver->getTaxRate( $sku, $itemAddress );
# Calc the monetary tax for the given quantity of this item and add it to the total.
$tax += $unitPrice * $quantity * $taxRate / 100;
}
return $tax;
}
#-------------------------------------------------------------------
=head2 delete ( [$params] )
=head2 getDriver ( [ $session ] )
Deletes data from the tax table by taxId.
Return an instance of the enabled tax driver. This method can be invoked both as class or instance method. If you
invoke this method as a class method you must pass a WebGUI::Session object.
=head3 $params
=head3 session
A hashref containing the taxId of the data to delete from the table.
=head4 taxId
The taxId of the data to delete from the table.
A WebGUI::Session object. Required in class context, optional in instance context.
=cut
sub delete {
my $self = shift;
my $params = shift;
WebGUI::Error::InvalidParam->throw(error => 'Must pass in a hashref of params')
unless ref($params) eq 'HASH';
WebGUI::Error::InvalidParam->throw(error => "Hash ref must contain a taxId key with a defined value")
unless exists($params->{taxId}) and defined $params->{taxId};
$self->session->db->write('delete from tax where taxId=?', [$params->{taxId}]);
return;
}
#-------------------------------------------------------------------
=head2 exportTaxData ( )
Creates a tab deliniated file containing all the information from
the tax table. Returns a temporary WebGUI::Storage object containing
the file. The file will be named "siteTaxData.csv".
=cut
sub exportTaxData {
my $self = shift;
my $taxIterator = $self->getItems;
my @columns = grep { $_ ne 'taxId' } $taxIterator->getColumnNames;
my $taxData = WebGUI::Text::joinCSV(@columns) . "\n";
while (my $taxRow = $taxIterator->hashRef() ) {
my @taxData = @{ $taxRow }{@columns};
foreach my $column (@taxData) {
$column =~ tr/,/|/; ##Convert to the alternation syntax for the text file
}
$taxData .= WebGUI::Text::joinCSV(@taxData) . "\n";
sub getDriver {
my $self = shift;
my $session = shift || $self->session;
unless (defined $session && $session->isa("WebGUI::Session")) {
WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Session", got=>(ref $session), error=>"Need a session.");
}
my $storage = WebGUI::Storage->createTemp($self->session);
$storage->addFileFromScalar('siteTaxData.csv', $taxData);
return $storage;
}
#-------------------------------------------------------------------
=head2 getAllItems ( )
Returns an arrayref of hashrefs, where each hashref is the data for one row of
tax data. taxId is dropped from the dataset.
=cut
sub getAllItems {
my $self = shift;
my $taxes = $self->session->db->buildArrayRefOfHashRefs('select country,state,city,code,taxRate from tax order by country, state');
return $taxes;
}
#-------------------------------------------------------------------
=head2 getItems ( )
Returns a WebGUI::SQL::Result object for accessing all of the data in the tax table. This
is a convenience method for listing and/or exporting tax data.
=cut
sub getItems {
my $self = shift;
my $result = $self->session->db->read('select * from tax order by country, state');
return $result;
}
#-------------------------------------------------------------------
=head2 getTaxRates ( $address )
Given a WebGUI::Shop::Address object, return all rates associated with the address as an arrayRef.
=cut
sub getTaxRates {
my $self = shift;
my $address = shift;
WebGUI::Error::InvalidObject->throw(error => 'Need an address.', expected=>'WebGUI::Shop::Address', got=>(ref $address))
unless ref($address) eq 'WebGUI::Shop::Address';
my $country = $address->get('country');
my $state = $address->get('state');
my $city = $address->get('city');
my $code = $address->get('code');
my $result = $self->session->db->buildArrayRef(
q{
select taxRate from tax where find_in_set(?, country)
and (state='' or find_in_set(?, state))
and (city='' or find_in_set(?, city))
and (code='' or find_in_set(?, code))
},
[ $country, $state, $city, $code, ]);
return $result;
}
#-------------------------------------------------------------------
=head2 importTaxData ( $filePath )
Import tax information from the specified file in CSV format. The
first line of the file should contain only the name of the columns, in
any order. It may not contain any comments.
These are the column names, each is required:
=over 4
=item *
country
=item *
state
=item *
city
=item *
code
=item *
taxRate
=back
The following lines will contain tax information. Blank
lines and anything following a '#' sign will be ignored from
the second line of the file, on to the end.
Returns 1 if the import has taken place. This is to help you know
if old data has been deleted and new has been inserted. If an error is
detected, it will throw exceptions.
=head3 $filePath
The path to a file with data to import into the Product system.
=cut
sub importTaxData {
my $self = shift;
my $filePath = shift;
WebGUI::Error::InvalidParam->throw(error => q{Must provide the path to a file})
unless $filePath;
WebGUI::Error::InvalidFile->throw(error => qq{File could not be found}, brokenFile => $filePath)
unless -e $filePath;
WebGUI::Error::InvalidFile->throw(error => qq{File is not readable}, brokenFile => $filePath)
unless -r $filePath;
open my $table, '<', $filePath or
WebGUI::Error->throw(error => qq{Unable to open $filePath for reading: $!\n});
my $headers;
$headers = <$table>;
chomp $headers;
my @headers = WebGUI::Text::splitCSV($headers);
WebGUI::Error::InvalidFile->throw(error => qq{Bad header found in the CSV file}, brokenFile => $filePath)
unless (join(q{-}, sort @headers) eq 'city-code-country-state-taxRate')
and (scalar @headers == 5);
my @taxData = ();
my $line = 1;
while (my $taxRow = <$table>) {
chomp $taxRow;
$taxRow =~ s/\s*#.+$//;
next unless $taxRow;
local $_;
my @taxRow = map { tr/|/,/; $_; } WebGUI::Text::splitCSV($taxRow);
WebGUI::Error::InvalidFile->throw(error => qq{Error found in the CSV file}, brokenFile => $filePath, brokenLine => $line)
unless scalar @taxRow == 5;
push @taxData, [ @taxRow ];
my $className = $session->setting->get( 'activeTaxPlugin' );
my $driver = eval {
WebGUI::Pluggable::instanciate( $className, 'new', [ $session ] );
};
if ($@) {
$session->log->error("Can't instanciate tax driver [$className] because $@");
return undef;
}
##Okay, if we got this far, then the data looks fine.
return unless scalar @taxData;
$self->session->db->beginTransaction;
$self->session->db->write('delete from tax');
foreach my $taxRow (@taxData) {
my %taxRow;
@taxRow{ @headers } = @{ $taxRow }; ##Must correspond 1:1, or else...
$self->add(\%taxRow);
}
$self->session->db->commit;
return 1;
return $driver;
}
#-------------------------------------------------------------------
@ -355,6 +155,9 @@ Constructor for the WebGUI::Shop::Tax. Returns a WebGUI::Shop::Tax object.
sub new {
my $class = shift;
my $session = shift;
unless (defined $session && $session->isa("WebGUI::Session")) {
WebGUI::Error::InvalidObject->throw(expected=>"WebGUI::Session", got=>(ref $session), error=>"Need a session.");
}
my $self = {};
bless $self, $class;
register $self;
@ -362,6 +165,8 @@ sub new {
return $self;
}
#-------------------------------------------------------------------
=head2 session ( )
@ -372,148 +177,35 @@ Accessor for the session object. Returns the session object.
#-------------------------------------------------------------------
=head2 www_deleteTax ( )
=head2 www_do ( )
Delete a row of tax information, using the form variable taxId as
the id of the row to delete.
Allows tax drivers to define their own www_ methods. Pass the www_ method that must be executed in the 'do' form
var.
=cut
sub www_deleteTax {
my $self = shift;
my $session = $self->session;
my $admin = WebGUI::Shop::Admin->new($session);
return $session->privilege->insufficient
unless $admin->canManage;
my $taxId = $session->form->get('taxId');
$self->delete({ taxId => $taxId });
return $self->www_manage;
}
#-------------------------------------------------------------------
=head2 www_addTax ( )
Add new tax information into the database, via the UI.
=cut
sub www_addTax {
sub www_do {
my $self = shift;
my $session = $self->session;
my $admin = WebGUI::Shop::Admin->new($session);
return $session->privilege->insufficient
unless $admin->canManage;
my $params;
my ($form) = $session->quick('form');
$params->{country} = $form->get('country', 'text');
$params->{state} = $form->get('state', 'text');
$params->{city} = $form->get('city', 'text');
$params->{code} = $form->get('code', 'text');
$params->{taxRate} = $form->get('taxRate', 'float');
$self->add($params);
return $self->www_manage;
}
#-------------------------------------------------------------------
my $taxDriver = $self->getDriver;
my $method = 'www_' . $session->form->process( 'do' );
=head2 www_exportTax ( )
return "Invalid method name" unless $method =~ m{ ^[a-zA-Z0-9_]+$ }xms;
Export the entire tax table as a CSV file the user can download.
if ( $taxDriver->can( $method ) ) {
my $output = eval{ $taxDriver->$method };
=cut
sub www_exportTax {
my $self = shift;
my $session = $self->session;
my $admin = WebGUI::Shop::Admin->new($session);
return $session->privilege->insufficient
unless $admin->canManage;
my $storage = $self->exportTaxData();
$self->session->http->setRedirect($storage->getUrl($storage->getFiles->[0]));
return "redirect";
}
#-------------------------------------------------------------------
=head2 www_getTaxesAsJson ( )
Servers side pagination for tax data that is sent as JSON back to the browser to be
displayed in a YUI DataTable.
=cut
sub www_getTaxesAsJson {
my ($self) = @_;
my $session = $self->session;
my $admin = WebGUI::Shop::Admin->new($session);
return $session->privilege->insufficient
unless $admin->canManage;
my ($db, $form) = $session->quick(qw(db form));
my $startIndex = $form->get('startIndex') || 0;
my $numberOfResults = $form->get('results') || 25;
my %goodKeys = qw/country 1 state 1 city 1 code 1 'tax rate' 1/;
my $sortKey = $form->get('sortKey');
$sortKey = $goodKeys{$sortKey} == 1 ? $sortKey : 'country';
my $sortDir = $form->get('sortDir');
$sortDir = lc($sortDir) eq 'desc' ? 'desc' : 'asc';
my @placeholders = ();
my $sql = 'select SQL_CALC_FOUND_ROWS * from tax';
my $keywords = $form->get("keywords");
if ($keywords ne "") {
$db->buildSearchQuery(\$sql, \@placeholders, $keywords, [qw{country state city code}])
}
push(@placeholders, $startIndex, $numberOfResults);
$sql .= sprintf (" order by %s limit ?,?","$sortKey $sortDir");
my %results = ();
my @records = ();
my $sth = $db->read($sql, \@placeholders);
while (my $record = $sth->hashRef) {
push(@records,$record);
}
$results{'recordsReturned'} = $sth->rows()+0;
$sth->finish;
$results{'records'} = \@records;
$results{'totalRecords'} = $db->quickScalar('select found_rows()')+0; ##Convert to numeric
$results{'startIndex'} = $startIndex;
$results{'sort'} = undef;
$results{'dir'} = $sortDir;
$session->http->setMimeType('application/json');
return JSON::to_json(\%results);
}
#-------------------------------------------------------------------
=head2 www_importTax ( )
Import new tax data from a file provided by the user. This will replace the current
data with the new data.
=cut
sub www_importTax {
my $self = shift;
my $session = $self->session;
my $admin = WebGUI::Shop::Admin->new($session);
return $session->privilege->insufficient
unless $admin->canManage;
my $storage = WebGUI::Storage->create($session);
my $taxFile = $storage->addFileFromFormPost('importFile', 1);
eval {
$self->importTaxData($storage->getPath($taxFile)) if $taxFile;
};
my ($exception, $status_message);
if ($exception = Exception::Class->caught('WebGUI::Error::InvalidFile')) {
$status_message = sprintf 'A problem was found with your file: %s',
$exception->error;
if ($exception->brokenLine) {
$status_message .= sprintf ' on line %d', $exception->brokenLine;
if ($@) {
$session->log->error("An error occurred while executing method [$method] on active tax driver: $@");
return "An error occurred while executing a method on a tax driver. Please consult the webgui log.";
}
else {
return $output || $self->www_manage;
}
}
elsif ($exception = Exception::Class->caught()) {
$status_message = sprintf 'A problem happened during the import: %s', $exception->error;
}
return $self->www_manage($status_message);
return "Cannot call method [$method] on active tax driver.";
}
#-------------------------------------------------------------------
@ -531,154 +223,107 @@ import.
=cut
sub www_manage {
my $self = shift;
my $status_message = shift;
my $session = $self->session;
my $admin = WebGUI::Shop::Admin->new($session);
return $session->privilege->insufficient
unless $admin->canManage;
##YUI specific datatable CSS
my ($style, $url) = $session->quick(qw(style url));
$style->setLink($url->extras('/yui/build/fonts/fonts-min.css'), {rel=>'stylesheet', type=>'text/css'});
$style->setLink($url->extras('yui/build/datatable/assets/skins/sam/datatable.css'), {rel=>'stylesheet', type => 'text/CSS'});
$style->setLink($url->extras('yui/build/paginator/assets/skins/sam/paginator.css'), {rel=>'stylesheet', type => 'text/CSS'});
$style->setScript($url->extras('/yui/build/utilities/utilities.js'), {type=>'text/javascript'});
$style->setScript($url->extras('yui/build/json/json-min.js'), {type => 'text/javascript'});
$style->setScript($url->extras('yui/build/paginator/paginator-min.js'), {type => 'text/javascript'});
$style->setScript($url->extras('yui/build/datasource/datasource-min.js'), {type => 'text/javascript'});
##YUI Datatable
$style->setScript($url->extras('yui/build/datatable/datatable-min.js'), {type => 'text/javascript'});
##Default CSS
$style->setRawHeadTags('<style type="text/css"> #paging a { color: #0000de; } #search, #export form { display: inline; } </style>');
my $i18n=WebGUI::International->new($session, 'Tax');
my $self = shift;
my $status_message = shift;
my $session = $self->session;
my $admin = WebGUI::Shop::Admin->new( $session );
my $exportForm = WebGUI::Form::formHeader($session,{action => $url->page('shop=tax;method=exportTax')})
. WebGUI::Form::submit($session,{value=>$i18n->get('export tax','Shop'), extras=>q{style="float: left;"} })
. WebGUI::Form::formFooter($session);
my $importForm = WebGUI::Form::formHeader($session,{action => $url->page('shop=tax;method=importTax')})
. WebGUI::Form::submit($session,{value=>$i18n->get('import tax','Shop'), extras=>q{style="float: left;"} })
. q{<input type="file" name="importFile" size="10" />}
. WebGUI::Form::formFooter($session);
return $session->privilege->insufficient unless $admin->canManage;
my $addForm = WebGUI::HTMLForm->new($session,action=>$url->page('shop=tax;method=addTax'));
$addForm->text(
label => $i18n->get('country'),
hoverHelp => $i18n->get('country help'),
name => 'country',
);
$addForm->text(
label => $i18n->get('state'),
hoverHelp => $i18n->get('state help'),
name => 'state',
);
$addForm->text(
label => $i18n->get('city'),
hoverHelp => $i18n->get('city help'),
name => 'city',
);
$addForm->text(
label => $i18n->get('code'),
hoverHelp => $i18n->get('code help'),
name => 'code',
);
$addForm->float(
label => $i18n->get('tax rate'),
hoverHelp => $i18n->get('tax rate help'),
name => 'taxRate',
);
$addForm->submit(
value => $i18n->get('add a tax'),
);
my $output;
if ($status_message) {
$output = <<EOSM;
<div class="error">
$status_message
</div>
EOSM
}
$output .= q|
<div class="yui-skin-sam">
<div id="search"><form id="keywordSearchForm"><input type="text" name="keywords" id="keywordsField" /><input type="submit" value="|.$i18n->get(364, 'WebGUI').q|" /></form></div>
<div id="dynamicdata"></div>
<div id="adding">|.$addForm->print.q|</div>
<div id="importExport">|.$exportForm.$importForm.q|</div>
</div>
my ($style, $url) = $session->quick( qw(style url) );
my $i18n = WebGUI::International->new( $session, 'Tax' );
<script type="text/javascript">
var taxtable = function() {
// Column definitions
formatDeleteTaxId = function(elCell, oRecord, oColumn, orderNumber) {
elCell.innerHTML = '<a href="|.$url->page(q{shop=tax;method=deleteTax}).q|;taxId='+oRecord.getData('taxId')+'">|.$i18n->get('delete').q|</a>';
};
var myColumnDefs = [ // sortable:true enables sorting
{key:"country", label:"|.$i18n->get('country').q|", sortable: true},
{key:"state", label:"|.$i18n->get('state').q|", sortable: true},
{key:"city", label:"|.$i18n->get('city').q|", sortable: true},
{key:"code", label:"|.$i18n->get('code').q|", sortable: true},
{key:"taxRate", label:"|.$i18n->get('tax rate').q|"},
{key:"taxId", label:"", formatter:formatDeleteTaxId}
];
// DataSource instance
var myDataSource = new YAHOO.util.DataSource("|.$url->page('shop=tax;method=getTaxesAsJson;').q|");
myDataSource.responseType = YAHOO.util.DataSource.TYPE_JSON;
myDataSource.responseSchema = {
resultsList: "records",
fields: [
{key:"country", parser:"string"},
{key:"state", parser:"string"},
{key:"city", parser:"string"},
{key:"code", parser:"string"},
{key:"taxRate", parser:"number"},
{key:"taxId", parser:"string"}
],
metaFields: {
totalRecords: "totalRecords" // Access to value in the server response
}
};
// DataTable configuration
var myConfigs = {
initialRequest: 'startIndex=0;results=25', // Initial request for first page of data
dynamicData: true, // Enables dynamic server-driven data
sortedBy : {key:"country", dir:YAHOO.widget.DataTable.CLASS_ASC}, // Sets UI initial sort arrow
paginator: new YAHOO.widget.Paginator({ rowsPerPage:25 }) // Enables pagination
};
// DataTable instance
var myDataTable = new YAHOO.widget.DataTable("dynamicdata", myColumnDefs, myDataSource, myConfigs);
// Update totalRecords on the fly with value from server to allow pagination
myDataTable.handleDataReturnPayload = function(oRequest, oResponse, oPayload) {
oPayload.totalRecords = oResponse.meta.totalRecords;
return oPayload;
}
my $activePlugin = $session->setting->get( 'activeTaxPlugin' );
my $plugins = $session->config->get( 'taxDrivers' );
my %options = map { $_ => $_ } @{ $plugins };
//Setup the form to submit an AJAX request back to the site.
YAHOO.util.Dom.get('keywordSearchForm').onsubmit = function () {
var state = myDataTable.getState();
state.pagination.recordOffset = 0;
myDataSource.sendRequest('keywords=' + YAHOO.util.Dom.get('keywordsField').value + ';startIndex=0;results=25', {success: myDataTable.onDataReturnInitializeTable, scope:myDataTable, argument:state});
return false;
};
return {
ds: myDataSource,
dt: myDataTable
};
my $pluginSwitcher =
'<fieldset><legend>Active tax plugin</legend>'
. WebGUI::Form::formHeader( $session )
. WebGUI::Form::hidden( $session, { name => 'shop', value => 'tax' } )
. WebGUI::Form::hidden( $session, { name => 'method', value => 'setActivePlugin' } )
. 'Active Tax Plugin '
. WebGUI::Form::selectBox( $session, { name => 'className', value => $activePlugin, options => \%options } )
. WebGUI::Form::submit( $session, { value => 'Switch' } )
. WebGUI::Form::formFooter( $session )
. '</fieldset>'
;
# my $output;
# if ($status_message) {
# $output = qq{<div class="error">$status_message</div>};
# }
}();
my $taxDriver = $self->getDriver;
my $output =
$pluginSwitcher
. '<fieldset><legend>Plugin configuration</legend>'
. $taxDriver->getConfigurationScreen
. '</fieldset>'
;
</script>
|;
return $admin->getAdminConsole->render($output, $i18n->get('taxes', 'Shop'));
}
#-------------------------------------------------------------------
=head2 www_setActivePlugin ( )
Displays a warning that informs users that they're about to change the active taxing plugin. Includes a confirm and
cancel button.
=cut
sub www_setActivePlugin {
my $self = shift;
my $session = $self->session;
my $admin = WebGUI::Shop::Admin->new( $session );
return $session->privilege->insufficient unless $admin->canManage;
my $message =
'Changing the active tax plugin will change the way tax is calulated on <b>all</b> products you sell. '
. 'Are you really sure you want to switch?';
my $proceedForm =
WebGUI::Form::formHeader( $session )
. WebGUI::Form::hidden( $session, { name => 'shop', value => 'tax' } )
. WebGUI::Form::hidden( $session, { name => 'method', value => 'setActivePluginConfirm' } )
. WebGUI::Form::hidden( $session, { name => 'className', value => $session->form->process('className') } )
. WebGUI::Form::submit( $session, { value => 'Proceed' } )
. WebGUI::Form::formFooter( $session );
my $cancelForm =
WebGUI::Form::formHeader( $session )
. WebGUI::Form::hidden( $session, { name => 'shop', value => 'tax' } )
. WebGUI::Form::hidden( $session, { name => 'method', value => 'manage' } )
. WebGUI::Form::submit( $session, { value => 'Cancel', extras => 'class="backwardButton"' } )
. WebGUI::Form::formFooter( $session );
my $output = $message . $proceedForm . $cancelForm;
return $admin->getAdminConsole->render( $output, 'Switch tax plugin' );
}
#-------------------------------------------------------------------
=head2 www_setActivePluginConfirm ( )
Actually changes the active tax driver.
=cut
sub www_setActivePluginConfirm {
my $self = shift;
my $session = $self->session;
my $admin = WebGUI::Shop::Admin->new( $session );
return $session->privilege->insufficient unless $admin->canManage;
my $className = $session->form->process( 'className', 'className' );
#### TODO: Check aginst list of available plugins.
$session->setting->set( 'activeTaxPlugin', $className );
return $self->www_manage;
}
1;

285
lib/WebGUI/Shop/TaxDriver.pm Normal file
View file

@ -0,0 +1,285 @@
package WebGUI::Shop::TaxDriver;
=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
=head1 NAME
Package WebGUI::Shop::TaxDriver
=head1 DESCRIPTION
This package is the base class for all modules which implement a tax driver.
=head1 SYNOPSIS
use WebGUI::Shop::TaxDriver;
my $taxDriver = WebGUI::Shop::TaxDriver->new($session);
=head1 METHODS
These subroutines are available from this package:
=cut
use strict;
use Class::InsideOut qw{ :std };
use JSON qw{ from_json to_json };
=head1 NAME
Package WebGUI::Shop::TaxDriver
=head1 DESCRIPTION
Base class for all modules which do tax calculations in the Shop.
=head1 SYNOPSIS
use base WebGUI::Shop::TaxDriver;
my $driver = WebGUI::Shop::TaxDriver->new($session);
=head1 METHODS
These subroutines are available from this package:
=cut
readonly session => my %session;
readonly messages => my %messages;
private options => my %options;
#-----------------------------------------------------------
=head2 appendTaxDetailVars ($var)
=head3 $var
=cut
sub appendTaxDetailVars {
my $self = shift;
my $var = shift;
return $var;
}
#-----------------------------------------------------------
=head2 canManage
Returns true if the current user can manage taxes.
=cut
sub canManage {
my $self = shift;
my $admin = WebGUI::Shop::Admin->new( $self->session );
return $admin->canManage;
}
#-----------------------------------------------------------
=head2 className {
Returns the class name of your plugin. You must overload this method in you own plugin.
=cut
sub className {
my $self = shift;
$self->session->log->fatal( "Tax plugin ($self) is required to overload the className method" );
}
#-----------------------------------------------------------
=head2 get ( [ property ] )
Returns the value of the requested configuration property. Returns a hash ref of all property/value pairs when no
specific property is passed.
=head3 property
The property whose value should be returned.
=cut
sub get {
my $self = shift;
my $key = shift;
my $options = $options{ id $self };
# Return safe copy of options hash if no key is passed.
return { %{ $options } } unless $key;
# Return option if key is passed.
return $options->{ $key } if exists $options->{ $key };
# Key does not exist.
$self->session->log->warn( "Non-existant option [$key] was queried by tax plugin $self" );
return undef;
}
#-----------------------------------------------------------
=head2 getConfigurationScreen ( )
Returns the configuration screen that contains the configuration options for this plugin in the admin console.
=cut
sub getConfigurationScreen {
return 'This plugin has no configuration options';
}
#-----------------------------------------------------------
=head2 getTaxRate ( sku, [ address ] )
Returns the tax rate in percents (eg. 19 for a rate of 19%) for the given sku and shipping address. Your tax driver
must overload this method.
Note that address is optional and that it's up to your plugin to handle that case.
=head3 sku
The sku for which the tax rate must be determined. Should be a WebGUI::Asset::Sku::* instance.
=head3 address
Optional, the shipping address for which to calculate the tax. Must be an instance of WebGUI::Shop::Address.
=cut
sub getTaxRate {
my $self = shift;
$self->session->log->fatal("Tax plugin ". $self->className ." is required to overload getTaxRate");
}
#-----------------------------------------------------------
=head2 getUserScreen ( )
Returns the screen for entering per user configuration for this tax driver.
=cut
sub getUserScreen {
return 'There are no tax options to configure.';
}
#-----------------------------------------------------------
=head2 skuFormDefinition ( )
Returns a hash ref containing the form defintion for the per sku options for this tax driver.
=cut
sub skuFormDefinition {
return {};
}
#-------------------------------------------------------------------
=head2 new ( $session )
Constructor
=head3 session
Instanciated WebGUI::Session object.
=cut
sub new {
my $class = shift;
my $session = shift;
my $self = {};
bless $self, $class;
register $self;
my $id = id $self;
$session{ $id } = $session;
$messages{ $id } = [];
# Load plugin configuration
my $optionsJSON = $session->db->quickScalar( 'select options from taxDriver where className=?', [
$self->className,
] );
$options{ $id } = $optionsJSON ? from_json( $optionsJSON ) : {};
return $self;
}
#-------------------------------------------------------------------
=head2 processSkuFormPost ( )
Processes the form parameters defined in the skuFormDefinition method and returns a hash ref containing the result.
=cut
sub processSkuFormPost {
my $self = shift;
my $form = $self->session->form;
my $configuration = {};
my $definition = $self->skuFormDefinition;
foreach my $fieldName ( keys %{ $definition } ) {
my ($fieldType, $defaultValue) = @{ $definition->{ $fieldName } }{ qw{ fieldType defaultValue } };
$configuration->{ $fieldName } = $form->process( $fieldName, $fieldType, $defaultValue );
}
return $configuration;
}
#-----------------------------------------------------------
=head2 update ( properties )
Updates the properties of the tax driver according to those passed.
=head3 properties
Hash ref containing the properties to set.
=cut
sub update {
my $self = shift;
my $update = shift;
my $db = $self->session->db;
# update local options hash
$options{ id $self } = { %{ $options{ id $self } }, %{ $update } };
# Persist to db
$db->write( 'replace into taxDriver (className, options) values (?,?)', [
$self->className,
to_json( $options{ id $self } ),
] );
}
1;

562
lib/WebGUI/Shop/TaxDriver/EU.pm Normal file
View file

@ -0,0 +1,562 @@
package WebGUI::Shop::TaxDriver::EU;
=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
use strict;
use SOAP::Lite;
use WebGUI::Content::Account;
use WebGUI::TabForm;
use WebGUI::Utility qw{ isIn };
use base qw{ WebGUI::Shop::TaxDriver };
=head1 NAME
Package WebGUI::Shop::TaxDriver::EU
=head1 DESCRIPTION
This package manages tax information, and calculates taxes on a shopping cart specifically handling
European Union VAT taxes.
=head1 SYNOPSIS
use WebGUI::Shop::Tax;
my $tax = WebGUI::Shop::Tax->new($session);
=head1 METHODS
These subroutines are available from this package:
=cut
my $EU_COUNTRIES = {
AT => 'Austria',
BE => 'Belgium',
BG => 'Bulgaria',
CY => 'Cyprus',
CZ => 'Czech Republic',
DE => 'Germany',
DK => 'Denmark',
EE => 'Estonia',
EL => 'Greece',
ES => 'Spain',
FI => 'Finland',
FR => 'France ',
GB => 'United Kingdom',
HU => 'Hungary',
IE => 'Ireland',
IT => 'Italy',
LT => 'Lithuania',
LU => 'Luxembourg',
LV => 'Latvia',
MT => 'Malta',
NL => 'Netherlands',
PL => 'Poland',
PT => 'Portugal',
RO => 'Romania',
SE => 'Sweden',
SI => 'Slovenia',
SK => 'Slovakia',
};
#-------------------------------------------------------------------
=head2 className
Returns the name of this class.
=cut
sub className {
return 'WebGUI::Shop::TaxDriver::EU';
}
#-----------------------------------------------------------
=head2 getConfigurationScreen ( )
Returns the form that contains the configuration options for this plugin in the admin console.
=cut
sub getConfigurationScreen {
my $self = shift;
my $session = $self->session;
my $taxGroups = $self->get( 'taxGroups' ) || [];
# General setting form
my $f = WebGUI::HTMLForm->new( $session );
$f->hidden(
name => 'shop',
value => 'tax',
);
$f->hidden(
name => 'method',
value => 'do',
);
$f->hidden(
name => 'do',
value => 'saveConfiguration',
);
$f->selectBox(
name => 'shopCountry',
value => $self->get( 'shopCountry' ),
label => 'Residential country',
hoverHelp => 'The country where your shop resides.',
options => $EU_COUNTRIES,
);
$f->submit;
my $general = $f->print;
# VAT groups manager
my $vatGroups = '<b>VAT groups</b><br />';
$vatGroups .= q{<table><thead><tr><th>Group name</th><th>Rate</th></tr></thead><tbody>};
foreach my $group ( @{ $taxGroups} ) {
my $deleteUrl = $session->url->page('shop=tax;method=do;do=deleteGroup;groupId=' . $group->{ id });
my $makeDefaultUrl = $session->url->page('shop=tax;method=do;do=setDefaultGroup;groupId=' . $group->{ id });
$vatGroups .=
q{<tr><td>}
. join( '</td><td>',
$group->{ name } . ( $group->{ id } eq $self->get( 'defaultGroup' ) ? '<i>(default)</i>' : '' ),
$group->{ rate },
qq{<a href="$deleteUrl">delete</a>},
qq{<a href="$makeDefaultUrl">Set as default group</a>},
)
. q{</td></tr>};
}
$vatGroups .= q{</tbody></table>};
$vatGroups .=
WebGUI::Form::formHeader( $session )
. WebGUI::Form::hidden( $session, { name => 'shop', value => 'tax' } )
. WebGUI::Form::hidden( $session, { name => 'method', value => 'do' } )
. WebGUI::Form::hidden( $session, { name => 'do', value => 'addGroup' } )
. 'Name '
. WebGUI::Form::text( $session, { name => 'name' } )
. ' Rate '
. WebGUI::Form::float( $session, { name => 'rate' } )
. '%'
. WebGUI::Form::submit( $session, { value => 'Add' } )
. WebGUI::Form::formFooter( $session );
# Wrap output in a YUI Tab widget.
my ($style, $url) = $session->quick( qw{ style url } );
$style->setLink($self->{_css},{rel=>"stylesheet", rel=>"stylesheet",type=>"text/css"});
$style->setLink($url->extras('/yui/build/fonts/fonts-min.css'),{type=>"text/css", rel=>"stylesheet"});
$style->setLink($url->extras('/yui/build/tabview/assets/skins/sam/tabview.css'),{type=>"text/css", rel=>"stylesheet"});
$style->setLink($url->extras('/yui/build/container/assets/container.css'),{ type=>'text/css', rel=>"stylesheet" });
$style->setLink($url->extras('/hoverhelp.css'),{ type=>'text/css', rel=>"stylesheet" });
$style->setScript($url->extras('/yui/build/utilities/utilities.js'),{ type=>'text/javascript' });
$style->setScript($url->extras('/yui/build/container/container-min.js'),{ type=>'text/javascript' });
$style->setScript($url->extras('/yui/build/tabview/tabview-min.js'),{ type=>'text/javascript' });
$style->setScript($url->extras('/hoverhelp.js'),{ type=>'text/javascript' });
my $output = <<EOHTML;
<div class="yui-skin-sam">
<div id="webguiTabForm" class="yui-navset">
<ul class="yui-nav">
<li class="selected"><a href="#tab1" ><em>General configuration</em></a></li>
<li ><a href="#tab2" ><em>VAT Groups</em></a></li>
</ul>
<div class="yui-content">
<div id="tab1">$general</div>
<div id="tab2">$vatGroups</div>
</div>
</div>
</div>
<script type="text/javascript"> var tabView = new YAHOO.widget.TabView('webguiTabForm'); </script>
EOHTML
return $output;
}
#-------------------------------------------------------------------
=head2 getCountryCode ($countryName)
Given a country name, return a 2 character country code.
=head3 $countryName
The name of the country to look up.
=cut
sub getCountryCode {
my $self = shift;
my $countryName = shift;
# Do reverse lookup on eu countries hash
return { reverse %{ $EU_COUNTRIES } }->{ $countryName };
}
#-------------------------------------------------------------------
=head2 getCountryName ($countryCode)
Given a 2 character country code, return the name of the country.
=head3 $countryCode
The code of the country to look up.
=cut
sub getCountryName {
my $self = shift;
my $countryCode = shift;
return $EU_COUNTRIES->{ $countryCode };
}
#-------------------------------------------------------------------
=head2 getGroupRate ($taxGroupId)
=head3 $taxGroupId
=cut
sub getGroupRate {
my $self = shift;
my $taxGroupId = shift;
my $taxGroups = $self->get( 'taxGroups' );
my ($group) = grep { $_->{ id } eq $taxGroupId } @{ $taxGroups };
return $group->{ rate };
}
#-------------------------------------------------------------------
=head2 getUserScreen ( )
Returns the screen for entering per user configuration for this tax driver.
=cut
sub getUserScreen {
my $self = shift;
my $url = $self->session->url;
my $output = '<b>VAT Numbers</b><br />'
. '<table><thead><tr><th>Country</th><th>VAT Number</th></tr></thead><tbody>';
foreach my $number ( @{ $self->getVATNumbers } ) {
my $deleteUrl = $url->page('shop=tax;method=do;do=deleteVATNumber;vatNumber='.$number->{ vatNumber });
$output .=
'<tr><td>'
. join( '</td><td>',
$self->getCountryName( $number->{ countryCode } ),
$number->{ vatNumber },
$number->{ name },
$number->{ address },
$number->{ approved },
qq{<a href="$deleteUrl">delete</a>},
)
. '</td></tr>'
;
}
$output .= '</tbody></table>';
my $f = WebGUI::HTMLForm->new( $self->session );
$f->hidden(
name => 'shop',
value => 'tax',
);
$f->hidden(
name => 'method',
value => 'do',
);
$f->hidden(
name => 'do',
value => 'addVATNumber',
);
$f->text(
name => 'vatNumber',
label => 'VAT Number',
);
$f->submit(
value => 'Add',
);
$output .= $f->print;
return $output;
}
#-------------------------------------------------------------------
=head2 getTaxRate ( sku, [ address ] )
Returns the tax rate in percents (eg. 19 for a rate of 19%) for the given sku and shipping address. Implements
EU VAT taxes and group rates.
=cut
sub getTaxRate {
my $self = shift;
my $sku = shift;
my $address = shift;
my $config = $sku->getTaxConfiguration( $self->className );
# Fetch the tax group from the sku. If the sku has none, use the default tax group.
my $taxGroupId = $config->{ taxGroup } || $self->get( 'defaultGroup' );
my $taxRate = $self->getGroupRate( $taxGroupId );
# No shipping address yet. Return group tax rate.
return $taxRate unless defined $address;
# Shipping address outside EU? That means exporting so no VAT.
my $country = $self->getCountryCode( $address->get( 'country' ) );
return 0 unless defined $country;
# Shipping address in same country as shop? Pay VAT;
return $taxRate if $country eq $self->get('shopCountry');
# Customer has VAT number in shipping country? Exempt from paying VAT.
return 0 if $self->hasVATNumber( $country );
# Customer has no VAT number and resides in EU. Pay VAT;
return $taxRate;
}
#-------------------------------------------------------------------
=head2 getVATNumbers ($countryCode)
=head3 $countryCode
=cut
sub getVATNumbers {
my $self = shift;
my $countryCode = shift;
my $session = $self->session;
my $sql = 'select * from tax_eu_vatNumbers where userId=?';
my $placeHolders = [ $session->user->userId ];
if ( $countryCode ) {
$sql .= ' and countryCode=?';
push @{ $placeHolders }, $countryCode;
}
my $numbers = $session->db->buildArrayRefOfHashRefs( $sql, $placeHolders );
return $numbers;
}
#-------------------------------------------------------------------
=head2 hasVATNumber ($countrycode)
=head3 $countryCode
=cut
sub hasVATNumber {
my $self = shift;
my $countryCode = shift;
my $numbers = $self->getVATNumbers( $countryCode );
return 0 unless @{ $numbers };
return $numbers->[0]->{ approved };
}
#-------------------------------------------------------------------
=head2 skuFormDefinition ( )
Returns a hash ref containing the form defintion for the per sku options for this tax driver.
=cut
sub skuFormDefinition {
my $self = shift;
my $taxGroups = $self->get( 'taxGroups' );
# If no tax groups are defined there's no need to add a form element.
return {} unless $taxGroups;
my %options =
map { $_->{ id } => "$_->{ name } ($_->{ rate } \%)" }
@{ $taxGroups };
tie my %definition, 'Tie::IxHash', (
taxGroup => {
fieldType => 'selectBox',
label => 'Tax group',
options => \%options,
}
);
return \%definition;
}
#-------------------------------------------------------------------
=head2 www_addGroup
=cut
sub www_addGroup {
my $self = shift;
my $form = $self->session->form;
return $self->session->privilege->insufficient unless $self->canManage;
my $groups = $self->get( 'taxGroups' ) || [];
my $name = $form->process( 'name' );
my $rate = $form->process( 'rate' );
my $id = $self->session->id->generate;
push @{ $groups }, {
name => $name,
rate => $rate,
id => $id,
};
$self->update( { taxGroups => $groups } );
return '';
}
#-------------------------------------------------------------------
=head2 www_addVATNumber
=cut
sub www_addVATNumber {
my $self = shift;
my $session = $self->session;
my ($db, $form) = $session->quick( qw{ db form } );
return $session->privilege->insufficient if $session->user->isVisitor;
my $vatNumber = uc $form->process( 'vatNumber' );
my ($countryCode, $number) = $vatNumber =~ m/^([A-Z]{2})([A-Z0-9]+)$/;
return 'Illegal country code' unless isIn( $countryCode, keys %{ $EU_COUNTRIES } );
return 'You already have a VAT number for this country.' if @{ $self->getVATNumbers( $countryCode ) };
# Check VAT number via SOAP interface.
# TODO: Handle timeouts.
my $soap = SOAP::Lite->service('http://ec.europa.eu/taxation_customs/vies/api/checkVatPort?wsdl');
my $isValid = ( $soap->checkVat( $countryCode, $number ) )[ 3 ] || 0;
# Write the code to the db.
$db->write( 'replace into tax_eu_vatNumbers (userId,countryCode,vatNumber,approved) values (?,?,?,?)', [
$self->session->user->userId,
$countryCode,
$vatNumber,
$isValid,
] );
my $instance = WebGUI::Content::Account->createInstance($session,"shop");
return $instance->displayContent( $instance->callMethod("manageTaxData", [], $session->user->userId) );
}
#-------------------------------------------------------------------
=head2 www_deleteGroup
=cut
sub www_deleteGroup {
my $self = shift;
my $form = $self->session->form;
return $self->session->privilege->insufficient unless $self->canManage;
my $taxGroups = $self->get( 'taxGroups' );
my $removeGroupId = $form->process( 'groupId' );
my @newGroups = grep { $_->{ id } ne $removeGroupId } @{ $taxGroups };
$self->update( { taxGroups => \@newGroups } );
return '';
}
#-------------------------------------------------------------------
=head2 www_deleteVATNumber
=cut
sub www_deleteVATNumber {
my $self = shift;
my $session = $self->session;
return $session->privilege->insufficient unless $session->user->isVisitor;
$session->db->write( 'delete from tax_eu_vatNumbers where userId=? and vatNumber=?', [
$session->user->userId,
$session->form->process( 'vatNumber' ),
] );
my $instance = WebGUI::Content::Account->createInstance($session,"shop");
return $instance->displayContent( $instance->callMethod("manageTaxData", [], $session->user->userId) );
}
#-------------------------------------------------------------------
=head2 www_saveConfiguration
=cut
sub www_saveConfiguration {
my $self = shift;
my $form = $self->session->form;
return $self->session->privilege->insufficient unless $self->canManage;
$self->update( {
shopCountry => $form->process( 'shopCountry', 'selectBox' ),
} );
return '';
}
#-------------------------------------------------------------------
=head2 www_setDefaultGroup
=cut
sub www_setDefaultGroup {
my $self = shift;
my $form = $self->session->form;
return $self->session->privilege->insufficient unless $self->canManage;
$self->update( {
defaultGroup => $form->process( 'groupId' ),
} );
return '';
}
1;

696
lib/WebGUI/Shop/TaxDriver/Generic.pm Normal file
View file

@ -0,0 +1,696 @@
package WebGUI::Shop::TaxDriver::Generic;
use strict;
use WebGUI::Text;
use WebGUI::Storage;
use WebGUI::Exception::Shop;
use List::Util qw{ sum };
use base qw{ WebGUI::Shop::TaxDriver };
=head1 NAME
Package WebGUI::Shop::TaxDriver::Generic
=head1 DESCRIPTION
This package manages tax information, and calculates taxes on a shopping cart. It isn't a classic object
in that the only data it contains is a WebGUI::Session object, but it does provide several methods for
handling the information in the tax tables.
Taxes are accumulated through increasingly specific geographic information. For example, you can
specify the sales tax for a whole country, then the additional sales tax for a state in the country,
all the way down to a single code inside of a city.
=head1 SYNOPSIS
use WebGUI::Shop::Tax;
my $tax = WebGUI::Shop::Tax->new($session);
=head1 METHODS
These subroutines are available from this package:
=cut
#-------------------------------------------------------------------
=head2 add ( [$params] )
Add tax information to the table. Returns the taxId of the newly created tax information.
=head3 $params
A hash ref of the geographic and rate information. The country and taxRate parameters
must have defined values.
=head4 country
The country this tax information applies to.
=head4 state
The state this tax information applies to. state and country together are unique.
=head4 city
The ciy this tax information applies to. Cities are unique with state and country information.
=head4 code
The postal code this tax information applies to. codes are unique with state and country information.
=head4 taxRate
This is the tax rate for the location, as specified by the geographical
fields country, state, city and/or code. The tax rate is stored as
a percentage, like 5.5 .
=cut
sub add {
my $self = shift;
my $params = shift;
WebGUI::Error::InvalidParam->throw(error => 'Must pass in a hashref of params')
unless ref($params) eq 'HASH';
WebGUI::Error::InvalidParam->throw(error => "Missing required information.", param => 'country')
unless exists($params->{country}) and $params->{country};
WebGUI::Error::InvalidParam->throw(error => "Missing required information.", param => 'taxRate')
unless exists($params->{taxRate}) and defined $params->{taxRate};
$params->{taxId} = 'new';
my $id = $self->session->db->setRow('tax_generic_rates', 'taxId', $params);
return $id;
}
#-------------------------------------------------------------------
=head2 getTaxRate ( sku, address )
Returns the tax rate for the given sku with the given shipping address.
=head3 sku
An instanciated WebGUI::Asset::Sku object.
=head3 address
An instanciated WebGUI::Shop::Address object containing the shipping address for the sku.
=cut
sub getTaxRate {
my $self = shift;
my $sku = shift;
my $address = shift;
my $session = $self->session;
# Check params
WebGUI::Error::InvalidParam->throw(error => 'Must pass in a WebGUI::Asset::Sku object')
unless $sku && $sku->isa( 'WebGUI::Asset::Sku' );
WebGUI::Error::InvalidParam->throw(error => 'Must pass in a WebGUI::Shop::Address object')
if $address && !$address->isa( 'WebGUI::Shop::Address' );
# Check if the sku has a tax rate override, and return that if it has.
my $config = $sku->getTaxConfiguration( $self->className );
if ( $config->{ overrideTaxRate } ) {
return $config->{ taxRateOverride };
}
# No tax rate override, so tax is calculated from the tax tables.
# If no address is supplied yet, return 0%
return 0 unless defined $address;
# Fetch the taxes for this address and cache it for later use.
my $taxables = $session->stow->get( 'genericTaxables_' . $address->getId );
unless ($taxables) {
$taxables = $self->getTaxRates($address);
$session->stow->set( 'genericTaxables_' . $address->getId, $taxables );
}
# Check for a SKU specific tax override rate
my $itemTax = sum @{ $taxables };
return $itemTax;
}
#-------------------------------------------------------------------
=head2 className
Returns the name of this class.
=cut
sub className {
return 'WebGUI::Shop::TaxDriver::Generic';
}
#-------------------------------------------------------------------
=head2 delete ( [$params] )
Deletes data from the tax table by taxId.
=head3 $params
A hashref containing the taxId of the data to delete from the table.
=head4 taxId
The taxId of the data to delete from the table.
=cut
sub delete {
my $self = shift;
my $params = shift;
WebGUI::Error::InvalidParam->throw(error => 'Must pass in a hashref of params')
unless ref($params) eq 'HASH';
WebGUI::Error::InvalidParam->throw(error => "Hash ref must contain a taxId key with a defined value")
unless exists($params->{taxId}) and defined $params->{taxId};
$self->session->db->write('delete from tax_generic_rates where taxId=?', [$params->{taxId}]);
return;
}
#-------------------------------------------------------------------
=head2 exportTaxData ( )
Creates a tab deliniated file containing all the information from
the tax table. Returns a temporary WebGUI::Storage object containing
the file. The file will be named "siteTaxData.csv".
=cut
sub exportTaxData {
my $self = shift;
my $taxIterator = $self->getItems;
my @columns = grep { $_ ne 'taxId' } $taxIterator->getColumnNames;
my $taxData = WebGUI::Text::joinCSV(@columns) . "\n";
while (my $taxRow = $taxIterator->hashRef() ) {
my @taxData = @{ $taxRow }{@columns};
foreach my $column (@taxData) {
$column =~ tr/,/|/; ##Convert to the alternation syntax for the text file
}
$taxData .= WebGUI::Text::joinCSV(@taxData) . "\n";
}
my $storage = WebGUI::Storage->createTemp($self->session);
$storage->addFileFromScalar('siteTaxData.csv', $taxData);
return $storage;
}
#-------------------------------------------------------------------
=head2 getAllItems ( )
Returns an arrayref of hashrefs, where each hashref is the data for one row of
tax data. taxId is dropped from the dataset.
=cut
sub getAllItems {
my $self = shift;
my $taxes = $self->session->db->buildArrayRefOfHashRefs('select country,state,city,code,taxRate from tax_generic_rates order by country, state');
return $taxes;
}
#-------------------------------------------------------------------
=head2 getItems ( )
Returns a WebGUI::SQL::Result object for accessing all of the data in the tax table. This
is a convenience method for listing and/or exporting tax data.
=cut
sub getItems {
my $self = shift;
my $result = $self->session->db->read('select * from tax_generic_rates order by country, state');
return $result;
}
#-------------------------------------------------------------------
=head2 getTaxRates ( $address )
Given a WebGUI::Shop::Address object, return all rates associated with the address as an arrayRef.
=cut
sub getTaxRates {
my $self = shift;
my $address = shift;
WebGUI::Error::InvalidObject->throw(error => 'Need an address.', expected=>'WebGUI::Shop::Address', got=>(ref $address))
unless ref($address) eq 'WebGUI::Shop::Address';
my $country = $address->get('country');
my $state = $address->get('state');
my $city = $address->get('city');
my $code = $address->get('code');
my $result = $self->session->db->buildArrayRef(
q{
select taxRate from tax_generic_rates where find_in_set(?, country)
and (state='' or find_in_set(?, state))
and (city='' or find_in_set(?, city))
and (code='' or find_in_set(?, code))
},
[ $country, $state, $city, $code, ]);
return $result;
}
#-------------------------------------------------------------------
=head2 importTaxData ( $filePath )
Import tax information from the specified file in CSV format. The
first line of the file should contain only the name of the columns, in
any order. It may not contain any comments.
These are the column names, each is required:
=over 4
=item *
country
=item *
state
=item *
city
=item *
code
=item *
taxRate
=back
The following lines will contain tax information. Blank
lines and anything following a '#' sign will be ignored from
the second line of the file, on to the end.
Returns 1 if the import has taken place. This is to help you know
if old data has been deleted and new has been inserted. If an error is
detected, it will throw exceptions.
=head3 $filePath
The path to a file with data to import into the Product system.
=cut
sub importTaxData {
my $self = shift;
my $filePath = shift;
WebGUI::Error::InvalidParam->throw(error => q{Must provide the path to a file})
unless $filePath;
WebGUI::Error::InvalidFile->throw(error => qq{File could not be found}, brokenFile => $filePath)
unless -e $filePath;
WebGUI::Error::InvalidFile->throw(error => qq{File is not readable}, brokenFile => $filePath)
unless -r $filePath;
open my $table, '<', $filePath or
WebGUI::Error->throw(error => qq{Unable to open $filePath for reading: $!\n});
my $headers;
$headers = <$table>;
chomp $headers;
my @headers = WebGUI::Text::splitCSV($headers);
WebGUI::Error::InvalidFile->throw(error => qq{Bad header found in the CSV file}, brokenFile => $filePath)
unless (join(q{-}, sort @headers) eq 'city-code-country-state-taxRate')
and (scalar @headers == 5);
my @taxData = ();
my $line = 1;
while (my $taxRow = <$table>) {
chomp $taxRow;
$taxRow =~ s/\s*#.+$//;
next unless $taxRow;
local $_;
my @taxRow = map { tr/|/,/; $_; } WebGUI::Text::splitCSV($taxRow);
WebGUI::Error::InvalidFile->throw(error => qq{Error found in the CSV file}, brokenFile => $filePath, brokenLine => $line)
unless scalar @taxRow == 5;
push @taxData, [ @taxRow ];
}
##Okay, if we got this far, then the data looks fine.
return unless scalar @taxData;
$self->session->db->beginTransaction;
$self->session->db->write('delete from tax_generic_rates');
foreach my $taxRow (@taxData) {
my %taxRow;
@taxRow{ @headers } = @{ $taxRow }; ##Must correspond 1:1, or else...
$self->add(\%taxRow);
}
$self->session->db->commit;
return 1;
}
#-------------------------------------------------------------------
=head2 skuFormDefinition ( )
Returns a hash ref containing the form defintion for the per sku options for this tax driver.
=cut
sub skuFormDefinition {
my $self = shift;
my $i18n = WebGUI::International->new( $self->session, 'Tax' );
tie my %definition, 'Tie::IxHash', (
overrideTaxRate => {
fieldType => "yesNo",
defaultValue => 0,
label => $i18n->get("override tax rate"),
hoverHelp => $i18n->get("override tax rate help")
},
taxRateOverride => {
fieldType => "float",
defaultValue => 0.00,
label => $i18n->get("tax rate override"),
hoverHelp => $i18n->get("tax rate override help")
},
);
return \%definition;
}
#-------------------------------------------------------------------
=head2 www_deleteTax ( )
Delete a row of tax information, using the form variable taxId as
the id of the row to delete.
=cut
sub www_deleteTax {
my $self = shift;
my $session = $self->session;
return $session->privilege->insufficient unless $self->canManage;
my $taxId = $session->form->get('taxId');
$self->delete({ taxId => $taxId });
return '';
}
#-------------------------------------------------------------------
=head2 www_addTax ( )
Add new tax information into the database, via the UI.
=cut
sub www_addTax {
my $self = shift;
my $session = $self->session;
return $session->privilege->insufficient unless $self->canManage;
my $params;
my ($form) = $session->quick('form');
$params->{country} = $form->get('country', 'text');
$params->{state} = $form->get('state', 'text');
$params->{city} = $form->get('city', 'text');
$params->{code} = $form->get('code', 'text');
$params->{taxRate} = $form->get('taxRate', 'float');
$self->add($params);
return '';
}
#-------------------------------------------------------------------
=head2 www_exportTax ( )
Export the entire tax table as a CSV file the user can download.
=cut
sub www_exportTax {
my $self = shift;
my $session = $self->session;
return $session->privilege->insufficient unless $self->canManage;
my $storage = $self->exportTaxData();
$self->session->http->setRedirect($storage->getUrl($storage->getFiles->[0]));
return "redirect";
}
#-------------------------------------------------------------------
=head2 www_getTaxesAsJson ( )
Servers side pagination for tax data that is sent as JSON back to the browser to be
displayed in a YUI DataTable.
=cut
sub www_getTaxesAsJson {
my ($self) = @_;
my $session = $self->session;
return $session->privilege->insufficient unless $self->canManage;
my ($db, $form) = $session->quick(qw(db form));
my $startIndex = $form->get('startIndex') || 0;
my $numberOfResults = $form->get('results') || 25;
my %goodKeys = qw/country 1 state 1 city 1 code 1 'tax rate' 1/;
my $sortKey = $form->get('sortKey');
$sortKey = $goodKeys{$sortKey} == 1 ? $sortKey : 'country';
my $sortDir = $form->get('sortDir');
$sortDir = lc($sortDir) eq 'desc' ? 'desc' : 'asc';
my @placeholders = ();
my $sql = 'select SQL_CALC_FOUND_ROWS * from tax_generic_rates';
my $keywords = $form->get("keywords");
if ($keywords ne "") {
$db->buildSearchQuery(\$sql, \@placeholders, $keywords, [qw{country state city code}])
}
push(@placeholders, $startIndex, $numberOfResults);
$sql .= sprintf (" order by %s limit ?,?","$sortKey $sortDir");
my %results = ();
my @records = ();
my $sth = $db->read($sql, \@placeholders);
while (my $record = $sth->hashRef) {
push(@records,$record);
}
$results{'recordsReturned'} = $sth->rows()+0;
$sth->finish;
$results{'records'} = \@records;
$results{'totalRecords'} = $db->quickScalar('select found_rows()')+0; ##Convert to numeric
$results{'startIndex'} = $startIndex;
$results{'sort'} = undef;
$results{'dir'} = $sortDir;
$session->http->setMimeType('application/json');
return JSON::to_json(\%results);
}
#-------------------------------------------------------------------
=head2 www_importTax ( )
Import new tax data from a file provided by the user. This will replace the current
data with the new data.
=cut
sub www_importTax {
my $self = shift;
my $session = $self->session;
return $session->privilege->insufficient unless $self->canManage;
my $storage = WebGUI::Storage->create($session);
my $taxFile = $storage->addFileFromFormPost('importFile', 1);
eval {
$self->importTaxData($storage->getPath($taxFile)) if $taxFile;
};
my ($exception, $status_message);
if ($exception = Exception::Class->caught('WebGUI::Error::InvalidFile')) {
$status_message = sprintf 'A problem was found with your file: %s',
$exception->error;
if ($exception->brokenLine) {
$status_message .= sprintf ' on line %d', $exception->brokenLine;
}
}
elsif ($exception = Exception::Class->caught()) {
$status_message = sprintf 'A problem happened during the import: %s', $exception->error;
}
$session->stow->set( 'tax_message', $status_message );
return '';
}
#-----------------------------------------------------------
=head2 getConfigurationScreen ( )
Returns the form that contains the configuration options for this plugin in the admin console.
=cut
sub getConfigurationScreen {
my $self = shift;
my $session = $self->session;
my $status_message = $session->stow->get( 'tax_message' );
return $session->privilege->insufficient unless $self->canManage;
##YUI specific datatable CSS
my ($style, $url) = $session->quick(qw(style url));
$style->setLink($url->extras('/yui/build/fonts/fonts-min.css'), {rel=>'stylesheet', type=>'text/css'});
$style->setLink($url->extras('yui/build/datatable/assets/skins/sam/datatable.css'), {rel=>'stylesheet', type => 'text/CSS'});
$style->setLink($url->extras('yui/build/paginator/assets/skins/sam/paginator.css'), {rel=>'stylesheet', type => 'text/CSS'});
$style->setScript($url->extras('/yui/build/utilities/utilities.js'), {type=>'text/javascript'});
$style->setScript($url->extras('yui/build/json/json-min.js'), {type => 'text/javascript'});
$style->setScript($url->extras('yui/build/paginator/paginator-min.js'), {type => 'text/javascript'});
$style->setScript($url->extras('yui/build/datasource/datasource-min.js'), {type => 'text/javascript'});
##YUI Datatable
$style->setScript($url->extras('yui/build/datatable/datatable-min.js'), {type => 'text/javascript'});
##Default CSS
$style->setRawHeadTags('<style type="text/css"> #paging a { color: #0000de; } #search, #export form { display: inline; } </style>');
my $i18n=WebGUI::International->new($session, 'Tax');
my $exportForm = WebGUI::Form::formHeader($session,{action => $url->page('shop=tax;method=do;do=exportTax')})
. WebGUI::Form::submit($session,{value=>$i18n->get('export tax','Shop'), extras=>q{style="float: left;"} })
. WebGUI::Form::formFooter($session);
my $importForm = WebGUI::Form::formHeader($session,{action => $url->page('shop=tax;method=do;do=importTax')})
. WebGUI::Form::submit($session,{value=>$i18n->get('import tax','Shop'), extras=>q{style="float: left;"} })
. q{<input type="file" name="importFile" size="10" />}
. WebGUI::Form::formFooter($session);
my $addForm = WebGUI::HTMLForm->new($session,action=>$url->page('shop=tax;method=do;do=addTax'));
$addForm->text(
label => $i18n->get('country'),
hoverHelp => $i18n->get('country help'),
name => 'country',
);
$addForm->text(
label => $i18n->get('state'),
hoverHelp => $i18n->get('state help'),
name => 'state',
);
$addForm->text(
label => $i18n->get('city'),
hoverHelp => $i18n->get('city help'),
name => 'city',
);
$addForm->text(
label => $i18n->get('code'),
hoverHelp => $i18n->get('code help'),
name => 'code',
);
$addForm->float(
label => $i18n->get('tax rate'),
hoverHelp => $i18n->get('tax rate help'),
name => 'taxRate',
);
$addForm->submit(
value => $i18n->get('add a tax'),
);
my $output;
if ($status_message) {
$output = <<EOSM;
<div class="error">
$status_message
</div>
EOSM
}
$output .= q|
<div class="yui-skin-sam">
<div id="search"><form id="keywordSearchForm"><input type="text" name="keywords" id="keywordsField" /><input type="submit" value="|.$i18n->get(364, 'WebGUI').q|" /></form></div>
<div id="dynamicdata"></div>
<div id="adding">|.$addForm->print.q|</div>
<div id="importExport">|.$exportForm.$importForm.q|</div>
</div>
<script type="text/javascript">
var taxtable = function() {
// Column definitions
formatDeleteTaxId = function(elCell, oRecord, oColumn, orderNumber) {
elCell.innerHTML = '<a href="|.$url->page(q{shop=tax;method=do;do=deleteTax}).q|;taxId='+oRecord.getData('taxId')+'">|.$i18n->get('delete').q|</a>';
};
var myColumnDefs = [ // sortable:true enables sorting
{key:"country", label:"|.$i18n->get('country').q|", sortable: true},
{key:"state", label:"|.$i18n->get('state').q|", sortable: true},
{key:"city", label:"|.$i18n->get('city').q|", sortable: true},
{key:"code", label:"|.$i18n->get('code').q|", sortable: true},
{key:"taxRate", label:"|.$i18n->get('tax rate').q|"},
{key:"taxId", label:"", formatter:formatDeleteTaxId}
];
// DataSource instance
var myDataSource = new YAHOO.util.DataSource("|.$url->page('shop=tax;method=do;do=getTaxesAsJson;').q|");
myDataSource.responseType = YAHOO.util.DataSource.TYPE_JSON;
myDataSource.responseSchema = {
resultsList: "records",
fields: [
{key:"country", parser:"string"},
{key:"state", parser:"string"},
{key:"city", parser:"string"},
{key:"code", parser:"string"},
{key:"taxRate", parser:"number"},
{key:"taxId", parser:"string"}
],
metaFields: {
totalRecords: "totalRecords" // Access to value in the server response
}
};
// DataTable configuration
var myConfigs = {
initialRequest: 'startIndex=0;results=25', // Initial request for first page of data
dynamicData: true, // Enables dynamic server-driven data
sortedBy : {key:"country", dir:YAHOO.widget.DataTable.CLASS_ASC}, // Sets UI initial sort arrow
paginator: new YAHOO.widget.Paginator({ rowsPerPage:25 }) // Enables pagination
};
// DataTable instance
var myDataTable = new YAHOO.widget.DataTable("dynamicdata", myColumnDefs, myDataSource, myConfigs);
// Update totalRecords on the fly with value from server to allow pagination
myDataTable.handleDataReturnPayload = function(oRequest, oResponse, oPayload) {
oPayload.totalRecords = oResponse.meta.totalRecords;
return oPayload;
}
//Setup the form to submit an AJAX request back to the site.
YAHOO.util.Dom.get('keywordSearchForm').onsubmit = function () {
var state = myDataTable.getState();
state.pagination.recordOffset = 0;
myDataSource.sendRequest('keywords=' + YAHOO.util.Dom.get('keywordsField').value + ';startIndex=0;results=25', {success: myDataTable.onDataReturnInitializeTable, scope:myDataTable, argument:state});
return false;
};
return {
ds: myDataSource,
dt: myDataTable
};
}();
</script>
|;
return $output;
}
1;

5
lib/WebGUI/Workflow/Activity/CalendarUpdateFeeds.pm
View file

@ -80,7 +80,8 @@ sub execute {
my $object = shift;
my $instance = shift;
$self->session->user({userId => 3});
my $previousUser = $session->user;
$session->user({userId => 3});
### TODO: If we take more than a minute, return WAITING so that some
# other activity can run
@ -381,6 +382,7 @@ sub execute {
if ($currentVersionTag) {
$currentVersionTag->setWorking;
}
$session->user({user => $previousUser});
return $self->WAITING(1);
}
my $eventData = shift @$eventList;
@ -431,6 +433,7 @@ sub execute {
}
$instance->deleteScratch('events');
$instance->deleteScratch('feeds');
$session->user({user => $previousUser});
return $self->COMPLETE;
}

153
lib/WebGUI/Workflow/Activity/ExpirePurchasedThingyRecords.pm Normal file
View file

@ -0,0 +1,153 @@
package WebGUI::Workflow::Activity::ExpirePurchasedThingyRecords;
=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
use strict;
use base 'WebGUI::Workflow::Activity';
=head1 NAME
Package WebGUI::Workflow::Activity::ExpirePurchasedThingyRecords
=head1 DESCRIPTION
Expire the purchased thingy records.
=head1 SYNOPSIS
See WebGUI::Workflow::Activity for details on how to use any activity.
=head1 METHODS
These methods are available from this class:
=cut
#-------------------------------------------------------------------
=head2 definition ( session, definition )
See WebGUI::Workflow::Activity::defintion() for details.
=cut
sub definition {
my $class = shift;
my $session = shift;
my $definition = shift;
my $i18n = WebGUI::International->new($session, "Workflow_Activity_ExpirePurchasedThingyRecords");
push @{$definition}, {
name => $i18n->get("topicName"),
properties => {
notificationOffset => {
fieldType => "interval",
defaultValue => 60*60*24*3,
label => $i18n->get('notificationOffset label'),
hoverHelp => $i18n->get('notificationOffset description'),
},
notificationMessage => {
fieldType => "HTMLArea",
defaultValue => $i18n->get('default notification'),
label => $i18n->get('notificationMessage label'),
hoverHelp => $i18n->get('notificationMessage description'),
},
notificationSubject => {
fieldType => "text",
defaultValue => $i18n->get('default notification subject'),
label => $i18n->get('notificationSubject label'),
hoverHelp => $i18n->get('notificationSubject description'),
},
},
};
return $class->SUPER::definition($session,$definition);
}
#-------------------------------------------------------------------
=head2 execute ( [ object ] )
See WebGUI::Workflow::Activity::execute() for details.
=cut
sub execute {
my $self = shift;
my $object = shift;
my $instance = shift;
my $time = time;
my %asset = (); # Keep track of assets we're using
### Notify of those about to expire
my $iter
= WebGUI::AssetCollateral::Sku::ThingyRecord::Record->getAllIterator(
$self->session,
{
constraints => {
"expires < ?" => $time + $self->get('notificationOffset'),
"sentExpiresNotice != ?" => 1,
},
});
while ( my $record = $iter->() ) {
$record->update({
sentExpiresNotice => 1,
});
my $msg = WebGUI::Mail::Send->create( $self->session, {
toUser => $record->get('userId'),
subject => $self->get('notificationSubject'),
});
$msg->addHtml( $self->get('notificationMessage') );
$msg->queue;
if ( time - $time > 60 ) {
return $self->WAITING(1);
}
}
### Delete expired
$iter
= WebGUI::AssetCollateral::Sku::ThingyRecord::Record->getAllIterator(
$self->session,
{
constraints => {
"expires < ?" => $time,
"isHidden != ?" => 1,
},
});
while ( my $record = $iter->() ) {
# Record is hidden
$record->update({ isHidden => 1 });
my $asset;
if ( !$asset{$record->get('assetId')} ) {
$asset = $asset{$record->get('assetId')}
= WebGUI::Asset->newByDynamicClass( $self->session, $record->get('assetId') );
}
else {
$asset = $asset{$record->get('assetId')};
}
$asset->deleteThingRecord( $asset->get('thingId'), $record->getId );
if ( time - $time > 60 ) {
return $self->WAITING(1);
}
}
return $self->COMPLETE;
}
1;
#vim:ft=perl

2
lib/WebGUI/Workflow/Activity/NotifyAboutUser.pm
View file

@ -92,6 +92,7 @@ See WebGUI::Workflow::Activity::execute() for details.
sub execute {
my $self = shift;
my $user = shift;
my $previousUser = $self->session->user;
$self->session->user({user=>$user});
my $message = $self->get("message");
WebGUI::Macro::process($self->session, \$message);
@ -105,6 +106,7 @@ sub execute {
});
$mail->addText($message);
$mail->addFooter;
$self->session->user({user=>$previousUser});
return $mail->send ? $self->COMPLETE : $self->ERROR;
}

3
lib/WebGUI/Workflow/Activity/RunCommandAsUser.pm
View file

@ -79,12 +79,15 @@ sub execute {
my $self = shift;
my $user = shift;
my $cmd = $self->get("command");
my $previousUser = $self->session->user;
$self->session->user({user=>$user});
WebGUI::Macro::process($self->session, \$cmd);
if (system($cmd)) {
$self->session->errorHandler->error("Workflow: RunCommandAsUser failed because: $!");
$self->session->user({user=>$previousUser});
return $self->ERROR;
} else {
$self->session->user({user=>$previousUser});
return $self->COMPLETE;
}
}

6
lib/WebGUI/i18n/English/Account_Shop.pm
View file

@ -54,6 +54,12 @@ our $I18N = {
lastUpdated => 0,
},
'manage tax label' => {
message => q{Manage Tax Settings},
lastUpdated => 0,
context => q{Label for the manage tax tab},
},
};
1;

20
lib/WebGUI/i18n/English/Asset_Matrix.pm
View file

@ -387,6 +387,16 @@ listing,|,
lastUpdated => 0,
},
'max screenshot width description' => {
message => q|Select the maximum width of the screenshots in this matrix. Screenshots that are larger will be resized.|,
lastUpdated => 0,
},
'max screenshot height description' => {
message => q|Select the maximum height of the screenshots in this matrix. Screenshots that are larger will be resized.|,
lastUpdated => 0,
},
'compare color no description' => {
message => q|Select the color for compare result 'No' in the compare display.|,
lastUpdated => 0,
@ -528,6 +538,16 @@ to increase performance. How long should we cache them?|,
lastUpdated => 0,
},
'max screenshot height label' => {
message => q|Maximum Screenshot Height|,
lastUpdated => 0,
},
'max screenshot width label' => {
message => q|Maximum Screenshot Width|,
lastUpdated => 0,
},
'sort by score label' => {
message => q|Score|,
lastUpdated => 0,

24
lib/WebGUI/i18n/English/Asset_Sku.pm
View file

@ -69,30 +69,6 @@ our $I18N = {
context => q|help for vendor field|
},
'override tax rate' => {
message => q|Override tax rate?|,
lastUpdated => 0,
context => q|A yes/no field asking whether to override tax rate.|
},
'override tax rate help' => {
message => q|Would you like to override the default tax rate for this item? Usually used in locales that have special or no tax on life essential items like food and clothing.|,
lastUpdated => 0,
context => q|help for override tax rate field|
},
'tax rate override' => {
message => q|Tax Rate Override|,
lastUpdated => 0,
context => q|a field containing the percentage to use to calculate tax for this item|
},
'tax rate override help' => {
message => q|What is the new percentage that should be used to calculate tax on this item?|,
lastUpdated => 0,
context => q|help for tax rate override field|
},
'add to cart' => {
message => q|Add To Cart|,
lastUpdated => 0,

70
lib/WebGUI/i18n/English/Asset_Survey.pm
View file

@ -372,7 +372,7 @@ our $I18N = {
lastUpdated => 1224686319
},
'is this the correct answer description' => {
message => q|Select wether this is the correct answer or not.|,
message => q|Select whether this is the correct answer or not.|,
context => q|Description of the 'is this the correct answer' field, used as hoverhelp in the edit answer dialog.|,
lastUpdated => 0
},
@ -576,6 +576,16 @@ the time limit for completing the survey. This message is in the 'take survey' t
message => q|The template used to display the Survey Edit screen.|,
lastUpdated => 0,
},
'Allow back button' => {
message => q|Allow back button|,
lastUpdated => 0,
},
'Allow back button help' => {
message => q|Allow the user to navigate backwards in a Survey.|,
lastUpdated => 0,
},
'Max user responses' => {
message => q|Max user responses|,
@ -876,37 +886,37 @@ directly inside the answer_loop for other types of questions.|,
},
'lastResponseCompleted' => {
message => q|A boolean indicating wether the current user's last response was completed.|,
message => q|A boolean indicating whether the current user's last response was completed.|,
context => q|Description of a template variable for a template Help page.|,
lastUpdated => 0,
},
'lastResponseTimedOut' => {
message => q|A boolean indicating wether the current user's last response timed out.|,
message => q|A boolean indicating whether the current user's last response timed out.|,
context => q|Description of a template variable for a template Help page.|,
lastUpdated => 0,
},
'maxResponsesSubmitted' => {
message => q|A boolean indicating wether the current user has reached the maximum number of responses.|,
message => q|A boolean indicating whether the current user has reached the maximum number of responses.|,
context => q|Description of a template variable for a template Help page.|,
lastUpdated => 0,
},
'user_canTakeSurvey' => {
message => q|A boolean indicating wether the current user can take the survey.|,
message => q|A boolean indicating whether the current user can take the survey.|,
context => q|Description of a template variable for a template Help page.|,
lastUpdated => 0,
},
'user_canViewReports' => {
message => q|A boolean indicating wether the current user can view the survey reports.|,
message => q|A boolean indicating whether the current user can view the survey reports.|,
context => q|Description of a template variable for a template Help page.|,
lastUpdated => 0,
},
'user_canEditSurvey' => {
message => q|A boolean indicating wether the current user can edit the survey.|,
message => q|A boolean indicating whether the current user can edit the survey.|,
context => q|Description of a template variable for a template Help page.|,
lastUpdated => 0,
},
@ -1008,17 +1018,27 @@ directly inside the answer_loop for other types of questions.|,
},
'totalQuestions' => {
message => q|A boolean indicating wether the user should see the total number of answers and the number of questions that have already been answered.|,
message => q|A boolean indicating whether the user should see the total number of answers and the number of questions that have already been answered.|,
context => q|Description of a template variable for a template Help page.|,
lastUpdated => 0,
},
'showTimeLimit' => {
message => q|A boolean indicating wether the number of minutes until the survey times out should be displayed.|,
message => q|A boolean indicating whether the number of minutes until the survey times out should be displayed.|,
context => q|Description of a template variable for a template Help page.|,
lastUpdated => 0,
},
'isLastPage' => {
message => q|A boolean indicating whether this is the last page of the survey.|,
context => q|Description of a template variable for a template Help page.|,
},
'allowBackBtn' => {
message => q|A boolean indicating whether the back button is allowed.|,
context => q|Description of a template variable for a template Help page.|,
},
'minutesLeft' => {
message => q|The number of minutes the user has left to finish the survey.|,
context => q|Description of a template variable for a template Help page.|,
@ -1238,7 +1258,7 @@ section/answer.|,
},
'randomizeAnswers' => {
message => q|A boolean indicating wether this question's answers should be randomized.|,
message => q|A boolean indicating whether this question's answers should be randomized.|,
context => q|Description of a template variable for a template Help page.|,
lastUpdated => 0,
},
@ -1368,6 +1388,36 @@ section/answer.|,
context => q|Description of a template variable for a template Help page.|,
lastUpdated => 0,
},
'year' => {
message => q|Year (YYYY):|,
context => q|Sub-label for "Year Month" question type|,
lastUpdated => 0,
},
'month' => {
message => q|Month:|,
context => q|Sub-label for "Year Month" question type|,
lastUpdated => 0,
},
'back' => {
message => q|Back|,
context => q|Back button label on Take Survey page|,
lastUpdated => 0,
},
'continue' => {
message => q|Continue|,
context => q|Continue button label on Take Survey page|,
lastUpdated => 0,
},
'finish' => {
message => q|Finish|,
context => q|Finish button label on Take Survey page|,
lastUpdated => 0,
},
};

81
lib/WebGUI/i18n/English/Asset_ThingyRecord.pm Normal file
View file

@ -0,0 +1,81 @@
package WebGUI::i18n::English::Asset_ThingyRecord;
use strict;
our $I18N = {
assetName => {
message => "Thingy Record",
lastUpdated => 0,
context => "The name of the asset",
},
renew => {
message => "Renew",
lastUpdated => 0,
context => "Label for button to renew a subscription",
},
saved => {
message => "Saved!",
lastUpdated => 0,
context => "Message to show after ThingyRecord is succesfully updated",
},
'renewal added to cart' => {
message => "Your renewal has been added to your cart.",
lastUpdated => 0,
context => "Message after adding a renewal to the cart.",
},
'templateIdView label' => {
message => "View Template",
lastUpdated => 0,
context => "Label for asset property",
},
'templateIdView description' => {
message => "The template to buy a new ThingyRecord",
lastUpdated => 0,
context => "Description of asset property",
},
'thingId label' => {
message => "Add to Thing",
lastUpdated => 0,
context => "Label for asset property",
},
'thingId description' => {
message => "The thing to purchase a record in",
lastUpdated => 0,
context => "Description of asset property",
},
'thingFields label' => {
message => "Fields to Add",
lastUpdated => 0,
context => "Label for asset property",
},
'thingFields description' => {
message => "The fields to allow the user to add data to",
lastUpdated => 0,
context => "Description of asset property",
},
'duration label' => {
message => "Duration",
lastUpdated => 0,
context => "Label for asset property",
},
'duration description' => {
message => "Length of a time a ThingyRecord should last",
lastUpdated => 0,
context => "Description of asset property",
},
};
1;
#vim:ft=perl

14
lib/WebGUI/i18n/English/Asset_UserList.pm
View file

@ -123,9 +123,8 @@ be ignored. The User List will show every users profile.|,
'alphabet' => {
message => q|The alphabet that is used for the alphabet search. This is a string of comma
seperated values|,
lastUpdated => 1081514049
message => q|The alphabet that is used for the alphabet search. This is a string of comma seperated values.|,
lastUpdated => 1239725937
},
'alphabet label' => {
@ -134,9 +133,8 @@ seperated values|,
},
'alphabet description' => {
message => q|The alphabet that is used for the alphabet search. Has to be a string of comma
seperated values|,
lastUpdated => 1081514049
message => q|The set of characters that are used for the alphabet search. This allows foreign character sets to be used. Has to be a string of comma seperated values.|,
lastUpdated => 1239725940
},
'alphabetSearchField' => {
@ -151,9 +149,9 @@ seperated values|,
'alphabetSearchField description' => {
message => q|Select the profile field in which the alphabet search will be done. You can disable
the aplhapbet search function by selecting 'Disable Alphabet Search'. This will improve the performance of the
the alphabet search function by selecting 'Disable Alphabet Search'. This will improve the performance of the
User List.|,
lastUpdated => 1223651066
lastUpdated => 1239726022
},
'Profile not public message' => {

322
lib/WebGUI/i18n/English/Asset_WSClient.pm
View file

@ -1,322 +0,0 @@
package WebGUI::i18n::English::Asset_WSClient;
use strict;
our $I18N = {
'35' => {
message => q|<b>Debug:</b> No template specified, using default.|,
lastUpdated => 1033575504
},
'32' => {
message => q|<b>Debug:</b> Error: Could not connect to the SOAP server.|,
lastUpdated => 1033575504
},
'11' => {
message => q|Execute by default?|,
lastUpdated => 1033575504
},
'21' => {
message => q|There were no results for this query.|,
lastUpdated => 1033575504
},
'72 description' => {
message => q|Select a template to display the output of the Web Service Client Asset.|,
lastUpdated => 1119981444,
},
'8 description' => {
message => q|<p>If you're using WebGUI macros in your query you'll want to check this box.</p>|,
lastUpdated => 1119981444,
},
'13 description' => {
message => q|<p>How many rows should be displayed before splitting the results into separate pages? In other words, how many rows should be displayed per page?</p>|,
lastUpdated => 1119981444,
},
'14 description' => {
message => q|<p>Because a SOAP call can return complex data structures, you'll need to specify which named variable is to be paginated. If none is specified, no pagination will occur.</p>|,
lastUpdated => 1119981444,
},
'2 description' => {
message => q|<p>From the SOAP::Lite man page, "URIs are just identifiers. They may look like URLs, but they are not guaranteed to point to anywhere and shouldn't be used as such pointers. URIs assume to be unique within the space of all XML documents, so consider them as unique identifiers and nothing else." If you specify a URI, you probably also need a proxy below. Alternatively, you can specify a WSDL file in place of a URI. This file refers to a real location at which a SOAP service description can be downloaded and used. For our purposes, the file must end in ".wsdl" to be properly recognized. If you use a WSDL file, you probably don't need to specify a proxy.</p>|,
lastUpdated => 1119981444,
},
'3 description' => {
message => q|<p>The SOAP proxy is the full name of the server and/or script that is listening for SOAP calls. For example:
<code>http://mydomain.com/cgi-bin/soaplistener.pl</code></p>|,
lastUpdated => 1119981444,
},
'4 description' => {
message => q|<p>The SOAP method is the name of the function to be invoked by the SOAP server. Include any extra parameters in the SOAP Call Parameters field below.</p>|,
lastUpdated => 1119981444,
},
'5 description' => {
message => q|<p>If your SOAP call requires any additional parameters, include them here as a valid Perl hash, array or scalar. For example: <code>'userid' => '12',<br />companyid => '&#94;FormParam("companyid");' Whether you need to use scalar, hash or array is entirely dependent on what your SOAP service expects as input. Likewise, what you get back is entirely dependent on what the service deems to return.</code>.</p>|,
lastUpdated => 1167970155,
},
'16 description' => {
message => q|If <i>soapHttpHeaderOverride</i> is set in the WebGUI configuration file, then this
property allows you to override the default MIME type for this page.|,
lastUpdated => 1119981444,
},
'11 description' => {
message => q|<p>Leave this set to yes unless your page is calling itself with additional parameters. You will probably know if/when you need to turn off default execution. To force execution when it has been disabled by default, pass a form variable "targetWobjects" specifying the name of the SOAP call to force execution. If current cached results already exist for this wobject they will be returned regardless. If you don't want <i>any</i> results returned no matter what, see the Tricks section below.</p>|,
lastUpdated => 1119981444,
},
'9 description' => {
message => q|<p>If you want to display debugging and error messages on the page, check this box.</p>|,
lastUpdated => 1119981444,
},
'15 description' => {
message => q|<p>This option will only display if you have Data::Structure::Util installed. SOAP calls return UTF8 strings even if they may not have UTF8 characters within them. This converts UTF8 characters so that there aren't collisions with any character sets specified in the page header. Decoding is turned off by default, but try turning it on if you see goofy gibberish, especially with the display of copyright symbols and the like.</p>|,
lastUpdated => 1167970807,
},
'28 description' => {
message => q|<p>By default, SOAP calls are cached uniquely for each user session. By selecting "Global" call returns can be shared between users.</p>|,
lastUpdated => 1119981444,
},
'27 description' => {
message => q|<p>The number of seconds returned SOAP results will be cached. Set to 1 to essentially skip caching.</p>|,
lastUpdated => 1167970680,
},
'26' => {
message => q|Could not connect to SOAP server.|,
lastUpdated => 1055349311
},
'2' => {
message => q|SOAP URI or WSDL|,
lastUpdated => 1033575504
},
'22' => {
message => q|Parse error on SOAP parameters.|,
lastUpdated => 1055348597
},
'assetName' => {
message => q|Web Services Client|,
lastUpdated => 1128834404
},
'72' => {
message => q|Web Services Client Template|,
lastUpdated => 1072812143
},
'30' => {
message => q|<b>Debug:</b> Error: The URI/WSDL specified is of an improper format.|,
lastUpdated => 1033575504
},
'13' => {
message => q|Pagination after|,
lastUpdated => 1072810296
},
'16' => {
message => q|HTTP Header Override|,
lastUpdated => 1033575504
},
'23' => {
message => q|The URI/WSDL specified is of an improper format.|,
lastUpdated => 1055348955
},
'29' => {
message => q|Session|,
lastUpdated => 1088120988
},
'25' => {
message => q|There was a problem with the SOAP call: |,
lastUpdated => 1055349116
},
'27' => {
message => q|Cache expires|,
lastUpdated => 1055349028
},
'28' => {
message => q|Cache|,
lastUpdated => 1088972047
},
'3' => {
message => q|SOAP Proxy|,
lastUpdated => 1033575504
},
'9' => {
message => q|Debug?|,
lastUpdated => 1033575504
},
'12' => {
message => q|Msg if no results|,
lastUpdated => 1033575504
},
'14' => {
message => q|Pagination variable|,
lastUpdated => 1072810296
},
'15' => {
message => q|Decode UTF8 data?|,
lastUpdated => 1101795689,
},
'20' => {
message => q|Edit Web Services Client|,
lastUpdated => 1033575504
},
'8' => {
message => q|Preprocess macros on query?|,
lastUpdated => 1033575504
},
'4' => {
message => q|SOAP Method/Call|,
lastUpdated => 1033575504
},
'disableWobject' => {
message => q|If the page was called with a form param of disableWobjects, this variable will
be set to true.|,
lastUpdated => 1149568071,
},
'results' => {
message => q|This loop contains all the results from
the SOAP call. Within the loop, you may access specific data elements by the
names set for them by the SOAP server (i.e. perhaps "localTime" for a time query).|,
lastUpdated => 1167971387,
},
'numResults' => {
message => q|Number of rows found by the client, if an array was returned.|,
lastUpdated => 1149568071,
},
'24' => {
message => q|SOAP return is type: |,
lastUpdated => 1055349028
},
'19' => {
message => q|Global|,
lastUpdated => 1088972047
},
'31' => {
message => q|<b>Debug:</b> Error: There was a problem with the SOAP call.|,
lastUpdated => 1033575504
},
'5' => {
message => q|SOAP Call Parameters|,
lastUpdated => 1033575504
},
'soapError' => {
message => q|This template variable will contain any errors from trying to fetch the SOAP content.|,
lastUpdated => 1167969800
},
'templateId' => {
message => q|The ID of the template used to display this Asset.|,
lastUpdated => 1167969800
},
'callMethod' => {
message => q|The name of the function to be invoked by the SOAP server.|,
lastUpdated => 1167969800
},
'debugMode' => {
message => q|A boolean indicating whether or not debug and error messages should be displayed.|,
lastUpdated => 1167969800
},
'execute_by_default' => {
message => q|A boolean indicating whether or not the WSClient was set to execute by default.|,
lastUpdated => 1167969800
},
'paginateAfter' => {
message => q|The number of rows of SOAP results to paginate.|,
lastUpdated => 1167969800
},
'paginateVar' => {
message => q|Determins which variable in the SOAP data returned by the will be used for pagination.|,
lastUpdated => 1167969800
},
'params' => {
message => q|Any user entered parameters, as perl code.|,
lastUpdated => 1167969800
},
'preprocessMacros' => {
message => q|If set to true, then macros in the params and callMethod will be evaluated.|,
lastUpdated => 1167969800
},
'proxy' => {
message => q|The full name of the SOAP server and/or script.|,
lastUpdated => 1167969800
},
'uri' => {
message => q|The URI of the SOAP server.|,
lastUpdated => 1167969800
},
'decodeUtf8' => {
message => q|Whether or not SOAP UTF8 results should be converted to the encoding used by the page.|,
lastUpdated => 1167969800
},
'httpHeader' => {
message => q|An alternate HTTP header that may be used to override the default MIME type for this page.|,
lastUpdated => 1167969800
},
'cacheTTL' => {
message => q|The number of seconds to cache SOAP results.|,
lastUpdated => 1167969800
},
'sharedCache' => {
message => q|A boolean indicating whether or not cached SOAP results will be shared between users or whether each user will have their own individual cache.|,
lastUpdated => 1167970639
},
'ws client asset template variables title' => {
message => q|Web Services Client Asset Template Variables|,
lastUpdated => 1164841146
},
};
1;

25
lib/WebGUI/i18n/English/Tax.pm
View file

@ -73,6 +73,31 @@ our $I18N = {
lastUpdated => 1206395083,
},
'override tax rate' => {
message => q|Override tax rate?|,
lastUpdated => 0,
context => q|A yes/no field asking whether to override tax rate.|
},
'override tax rate help' => {
message => q|Would you like to override the default tax rate for this item? Usually used in locales that have special or no tax on life essential items like food and clothing.|,
lastUpdated => 0,
context => q|help for override tax rate field|
},
'tax rate override' => {
message => q|Tax Rate Override|,
lastUpdated => 0,
context => q|a field containing the percentage to use to calculate tax for this item|
},
'tax rate override help' => {
message => q|What is the new percentage that should be used to calculate tax on this item?|,
lastUpdated => 0,
context => q|help for tax rate override field|
},
};
1;

6
lib/WebGUI/i18n/English/WebGUI.pm
View file

@ -961,6 +961,12 @@ to add or remove users from their groups.
lastUpdated => 1036864905
},
'view profile' => {
message => q|View user's profile.|,
context => q|Label for a URL to view the profile for the user. Used in Operation/User.pm|,
lastUpdated => 1239926712
},
'60' => {
message => q|Are you certain you want to deactivate your account. If you proceed your account information will be lost permanently.|,
lastUpdated => 1031514049

53
lib/WebGUI/i18n/English/Workflow_Activity_ExpirePurchasedThingyRecords.pm Normal file
View file

@ -0,0 +1,53 @@
package WebGUI::i18n::English::Workflow_Activity_ExpirePurchasedThingyRecords;
use strict;
our $I18N = {
'topicName' => {
message => "Expire Purchased Thingy Records",
lastUpdated => 0,
},
'default notification' => {
message => q{Your subscription is about to expire!},
lastUpdated => 0,
context => "The default notification message when a ThingyRecord is about to expire.",
},
'default notification subject' => {
message => q{Important notice about your subscription},
lastUpdated => 0,
context => "The default notification message subject",
},
'notificationOffset label' => {
message => q{Notification Offset},
lastUpdated => 0,
context => "Label for workflow activity property",
},
'notificationOffset description' => {
message => q{The amount of time before the ThingyRecord expires when the notification is sent.},
lastUpdated => 0,
context => "Description of workflow activity property",
},
'notificationMessage label' => {
message => q{Notification Message},
lastUpdated => 0,
context => "Label for workflow activity property",
},
'notificationMessage description' => {
message => q{The message to send for the notification},
lastUpdated => 0,
context => "Description of workflow activity property",
},
'notificationSubject label' => {
message => q{Notification Message Subject},
lastUpdated => 0,
context => "Label for workflow activity property",
},
'notificationSubject description' => {
message => q{The subject of the message to send},
lastUpdated => 0,
context => "Description of workflow activity property",
},
};
1;
#vim:ft=perl