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

Merge commit '469c2b72b4' into WebGUI8. All tests passing.

Browse source
This commit is contained in:
Colin Kuskie 2010-07-01 10:13:22 -07:00
commit 565cf955d7
147 changed files with 1526 additions and 1283 deletions
Download patch file Download diff file Expand all files Collapse all files

17
docs/changelog/7.x.x.txt
View file

@ -1,3 +1,20 @@
7.9.8
- fixed #11651: First Day of Week is a string...
- fixed #11656: Thingy: Select list fields are not sorted properly
- fixed #11662: yahooapis.com sourced links
- fixed #11658: tmpl var message missing in template help for the cart
- fixed: many other template variables for the cart
- fixed #11628: Message Board: Last Post doesn't show up in CS Thread List
- fixed #11646: Post and Thread Last Post
- fixed #11626: Duplicate messages from Collab Systems
- fixed #11667: Shop: unable to remove item from Cart
- fixed #11550: Pending assets in the clipboard or trash are not visible from the approval screen
- fixed #11678: Story Archive leaks version tags
- fixed #11671: Approving version tags takes up 1 to hour to take affect.
- fixed #11663: More detail section of image gallery
- fixed #11681: Gallery album chokes on photo w/ missing properties
- fixed #11612: Thingy: Search on "list" type fields does not work properly
7.9.7
- added #11571: Allow return from photo edit view to gallery edit view
- fixed: Reject form submissions without image selected for upload in edit view of Photo asset

30
docs/create.sql
View file

File diff suppressed because one or more lines are too long

30
docs/previousVersion.sql
View file

File diff suppressed because one or more lines are too long

BIN
docs/upgrades/packages-7.9.3/default-wiki-front-page.wgpkg
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.9.3/home_map_map-templates_default-edit-map-point.wgpkg
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.9.3/home_map_map-templates_default-map-point-view.wgpkg
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.9.4/crystalx.wgpkg
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.9.4/greenportal.wgpkg
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.9.4/root_import_account_inbox_default-inbox-view-template.wgpkg
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.9.4/root_import_wiki.wgpkg
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.9.4/shopping-cart-collateral-items.wgpkg
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.9.4/style-underground.wgpkg
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.9.4/style_01.wgpkg
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.9.4/style_02.wgpkg
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.9.4/style_03.wgpkg
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.9.5/root_import_collaboration.wgpkg
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.9.5/root_import_gallery-templates_default-gallery-add-archive.wgpkg
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.9.5/wiki-master-by-keyword-template.tmpl.wgpkg
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.9.6/root_import_gallery-templates_default-gallery-add-archive.wgpkg
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.9.6/root_import_gallery-templates_default-gallery-search.wgpkg
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.9.6/root_import_gallery-templates_default-gallery-view-photo.wgpkg
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.9.7/root_import_gallery-templates_admin.css.wgpkg
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.9.7/root_import_gallery-templates_default-gallery-edit-album.wgpkg
View file

Binary file not shown.

176
docs/upgrades/upgrade_7.9.2-7.9.3.pl
View file

@ -1,176 +0,0 @@
#!/usr/bin/env perl
#-------------------------------------------------------------------
# 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
#-------------------------------------------------------------------
our ($webguiRoot);
BEGIN {
$webguiRoot = "../..";
unshift (@INC, $webguiRoot."/lib");
}
use strict;
use Getopt::Long;
use WebGUI::Session;
use WebGUI::Storage;
use WebGUI::Asset;
my $toVersion = '7.9.3';
my $quiet; # this line required
my $session = start(); # this line required
reindexSiteForDefaultSynopsis( $session );
addTopLevelWikiKeywords( $session );
renameMapPointStateColumn( $session );
finish($session); # this line required
#----------------------------------------------------------------------------
# Describe what our function does
#sub exampleFunction {
# my $session = shift;
# print "\tWe're doing some stuff here that you should know about... " unless $quiet;
# # and here's our code
# print "DONE!\n" unless $quiet;
#}
#----------------------------------------------------------------------------
sub renameMapPointStateColumn {
my $session = shift;
print "\tRename the MapPoint column state to region... " unless $quiet;
$session->db->write('ALTER TABLE MapPoint CHANGE state region char(35)');
print "Done.\n" unless $quiet;
}
#----------------------------------------------------------------------------
sub addTopLevelWikiKeywords {
my $session = shift;
print "\tAdding top level keywords page to WikiMaster... " unless $quiet;
my $sth = $session->db->read('DESCRIBE `WikiMaster`');
while (my ($col) = $sth->array) {
if ($col eq 'topLevelKeywords') {
print "Skipped.\n" unless $quiet;
return;
}
}
$session->db->write('ALTER TABLE WikiMaster ADD COLUMN topLevelKeywords LONGTEXT');
print "Done.\n" unless $quiet;
}
#----------------------------------------------------------------------------
# Reindex the site to clear out default synopsis
sub reindexSiteForDefaultSynopsis {
my $session = shift;
print "\tRe-indexing site to clear out default synopses... " unless $quiet;
my $rs = $session->db->read("select assetId, className from asset where state='published'");
my @searchableAssetIds;
while (my ($id, $class) = $rs->array) {
my $asset = WebGUI::Asset->new($session,$id,$class);
if (defined $asset && $asset->get("state") eq "published" && ($asset->get("status") eq "approved" || $asset->get("status") eq "archived")) {
$asset->indexContent;
push (@searchableAssetIds, $id);
}
}
# delete indexes of assets that are no longer searchable
my $list = $session->db->quoteAndJoin(\@searchableAssetIds) if scalar(@searchableAssetIds);
$session->db->write("delete from assetIndex where assetId not in (".$list.")") if $list;
print "DONE!\n" unless $quiet;
}
# -------------- DO NOT EDIT BELOW THIS LINE --------------------------------
#----------------------------------------------------------------------------
# Add a package to the import node
sub addPackage {
my $session = shift;
my $file = shift;
print "\tUpgrading package $file\n" unless $quiet;
# Make a storage location for the package
my $storage = WebGUI::Storage->createTemp( $session );
$storage->addFileFromFilesystem( $file );
# Import the package into the import node
my $package = eval {
my $node = WebGUI::Asset->getImportNode($session);
$node->importPackage( $storage, {
overwriteLatest => 1,
clearPackageFlag => 1,
setDefaultTemplate => 1,
} );
};
if ($package eq 'corrupt') {
die "Corrupt package found in $file. Stopping upgrade.\n";
}
if ($@ || !defined $package) {
die "Error during package import on $file: $@\nStopping upgrade\n.";
}
return;
}
#-------------------------------------------------
sub start {
my $configFile;
$|=1; #disable output buffering
GetOptions(
'configFile=s'=>\$configFile,
'quiet'=>\$quiet
);
my $session = WebGUI::Session->open($webguiRoot,$configFile);
$session->user({userId=>3});
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"Upgrade to ".$toVersion});
return $session;
}
#-------------------------------------------------
sub finish {
my $session = shift;
updateTemplates($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->commit;
$session->db->write("insert into webguiVersion values (".$session->db->quote($toVersion).",'upgrade',".time().")");
$session->close();
}
#-------------------------------------------------
sub updateTemplates {
my $session = shift;
return undef unless (-d "packages-".$toVersion);
print "\tUpdating packages.\n" unless ($quiet);
opendir(DIR,"packages-".$toVersion);
my @files = readdir(DIR);
closedir(DIR);
my $newFolder = undef;
foreach my $file (@files) {
next unless ($file =~ /\.wgpkg$/);
# Fix the filename to include a path
$file = "packages-" . $toVersion . "/" . $file;
addPackage( $session, $file );
}
}
#vim:ft=perl

267
docs/upgrades/upgrade_7.9.3-7.9.4.pl
View file

@ -1,267 +0,0 @@
#!/usr/bin/env perl
#-------------------------------------------------------------------
# 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
#-------------------------------------------------------------------
our ($webguiRoot);
BEGIN {
$webguiRoot = "../..";
unshift (@INC, $webguiRoot."/lib");
}
use strict;
use Getopt::Long;
use WebGUI::Session;
use WebGUI::Storage;
use WebGUI::Asset;
use WebGUI::Asset::WikiPage;
use WebGUI::Exception;
use WebGUI::Shop::Pay;
my $toVersion = '7.9.4';
my $quiet; # this line required
my $session = start(); # this line required
# upgrade functions go here
addWikiSubKeywords($session);
addSynopsistoEachWikiPage($session);
dropVisitorAddressBooks($session);
alterCartTable($session);
alterAddressBookTable($session);
addWizardHandler( $session );
addTemplateExampleImage( $session );
addPayDriverTemplates( $session );
finish($session); # this line required
#----------------------------------------------------------------------------
# Describe what our function does
#sub exampleFunction {
# my $session = shift;
# print "\tWe're doing some stuff here that you should know about... " unless $quiet;
# # and here's our code
# print "DONE!\n" unless $quiet;
#}
#----------------------------------------------------------------------------
# Add example images to templates
sub addTemplateExampleImage {
my $session = shift;
print "\tAdding example image field to template... " unless $quiet;
$session->db->write( q{
ALTER TABLE template ADD storageIdExample CHAR(22)
} );
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
sub addWizardHandler {
my ( $sesssion ) = @_;
print "\tAdding WebGUI::Wizard... " unless $quiet;
if ( !grep { $_ eq 'WebGUI::Content::Wizard' } @{$session->config->get('contentHandlers')} ) {
# Find the place of Operation and add before
my @handlers = ();
for my $handler ( @{$session->config->get('contentHandlers')} ) {
if ( $handler eq 'WebGUI::Content::Operation' ) {
push @handlers, 'WebGUI::Content::Wizard';
}
push @handlers, $handler;
}
$session->config->set('contentHandlers',\@handlers);
}
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
sub addWikiSubKeywords {
my $session = shift;
print "\tAdd the WikiMaster sub-keywords table... " unless $quiet;
# and here's our code
$session->db->write(<<EOSQL);
CREATE TABLE IF NOT EXISTS WikiMasterKeywords (
assetId CHAR(22) binary not null,
keyword CHAR(64) not null,
subKeyword CHAR(64),
PRIMARY KEY (`assetId`,`keyword`, `subKeyword`),
KEY `assetId` (`assetId`),
KEY `keyword` (`keyword`),
KEY `subKeyword` (`subKeyword`)
)
EOSQL
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
sub addSynopsistoEachWikiPage {
my $session = shift;
print "\tAdd a synopsis to each wiki page this may take a while... " unless $quiet;
my $pager = WebGUI::Asset::WikiPage->getIsa($session);
PAGE: while (1) {
my $page = eval {$pager->()};
next PAGE if Exception::Class->caught();
last PAGE unless $page;
my ($synopsis) = $page->getSynopsisAndContent(undef, $page->get('content'));
$page->update({synopsis => $synopsis});
}
# and here's our code
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
sub dropVisitorAddressBooks {
my $session = shift;
print "\tDrop AddressBooks owned by Visitor... " unless $quiet;
my $sth = $session->db->read(q|SELECT addressBookId FROM addressBook where userId='1'|);
BOOK: while (my ($addressBookId) = $sth->array) {
my $book = eval { WebGUI::Shop::AddressBook->new($session, $addressBookId); };
next BOOK if Exception::Class->caught();
$book->delete;
}
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
sub alterAddressBookTable {
my $session = shift;
print "\tDrop sessionId from the Address Book database table... " unless $quiet;
# and here's our code
$session->db->write("ALTER TABLE addressBook DROP COLUMN sessionId");
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
sub alterCartTable {
my $session = shift;
print "\tAdd billing address column to the Cart table... " unless $quiet;
# and here's our code
$session->db->write("ALTER TABLE cart ADD COLUMN billingAddressId CHAR(22)");
$session->db->write("ALTER TABLE cart ADD COLUMN gatewayId CHAR(22)");
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
sub addPayDriverTemplates {
my $session = shift;
print "\tAdd templates to the Payment Drivers that need them... " unless $quiet;
# and here's our code
my $pay = WebGUI::Shop::Pay->new($session);
my @gateways = @{ $pay->getPaymentGateways };
GATEWAY: foreach my $gateway (@gateways) {
next GATEWAY unless $gateway;
my $properties = $gateway->get;
if ($gateway->isa('WebGUI::Shop::PayDriver::Cash')) {
$properties->{summaryTemplateId} = '30h5rHxzE_Q0CyI3Gg7EJw';
}
elsif ($gateway->isa('WebGUI::Shop::PayDriver::ITransact')) {
##Nothing to do. This template was only changed, not added.
}
elsif ($gateway->isa('WebGUI::Shop::PayDriver::Ogone')) {
$properties->{summaryTemplateId} = 'jysVZeUR0Bx2NfrKs5sulg';
}
elsif ($gateway->isa('WebGUI::Shop::PayDriver::PayPal::PayPalStd')) {
$properties->{summaryTemplateId} = '300AozDaeveAjB_KN0ljlQ';
}
elsif ($gateway->isa('WebGUI::Shop::PayDriver::PayPal::ExpressCheckout')) {
$properties->{summaryTemplateId} = 'GqnZPB0gLoZmqQzYFaq7bg';
}
else {
die "Unknown payment driver type found. Unable to automatically upgrade.\n";
}
$gateway->update($properties);
}
print "DONE!\n" unless $quiet;
}
# -------------- DO NOT EDIT BELOW THIS LINE --------------------------------
#----------------------------------------------------------------------------
# Add a package to the import node
sub addPackage {
my $session = shift;
my $file = shift;
print "\tUpgrading package $file\n" unless $quiet;
# Make a storage location for the package
my $storage = WebGUI::Storage->createTemp( $session );
$storage->addFileFromFilesystem( $file );
# Import the package into the import node
my $package = eval {
my $node = WebGUI::Asset->getImportNode($session);
$node->importPackage( $storage, {
overwriteLatest => 1,
clearPackageFlag => 1,
setDefaultTemplate => 1,
} );
};
if ($package eq 'corrupt') {
die "Corrupt package found in $file. Stopping upgrade.\n";
}
if ($@ || !defined $package) {
die "Error during package import on $file: $@\nStopping upgrade\n.";
}
return;
}
#-------------------------------------------------
sub start {
my $configFile;
$|=1; #disable output buffering
GetOptions(
'configFile=s'=>\$configFile,
'quiet'=>\$quiet
);
my $session = WebGUI::Session->open($webguiRoot,$configFile);
$session->user({userId=>3});
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"Upgrade to ".$toVersion});
return $session;
}
#-------------------------------------------------
sub finish {
my $session = shift;
updateTemplates($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->commit;
$session->db->write("insert into webguiVersion values (".$session->db->quote($toVersion).",'upgrade',".time().")");
$session->close();
}
#-------------------------------------------------
sub updateTemplates {
my $session = shift;
return undef unless (-d "packages-".$toVersion);
print "\tUpdating packages.\n" unless ($quiet);
opendir(DIR,"packages-".$toVersion);
my @files = readdir(DIR);
closedir(DIR);
my $newFolder = undef;
foreach my $file (@files) {
next unless ($file =~ /\.wgpkg$/);
# Fix the filename to include a path
$file = "packages-" . $toVersion . "/" . $file;
addPackage( $session, $file );
}
}
#vim:ft=perl

207
docs/upgrades/upgrade_7.9.4-7.9.5.pl
View file

@ -1,207 +0,0 @@
#!/usr/bin/env perl
#-------------------------------------------------------------------
# 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
#-------------------------------------------------------------------
our ($webguiRoot);
BEGIN {
$webguiRoot = "../..";
unshift (@INC, $webguiRoot."/lib");
}
use strict;
use Getopt::Long;
use WebGUI::Session;
use WebGUI::Storage;
use WebGUI::Asset;
use WebGUI::Workflow::Instance;
my $toVersion = '7.9.5';
my $quiet; # this line required
my $session = start(); # this line required
# upgrade functions go here
modifySortItems( $session );
fixRequestForApprovalScratch($session);
addRejectNoticeSetting($session);
updateGroupGroupingsTable($session);
installNewCSUnsubscribeTemplate($session);
finish($session); # this line required
#----------------------------------------------------------------------------
# Describe what our function does
#sub exampleFunction {
# my $session = shift;
# print "\tWe're doing some stuff here that you should know about... " unless $quiet;
# # and here's our code
# print "DONE!\n" unless $quiet;
#}
#----------------------------------------------------------------------------
# Adds setting which allows users to set whether or not to send reject notices
sub addRejectNoticeSetting {
my $session = shift;
print "\tAdding reject notice setting... " unless $quiet;
$session->setting->add('sendRejectNotice',1);
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
sub installNewCSUnsubscribeTemplate {
my $session = shift;
print "\tAdding new unsubscribe template to the CS... " unless $quiet;
$session->db->write(q|ALTER TABLE Collaboration ADD COLUMN unsubscribeTemplateId CHAR(22) NOT NULL|);
$session->db->write(q|UPDATE Collaboration set unsubscribeTemplateId='default_CS_unsubscribe'|);
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
# Add keys and indicies to groupGroupings to help speed up group queries
sub updateGroupGroupingsTable {
my $session = shift;
print "\tAdding primary key and indicies to groupGroupings table... " unless $quiet;
my $sth = $session->db->read('show create table groupGroupings');
my ($field,$stmt) = $sth->array;
$sth->finish;
unless ($stmt =~ m/PRIMARY KEY/i) {
$session->db->write("alter table groupGroupings add primary key (groupId,inGroup)");
}
unless ($stmt =~ m/KEY `inGroup`/i) {
$session->db->write("alter table groupGroupings add index inGroup (inGroup)");
}
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
# Describe what our function does
sub fixRequestForApprovalScratch {
my $session = shift;
print "\tCorrect RequestApprovalForVersionTag workflow instance data with leading commas... " unless $quiet;
# and here's our code
my $instances = WebGUI::Workflow::Instance->getAllInstances($session);
INSTANCE: foreach my $instance (@{ $instances }) {
my $messageId = $instance->getScratch('messageId');
next INSTANCE unless $messageId;
$messageId =~ s/^,//;
$instance->setScratch('messageId', $messageId);
}
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
# Changes sortItems to a SelectBox
sub modifySortItems {
my $session = shift;
print "\tUpdating SyndicatedContent...\n" unless $quiet;
require WebGUI::Form::SelectBox;
print "\t\tModifying table...\n" unless $quiet;
my $type = WebGUI::Form::SelectBox->getDatabaseFieldType;
$session->db->write("ALTER TABLE SyndicatedContent MODIFY sortItems $type");
print "\t\tConverting old values..." unless $quiet;
$session->db->write(q{
UPDATE SyndicatedContent
SET sortItems = 'none'
WHERE sortItems <> '1'
});
$session->db->write(q{
UPDATE SyndicatedContent
SET sortItems = 'pubDate_des'
WHERE sortItems = '1'
});
# and here's our code
print "DONE!\n" unless $quiet;
}
# -------------- DO NOT EDIT BELOW THIS LINE --------------------------------
#----------------------------------------------------------------------------
# Add a package to the import node
sub addPackage {
my $session = shift;
my $file = shift;
print "\tUpgrading package $file\n" unless $quiet;
# Make a storage location for the package
my $storage = WebGUI::Storage->createTemp( $session );
$storage->addFileFromFilesystem( $file );
# Import the package into the import node
my $package = eval {
my $node = WebGUI::Asset->getImportNode($session);
$node->importPackage( $storage, {
overwriteLatest => 1,
clearPackageFlag => 1,
setDefaultTemplate => 1,
} );
};
if ($package eq 'corrupt') {
die "Corrupt package found in $file. Stopping upgrade.\n";
}
if ($@ || !defined $package) {
die "Error during package import on $file: $@\nStopping upgrade\n.";
}
return;
}
#-------------------------------------------------
sub start {
my $configFile;
$|=1; #disable output buffering
GetOptions(
'configFile=s'=>\$configFile,
'quiet'=>\$quiet
);
my $session = WebGUI::Session->open($webguiRoot,$configFile);
$session->user({userId=>3});
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"Upgrade to ".$toVersion});
return $session;
}
#-------------------------------------------------
sub finish {
my $session = shift;
updateTemplates($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->commit;
$session->db->write("insert into webguiVersion values (".$session->db->quote($toVersion).",'upgrade',".time().")");
$session->close();
}
#-------------------------------------------------
sub updateTemplates {
my $session = shift;
return undef unless (-d "packages-".$toVersion);
print "\tUpdating packages.\n" unless ($quiet);
opendir(DIR,"packages-".$toVersion);
my @files = readdir(DIR);
closedir(DIR);
my $newFolder = undef;
foreach my $file (@files) {
next unless ($file =~ /\.wgpkg$/);
# Fix the filename to include a path
$file = "packages-" . $toVersion . "/" . $file;
addPackage( $session, $file );
}
}
#vim:ft=perl

161
docs/upgrades/upgrade_7.9.5-7.9.6.pl
View file

@ -1,161 +0,0 @@
#!/usr/bin/env perl
#-------------------------------------------------------------------
# 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
#-------------------------------------------------------------------
our ($webguiRoot);
BEGIN {
$webguiRoot = "../..";
unshift (@INC, $webguiRoot."/lib");
}
use strict;
use Getopt::Long;
use WebGUI::Session;
use WebGUI::Storage;
use WebGUI::Asset;
my $toVersion = '7.9.6';
my $quiet; # this line required
my $session = start(); # this line required
# upgrade functions go here
fixConvertUTCMacroName($session);
dropOldEMSTableColumn($session);
addIndexForInbox($session);
finish($session); # this line required
#----------------------------------------------------------------------------
# Describe what our function does
#sub exampleFunction {
# my $session = shift;
# print "\tWe're doing some stuff here that you should know about... " unless $quiet;
# # and here's our code
# print "DONE!\n" unless $quiet;
#}
#----------------------------------------------------------------------------
# Add keys and indicies to groupGroupings to help speed up group queries
sub addIndexForInbox {
my $session = shift;
print "\tAdding index to inbox_messageState... " unless $quiet;
my $sth = $session->db->read('show create table inbox_messageState');
my ($field,$stmt) = $sth->array;
$sth->finish;
unless ($stmt =~ m/KEY `userId_deleted_isRead`/i) {
$session->db->write("alter table inbox_messageState add index userId_deleted_isRead (userId,deleted,isRead)");
}
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
# Describe what our function does
sub fixConvertUTCMacroName {
my $session = shift;
print "\tFix the name of the ConvertUTCToTZ macro in the config file... " unless $quiet;
$session->config->deleteFromHash('macros', 'ConvertToUTC');
$session->config->addToHash('macros', 'ConvertUTCToTZ', 'ConvertUTCToTZ');
# and here's our code
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
# Describe what our function does
sub dropOldEMSTableColumn {
my $session = shift;
print "\tDrop an old column from the EventMangementSystem table that is no longer used... " unless $quiet;
$session->db->write(q|ALTER TABLE EventManagementSystem DROP COLUMN groupToApproveEvents|);
# and here's our code
print "DONE!\n" unless $quiet;
}
# -------------- DO NOT EDIT BELOW THIS LINE --------------------------------
#----------------------------------------------------------------------------
# Add a package to the import node
sub addPackage {
my $session = shift;
my $file = shift;
print "\tUpgrading package $file\n" unless $quiet;
# Make a storage location for the package
my $storage = WebGUI::Storage->createTemp( $session );
$storage->addFileFromFilesystem( $file );
# Import the package into the import node
my $package = eval {
my $node = WebGUI::Asset->getImportNode($session);
$node->importPackage( $storage, {
overwriteLatest => 1,
clearPackageFlag => 1,
setDefaultTemplate => 1,
} );
};
if ($package eq 'corrupt') {
die "Corrupt package found in $file. Stopping upgrade.\n";
}
if ($@ || !defined $package) {
die "Error during package import on $file: $@\nStopping upgrade\n.";
}
return;
}
#-------------------------------------------------
sub start {
my $configFile;
$|=1; #disable output buffering
GetOptions(
'configFile=s'=>\$configFile,
'quiet'=>\$quiet
);
my $session = WebGUI::Session->open($webguiRoot,$configFile);
$session->user({userId=>3});
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"Upgrade to ".$toVersion});
return $session;
}
#-------------------------------------------------
sub finish {
my $session = shift;
updateTemplates($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->commit;
$session->db->write("insert into webguiVersion values (".$session->db->quote($toVersion).",'upgrade',".time().")");
$session->close();
}
#-------------------------------------------------
sub updateTemplates {
my $session = shift;
return undef unless (-d "packages-".$toVersion);
print "\tUpdating packages.\n" unless ($quiet);
opendir(DIR,"packages-".$toVersion);
my @files = readdir(DIR);
closedir(DIR);
my $newFolder = undef;
foreach my $file (@files) {
next unless ($file =~ /\.wgpkg$/);
# Fix the filename to include a path
$file = "packages-" . $toVersion . "/" . $file;
addPackage( $session, $file );
}
}
#vim:ft=perl

241
docs/upgrades/upgrade_7.9.6-7.9.7.pl
View file

@ -1,241 +0,0 @@
#!/usr/bin/env perl
#-------------------------------------------------------------------
# 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
#-------------------------------------------------------------------
our ($webguiRoot);
BEGIN {
$webguiRoot = "../..";
unshift (@INC, $webguiRoot."/lib");
}
use strict;
use Getopt::Long;
use WebGUI::Session;
use WebGUI::Storage;
use WebGUI::Asset;
use WebGUI::Asset::Wobject::Collaboration;
use WebGUI::Exception;
use WebGUI::Workflow::Cron;
use WebGUI::Utility qw/isIn/;
my $toVersion = '7.9.7';
my $quiet; # this line required
my $session = start(); # this line required
# upgrade functions go here
restoreDefaultCronJobs($session);
restoreCsCronJobs($session);
cleanup_inbox_messageStateTable($session);
finish($session); # this line required
#----------------------------------------------------------------------------
# Describe what our function does
#sub exampleFunction {
# my $session = shift;
# print "\tWe're doing some stuff here that you should know about... " unless $quiet;
# # and here's our code
# print "DONE!\n" unless $quiet;
#}
#----------------------------------------------------------------------------
# Describe what our function does
sub cleanup_inbox_messageStateTable {
my $session = shift;
print "\tDelete dead entries from the inbox_MessageState table. This may take a long time... " unless $quiet;
# and here's our code
my $source = $session->db->read("select messageId from inbox_messageState s where not exists(select messageId from inbox where messageId = s.messageId)");
my $cleaner = $session->db->prepare("delete from inbox_messageState where messageId=?");
while (my ($messageId) = $source->array) {
$cleaner->execute([$messageId]);
}
$source->finish;
$cleaner->finish;
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
# Describe what our function does
sub restoreDefaultCronJobs {
my $session = shift;
# and here's our code
print "\tRestore missing default cron jobs that may have been deleted... " unless $quiet;
my $tasks = WebGUI::Workflow::Cron->getAllTasks($session);
my @taskIds = map { $_->getId } @{ $tasks };
if (! isIn('pbcron0000000000000001', @taskIds)) {
print "\n\t\tRestoring Daily Maintenance Task... " unless $quiet;
WebGUI::Workflow::Cron->create($session, {
title => "Daily Maintenance", dayOfMonth => '*',
enabled => 1, monthOfYear => '*',
runOnce => 0, dayOfWeek => '*',
minuteOfHour => 30, workflowId => 'pbworkflow000000000001',
hourOfDay => 23, priority => 3,
},
'pbcron0000000000000001');
}
if (! isIn('pbcron0000000000000002', @taskIds)) {
print "\n\t\tRestoring Weekly Maintenance Task... " unless $quiet;
WebGUI::Workflow::Cron->create($session, {
title => "Weekly Maintenance", dayOfMonth => '*',
enabled => 1, monthOfYear => '*',
runOnce => 0, dayOfWeek => '0',
minuteOfHour => 30, workflowId => 'pbworkflow000000000002',
hourOfDay => 1, priority => 3,
},
'pbcron0000000000000002');
}
if (! isIn('pbcron0000000000000003', @taskIds)) {
print "\n\t\tRestoring Hourly Maintenance Task... " unless $quiet;
WebGUI::Workflow::Cron->create($session, {
title => "Hourly Maintenance", dayOfMonth => '*',
enabled => 1, monthOfYear => '*',
runOnce => 0, dayOfWeek => '*',
minuteOfHour => 15, workflowId => 'pbworkflow000000000004',
hourOfDay => '*', priority => 3,
},
'pbcron0000000000000003');
}
if (! isIn('pbcron0000000000000004', @taskIds)) {
print "\n\t\tRestoring Email Delivery Task... " unless $quiet;
WebGUI::Workflow::Cron->create($session, {
title => "Send Queued Email Messages Every 5 Minutes",
dayOfMonth => '*',
enabled => 1, monthOfYear => '*',
runOnce => 0, dayOfWeek => '*',
minuteOfHour => '*/5', workflowId => 'pbworkflow000000000007',
hourOfDay => '*', priority => 3,
},
'pbcron0000000000000004');
}
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
# Describe what our function does
sub restoreCsCronJobs {
my $session = shift;
print "\tRestore missing Collaboration System cron jobs that may have been deleted... " unless $quiet;
my $i18n = WebGUI::International->new($session, "Asset_Collaboration");
my $getCs = WebGUI::Asset::Wobject::Collaboration->getIsa($session);
CS: while (1) {
my $cs = eval { $getCs->(); };
if (my $e = Exception::Class->caught()) {
$session->log->error($@);
next CS;
}
last CS unless $cs;
##Do something useful with $product
my $cron = undef;
if ($cs->get("getMailCronId")) {
$cron = WebGUI::Workflow::Cron->new($session, $cs->get("getMailCronId"));
}
next CS if $cron;
$cron = WebGUI::Workflow::Cron->create($session, {
title => $cs->getTitle." ".$i18n->get("mail"),
minuteOfHour => "*/".($cs->get("getMailInterval")/60),
className => (ref $cs),
methodName => "new",
parameters => $cs->getId,
workflowId => "csworkflow000000000001"
});
$cs->update({getMailCronId=>$cron->getId});
if ($cs->get("getMail")) {
$cron->set({enabled=>1,title=>$cs->getTitle." ".$i18n->get("mail"), minuteOfHour=>"*/".($cs->get("getMailInterval")/60)});
} else {
$cron->set({enabled=>0,title=>$cs->getTitle." ".$i18n->get("mail"), minuteOfHour=>"*/".($cs->get("getMailInterval")/60)});
}
}
print "DONE!\n" unless $quiet;
}
# -------------- DO NOT EDIT BELOW THIS LINE --------------------------------
#----------------------------------------------------------------------------
# Add a package to the import node
sub addPackage {
my $session = shift;
my $file = shift;
print "\tUpgrading package $file\n" unless $quiet;
# Make a storage location for the package
my $storage = WebGUI::Storage->createTemp( $session );
$storage->addFileFromFilesystem( $file );
# Import the package into the import node
my $package = eval {
my $node = WebGUI::Asset->getImportNode($session);
$node->importPackage( $storage, {
overwriteLatest => 1,
clearPackageFlag => 1,
setDefaultTemplate => 1,
} );
};
if ($package eq 'corrupt') {
die "Corrupt package found in $file. Stopping upgrade.\n";
}
if ($@ || !defined $package) {
die "Error during package import on $file: $@\nStopping upgrade\n.";
}
return;
}
#-------------------------------------------------
sub start {
my $configFile;
$|=1; #disable output buffering
GetOptions(
'configFile=s'=>\$configFile,
'quiet'=>\$quiet
);
my $session = WebGUI::Session->open($webguiRoot,$configFile);
$session->user({userId=>3});
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"Upgrade to ".$toVersion});
return $session;
}
#-------------------------------------------------
sub finish {
my $session = shift;
updateTemplates($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->commit;
$session->db->write("insert into webguiVersion values (".$session->db->quote($toVersion).",'upgrade',".time().")");
$session->close();
}
#-------------------------------------------------
sub updateTemplates {
my $session = shift;
return undef unless (-d "packages-".$toVersion);
print "\tUpdating packages.\n" unless ($quiet);
opendir(DIR,"packages-".$toVersion);
my @files = readdir(DIR);
closedir(DIR);
my $newFolder = undef;
foreach my $file (@files) {
next unless ($file =~ /\.wgpkg$/);
# Fix the filename to include a path
$file = "packages-" . $toVersion . "/" . $file;
addPackage( $session, $file );
}
}
#vim:ft=perl

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

@ -118,6 +118,7 @@ sub _fixReplyCount {
my $lastPostId = $asset->getLineage( [ qw{ self descendants } ], {
isa => 'WebGUI::Asset::Post',
orderByClause => 'assetData.revisionDate desc',
limit => 1,
} )->[0];
my $lastPost = eval { WebGUI::Asset->newById( $self->session, $lastPostId ); };
if ( ! Exception::Class->caught() ) {
@ -322,6 +323,53 @@ override cut => sub {
#-------------------------------------------------------------------
=head2 disqualifyAsLastPost ( )
This method should be called whenever something happens to the Post or Thread that would disqualify
it as being the last post in a Thread, or Collaboration System. Good examples are cutting to the
clipboard, trashing, or archiving.
If the Post was the last post, it will find the second to last post for each kind of parent asset,
and update that asset with that Post's information.
=cut
sub disqualifyAsLastPost {
my $self = shift;
my $thread = $self->getThread;
if ($thread->get('lastPostId') eq $self->getId) {
my $secondary_post = $thread->getLineage(['descendants'], {
returnObjects => 1,
includeOnlyClasses => ["WebGUI::Asset::Post", ],
limit => 1,
orderByClause => 'revisionDate,lineage DESC',
})->[0];
if ($secondary_post) { ##Handle edge case for no other
$thread->update({ lastPostId => $secondary_post->getId, lastPostDate => $secondary_post->get('creationDate'), });
}
else {
$thread->update({ lastPostId => '', lastPostDate => '', });
}
}
my $cs = $thread->getParent;
if ($cs->get('lastPostId') eq $self->getId) {
my $secondary_post = $cs->getLineage(['descendants'], {
returnObjects => 1,
includeOnlyClasses => ["WebGUI::Asset::Post","WebGUI::Asset::Post::Thread"],
limit => 1,
orderByClause => 'revisionDate DESC',
})->[0];
if ($secondary_post) { ##Handle edge case for no other
$cs->update({ lastPostId => $secondary_post->getId, lastPostDate => $secondary_post->get('creationDate'), });
}
else {
$cs->update({ lastPostId => '', lastPostDate => '', });
}
}
}
#-------------------------------------------------------------------
=head2 DESTROY
Extend the base method to delete the locally cached thread object.
@ -1109,6 +1157,22 @@ sub postProcess {
#-------------------------------------------------------------------
=head2 publish
Extend the base method to handle updating last post information in the parent Thread
and CS.
=cut
sub publish {
my $self = shift;
$self->next::method(@_);
$self->qualifyAsLastPost;
return 1;
}
#-------------------------------------------------------------------
=head2 purge
Extend the base method to handle cleaning up storage locations.
@ -1156,6 +1220,31 @@ override purgeRevision => sub {
#-------------------------------------------------------------------
=head2 qualifyAsLastPost ( )
This method should be called whenever something happens to the Post or Thread that would qualify
it as being the last post in a Thread, or Collaboration System. Good examples are pasting from
the clipboard, restoring from the trash, or changing the state from archiving.
It checks the parent Thread and CS to see if it is now the last Post, and updates that asset with
its information.
=cut
sub qualifyAsLastPost {
my ($self) = @_;
my $thread = $self->getThread();
if ($self->get('creationDate') > $thread->get('lastPostDate')) {
$thread->update({ lastPostId => $self->getId, lastPostDate => $self->get('creationDate'), });
}
my $cs = $thread->getParent;
if ($self->get('creationDate') > $cs->get('lastPostDate')) {
$cs->update({ lastPostId => $self->getId, lastPostDate => $self->get('creationDate'), });
}
}
#-------------------------------------------------------------------
=head2 rate ( rating )
@ -1260,14 +1349,16 @@ override setParent => sub {
=head2 setStatusArchived ( )
Sets the status of this post to archived.
Sets the status of this post to archived. Updates the parent thread and CS to remove
the lastPost, if this post is the last post.
=cut
sub setStatusArchived {
my ($self) = @_;
$self->update({status=>'archived'});
my ($self) = @_;
$self->update({status=>'archived'});
$self->disqualifyAsLastPost;
}
@ -1276,20 +1367,23 @@ sub setStatusArchived {
=head2 setStatusUnarchived ( )
Sets the status of this post to approved, but does so without any of the normal notifications and other stuff.
Updates the last post information in the parent Thread and CS if applicable.
=cut
sub setStatusUnarchived {
my ($self) = @_;
$self->update({status=>'approved'}) if ($self->status eq "archived");
my ($self) = @_;
$self->update({status=>'approved'}) if ($self->status eq "archived");
$self->qualifyAsLastPost;
}
#-------------------------------------------------------------------
=head2 trash ( )
Moves post to the trash, updates reply counter on thread and recalculates the thread rating.
Moves post to the trash, updates reply counter on thread, recalculates the thread rating,
and updates any lastPost information in the parent Thread, and CS.
=cut
@ -1298,23 +1392,9 @@ override trash => sub {
super();
$self->getThread->sumReplies if ($self->isReply);
$self->getThread->updateThreadRating;
if ($self->getThread->lastPostId eq $self->getId) {
my $threadLineage = $self->getThread->lineage;
my ($id, $date) = $self->session->db->quickArray("select assetId, creationDate from asset where
lineage like ? and assetId<>? and asset.state='published' and className like 'WebGUI::Asset::Post%'
order by creationDate desc",[$threadLineage.'%', $self->getId]);
$self->getThread->update({lastPostId=>$id, lastPostDate=>$date});
}
if ($self->getThread->getParent->lastPostId eq $self->getId) {
my $forumLineage = $self->getThread->getParent->lineage;
my ($id, $date) = $self->session->db->quickArray("select assetId, creationDate from asset where
lineage like ? and assetId<>? and asset.state='published' and className like 'WebGUI::Asset::Post%'
order by creationDate desc",[$forumLineage.'%', $self->getId]);
$self->getThread->getParent->update({lastPostId=>$id, lastPostDate=>$date});
}
$self->disqualifyAsLastPost;
};
#-------------------------------------------------------------------
=head2 prepareView
@ -1513,6 +1593,7 @@ sub www_edit {
$var{'archive.form'} = WebGUI::Form::yesNo($session, {
name=>"archive"
});
$var{'isSubscribedToCs'} = $self->getThread->getParent->isSubscribed;
$var{'form.header'} .= WebGUI::Form::hidden($session, {
name=>"proceed",
value=>"showConfirmation"

5
lib/WebGUI/Asset/Wobject/GalleryAlbum.pm
View file

@ -211,8 +211,9 @@ sub appendTemplateVarsFileLoop {
my $assetIds = shift;
my $session = $self->session;
for my $assetId (@$assetIds) {
my $asset = WebGUI::Asset->newById($session, $assetId);
ASSET: for my $assetId (@$assetIds) {
my $asset = eval { WebGUI::Asset->newById($session, $assetId); };
next ASSET if Exception::Class->caught();
# Set the parent
$asset->{_parent} = $self;
push @{$var->{file_loop}}, $asset->getTemplateVars;

13
lib/WebGUI/Asset/Wobject/StoryArchive.pm
View file

@ -288,9 +288,14 @@ sub getFolder {
##For a fully automatic commit, save the current tag, create a new one
##with the commit without approval workflow, commit it, then restore
##the original if it exists
my $oldVersionTag = WebGUI::VersionTag->getWorking($session, 'noCreate');
my $newVersionTag = WebGUI::VersionTag->create($session, { workflowId => 'pbworkflow00000000003', });
$newVersionTag->setWorking;
my ($oldVersionTag, $newVersionTag);
$oldVersionTag = WebGUI::VersionTag->getWorking($session, 'noCreate');
if ($self->hasBeenCommitted) {
$newVersionTag = WebGUI::VersionTag->create($session, { workflowId => 'pbworkflow00000000003', });
$newVersionTag->setWorking;
$newVersionTag->set({ name => 'Adding folder '. $folderName. ' to archive '. $self->getUrl});
}
##Call SUPER because my addChild calls getFolder
$folder = $self->addChild({
@ -301,7 +306,7 @@ sub getFolder {
isHidden => 1,
styleTemplateId => $self->styleTemplateId,
});
$newVersionTag->commit();
$newVersionTag->commit() if $newVersionTag;
##Restore the old one, if it exists
$oldVersionTag->setWorking() if $oldVersionTag;

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

@ -996,20 +996,8 @@ sub getFormPlugin {
eval { WebGUI::Pluggable::load($class) };
if ($class->isa('WebGUI::Form::List')) {
delete $param{size};
my $values = WebGUI::Operation::Shared::secureEval($session,$data->{possibleValues});
if (ref $values eq 'HASH') {
$param{options} = $values;
}
else{
my %options;
tie %options, 'Tie::IxHash';
foreach (split(/\n/x, $data->{possibleValues})) {
s/\s+$//x; # remove trailing spaces
$options{$_} = $_;
}
$param{options} = \%options;
}
$param{options} = $values;
}
if ($data->{fieldType} eq "YesNo") {
@ -3238,7 +3226,7 @@ $self->session->form->process($_) eq "") {
sequenceNumber');
while (my $field = $fields->hashRef) {
if ($field->{searchIn}){
my $searchForm = $self->getFormElement($field);
my $searchForm = $self->getFormPlugin($field, 1);
my $searchTextForm = WebGUI::Form::Text($self->session, {
name=>"field_".$field->{fieldId},
size=>25,
@ -3253,9 +3241,10 @@ sequenceNumber');
push(@searchFields_loop, {
"searchFields_fieldId" => $field->{fieldId},
"searchFields_label" => $field->{label},
"searchFields_form" => $searchForm,
"searchFields_form" => $searchForm->toHtml,
"searchFields_textForm" => $searchTextForm,
"searchFields_is".$fieldType => 1,
"searchFields_listType" => $searchForm->isa('WebGUI::Form::List'),
});
my @searchValue = $session->form->process("field_".$field->{fieldId});

1
lib/WebGUI/AssetClipboard.pm
View file

@ -183,6 +183,7 @@ sub getAssetsInClipboard {
{
statesToInclude => ["clipboard"],
returnObjects => 1,
statusToInclude => [qw/approved pending archived/],
whereClause => $limit,
}
);

8
lib/WebGUI/AssetLineage.pm
View file

@ -420,10 +420,6 @@ An array reference containing a list of asset classes to remove from the result
A boolean indicating that we should return objects rather than asset ids.
=head4 returnSQL
A boolean indicating that we should return the sql statement rather than asset ids.
=head4 invertTree
A boolean indicating whether the resulting asset tree should be returned in reverse order.
@ -446,7 +442,8 @@ A string containing as asset class to join in. There is no real reason to use a
=head4 whereClause
A string containing extra where clause information for the query.
A string containing extra WHERE clause information for the query. The AND conjunction will be added internally, so the clause
should not start with AND.
=head4 orderByClause
@ -591,6 +588,7 @@ An integer describing how many levels of ancestry from the start point that shou
=head4 excludeClasses
An array reference containing a list of asset classes to remove from the result set. The opposite of the includOnlyClasses rule.
Each class is internally appended with a SQL wildcard, so any subclass will also be excluded.
=head4 invertTree

41
lib/WebGUI/AssetTrash.pm
View file

@ -57,39 +57,20 @@ sub getAssetsInTrash {
my $self = shift;
my $limitToUser = shift;
my $userId = shift || $self->session->user->userId;
my @assets;
my $limit;
if ($limitToUser) {
$limit = "and asset.stateChangedBy=".$self->session->db->quote($userId);
$limit = "asset.stateChangedBy=".$self->session->db->quote($userId);
}
my $sth = $self->session->db->read("
select
asset.assetId,
assetData.revisionDate
from
asset
left join
assetData on asset.assetId=assetData.assetId
where
asset.state='trash'
and assetData.revisionDate=(SELECT max(revisionDate) from assetData where assetData.assetId=asset.assetId)
$limit
group by
assetData.assetId
order by
assetData.title desc
");
while (my ($id, $date) = $sth->array) {
my $asset = WebGUI::Asset->newById($self->session, $id, $date);
if (!Exception::Class->caught()) {
push(@assets, $asset);
}
else {
$self->session->errorHandler->error("AssetTrash::getAssetsInTrash - failed to instanciate asset with assetId $id and revisionDate $date");
}
}
$sth->finish;
return \@assets;
my $root = WebGUI::Asset->getRoot($self->session);
return $root->getLineage(
["descendants", ],
{
statesToInclude => ["trash"],
statusToInclude => [qw/approved pending archived/],
returnObjects => 1,
whereClause => $limit,
}
);
}
#----------------------------------------------------------------------------

4
lib/WebGUI/Auth.pm
View file

@ -800,7 +800,9 @@ Returns whether or not a method is callable
sub isCallable {
my $self = shift;
return isIn($_[0],@{$self->{callable}})
return 1 if isIn($_[0],@{$self->{callable}});
return 1 if $self->can( 'www_' . $_[0] );
return 0;
}
#-------------------------------------------------------------------

297
lib/WebGUI/Auth/Twitter.pm Normal file
View file

@ -0,0 +1,297 @@
package WebGUI::Auth::Twitter;
=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::Auth';
use Net::Twitter;
=head1 NAME
WebGUI::Auth::Twitter -- Twitter auth for WebGUI
=head1 DESCRIPTION
Allow WebGUI to authenticate to WebGUI
=head1 METHODS
These methods are available from this class:
=cut
#----------------------------------------------------------------------------
=head2 new ( ... )
Create a new object
=cut
sub new {
my $self = shift->SUPER::new(@_);
return bless $self, __PACKAGE__; # Auth requires rebless
}
#----------------------------------------------------------------------------
=head2 createTwitterUser ( twitterUserId, username )
my $user = $self->createTwitterUser( $twitterUserId, $username );
Create a new Auth::Twitter user with the given twitter userId and screen name.
=cut
sub createTwitterUser {
my ( $self, $twitterUserId, $username ) = @_;
my $user = WebGUI::User->create( $self->session );
$user->username( $username );
$self->saveParams( $user->userId, $self->authMethod, {
"twitterUserId" => $twitterUserId,
} );
return $user;
}
#----------------------------------------------------------------------------
=head2 editUserSettingsForm ( )
Return the form to edit the settings of this Auth module
=cut
sub editUserSettingsForm {
my $self = shift;
my $session = $self->session;
my ( $setting ) = $session->quick(qw( setting ));
my $i18n = WebGUI::International->new( $session, 'Auth_Twitter' );
my $keyUrl = 'http://dev.twitter.com/apps/new';
my $f = WebGUI::HTMLForm->new( $session );
$f->yesNo(
name => 'twitterEnabled',
value => $setting->get( 'twitterEnabled' ),
label => $i18n->get('enabled'),
hoverHelp => $i18n->get('enabled help'),
);
$f->text(
name => 'twitterConsumerKey',
value => $setting->get( 'twitterConsumerKey' ),
label => $i18n->get('consumer key'),
hoverHelp => $i18n->get('consumer key help'),
subtext => sprintf( $i18n->get('get key'), ($keyUrl) x 2 ),
);
$f->text(
name => 'twitterConsumerSecret',
value => $setting->get( 'twitterConsumerSecret' ),
label => $i18n->get('consumer secret'),
hoverHelp => $i18n->get('consumer secret help'),
);
$f->template(
name => 'twitterTemplateIdChooseUsername',
value => $setting->get( 'twitterTemplateIdChooseUsername' ),
label => $i18n->get('choose username template'),
hoverHelp => $i18n->get('choose username template help'),
namespace => 'Auth/Twitter/ChooseUsername',
);
return $f->printRowsOnly;
}
#----------------------------------------------------------------------------
=head2 editUserSettingsFormSave ( )
Process the form for this Auth module's settings
=cut
sub editUserSettingsFormSave {
my $self = shift;
my $session = $self->session;
my ( $form, $setting ) = $session->quick(qw( form setting ));
my @fields = qw(
twitterEnabled twitterConsumerKey twitterConsumerSecret
twitterTemplateIdChooseUsername
);
for my $field ( @fields ) {
$setting->set( $field, $form->get( $field ) );
}
return;
}
#----------------------------------------------------------------------------
=head2 getTemplateChooseUsername ( )
Get the template to choose a username
=cut
sub getTemplateChooseUsername {
my ( $self ) = @_;
my $templateId = $self->session->setting->get('twitterTemplateIdChooseUsername');
return WebGUI::Asset->newById( $self->session, $templateId );
}
#----------------------------------------------------------------------------
=head2 getTwitter ( )
Get the Net::Twitter object with the appropriate keys
=cut
sub getTwitter {
my ( $self ) = @_;
my $setting = $self->session->setting;
if ( !$self->{_twitter} ) {
my $nt = Net::Twitter->new(
traits => [qw/API::REST OAuth/],
consumer_key => $setting->get( 'twitterConsumerKey' ), # Test: '3hvJpBr73pa4FycNrqw',
consumer_secret => $setting->get( 'twitterConsumerSecret' ), # Test: 'E4M5DJ66RAXiHgNCnJES96yTqglttsUes6OBcw9A',
);
$self->{_twitter} = $nt;
}
return $self->{_twitter};
}
#----------------------------------------------------------------------------
=head2 www_login ( )
Begin the login procedure
=cut
sub www_login {
my ( $self ) = @_;
my $session = $self->session;
my ( $url, $scratch, $setting ) = $session->quick( qw( url scratch setting ) );
my $nt = $self->getTwitter;
my $auth_url = $nt->get_authentication_url(
callback => $url->getSiteURL . $url->page('op=auth&authType=Twitter&method=callback'),
);
$scratch->set( 'AuthTwitterToken', $nt->request_token );
$scratch->set( 'AuthTwitterTokenSecret', $nt->request_token_secret );
$session->http->setRedirect($auth_url);
return "redirect";
}
#----------------------------------------------------------------------------
=head2 www_callback ( )
Callback from the Twitter authentication. Try to log the user in, creating a
new user account if necessary.
If the username is taken, allow the user to choose a new one.
=cut
sub www_callback {
my ( $self ) = @_;
my $session = $self->session;
my ( $form, $scratch, $db, $setting ) = $session->quick(qw( form scratch db setting ));
my $verifier = $form->get('oauth_verifier');
my $nt = $self->getTwitter;
$nt->request_token( $scratch->get('AuthTwitterToken') );
$nt->request_token_secret( $scratch->get('AuthTwitterTokenSecret') );
my ($access_token, $access_token_secret, $twitterUserId, $twitterScreenName )
= $nt->request_access_token(verifier => $verifier);
### Log the user in
# Find their twitter user ID
my $userId = $db->quickScalar(
"SELECT userId FROM authentication WHERE authMethod = ? AND fieldName = ? AND fieldData = ?",
[ "Twitter", "twitterUserId", $twitterUserId ],
);
# Returning user
if ( $userId ) {
my $user = WebGUI::User->new( $session, $userId );
$self->user( $user );
return $self->login;
}
# Otherwise see if their screen name exists and create a user
elsif ( !WebGUI::User->newByUsername( $session, $twitterScreenName ) ) {
my $user = $self->createTwitterUser( $twitterUserId, $twitterScreenName );
$self->user( $user );
return $self->login;
}
# Otherwise ask them for a new username to use
my $i18n = WebGUI::International->new( $session, 'Auth_Twitter' );
$scratch->set( "AuthTwitterUserId", $twitterUserId );
my $tmpl = $self->getTemplateChooseUsername;
my $var = {
message => sprintf( $i18n->get("twitter screen name taken"), $twitterScreenName ),
};
return $tmpl->process( $var );
}
#----------------------------------------------------------------------------
=head2 www_setUsername ( )
Set the username for a twitter user. Only used as part of the initial twitter
registration.
=cut
sub www_setUsername {
my ( $self ) = @_;
my $session = $self->session;
my ( $form, $scratch, $db ) = $session->quick(qw( form scratch db ));
my $i18n = WebGUI::International->new( $session, 'Auth_Twitter' );
# Don't allow just anybody to set a username
return unless $scratch->get('AuthTwitterUserId');
my $username = $form->get('newUsername');
if ( !WebGUI::User->newByUsername( $session, $username ) ) {
my $twitterUserId = $scratch->get( "AuthTwitterUserId" );
my $user = $self->createTwitterUser( $twitterUserId, $username );
$self->user( $user );
return $self->login;
}
# Username is again taken! Noooooo!
my $tmpl = $self->getTemplateChooseUsername;
my $var = {
message => sprintf( $i18n->get("webgui username taken"), $username ),
};
return $tmpl->process( $var );
}
1;

3
lib/WebGUI/Content/AssetManager.pm
View file

@ -373,9 +373,6 @@ sub www_manage {
$session->style->setScript( $session->url->extras( 'yui-webgui/build/form/form.js' ) );
$session->style->setRawHeadTags( <<ENDHTML );
<link type="text/css" rel="stylesheet" href="http://yui.yahooapis.com/2.6.0/build/logger/assets/skins/sam/logger.css">
<script type="text/javascript" src="http://yui.yahooapis.com/2.6.0/build/logger/logger-min.js"></script>
<script type="text/javascript">
YAHOO.util.Event.onDOMReady( WebGUI.AssetManager.initManager );
</script>

1
lib/WebGUI/Help/Asset_Post.pm
View file

@ -27,6 +27,7 @@ our $HELP = {
{ 'name' => 'reply.synopsis' },
{ 'name' => 'reply.content' },
{ 'name' => 'reply.userDefinedN' },
{ 'name' => 'isSubscribedToCs' },
{ 'name' => 'subscribe.form' },
{ 'name' => 'isNewThread' },
{ 'name' => 'archive.form' },

1
lib/WebGUI/Help/Asset_Thingy.pm
View file

@ -191,6 +191,7 @@ our $HELP = {
{ 'name' => 'searchFields_textForm' },
{ 'name' => 'searchFields_label' },
{ 'name' => 'searchFields_is__fieldType__' },
{ 'name' => 'searchFields_listType' },
],
},
{ 'name' => 'listOfThings',

219
lib/WebGUI/Help/Shop.pm
View file

@ -72,6 +72,10 @@ our $HELP = {
name => "quantity",
description => "quantity help",
},
{
name => "removeBox",
description => "removeBox help",
},
{
name => "dateAdded",
description => "dateAdded help",
@ -102,32 +106,20 @@ our $HELP = {
description => "price help",
},
{
name => "removeButton",
description => "removeButton help",
required => 1,
},
{
name => "shipToButton",
description => "item shipToButton help",
name => "itemAddressChooser",
description => "itemAddressChooser help",
},
{
name => "shippingAddress",
description => "shippingAddress help",
},
{
name => "isCashier",
},
{
name => "posLookupForm",
},
{
name => "posUsername",
},
{
name => "posUserId",
},
],
},
{
name => "message",
description => "message help",
required => 1,
},
{
name => "error",
description => "error help",
@ -152,10 +144,26 @@ our $HELP = {
name => "continueShoppingButton",
description => "continueShoppingButton help",
},
{
name => "minimumCartAmount",
description => "minimumCartAmount help",
},
{
name => "subtotalPrice",
description => "subtotalPrice help",
},
{
name => "shippingAddressChooser",
description => "shippingAddressChooser help",
},
{
name => "billingAddressChooser",
description => "billingAddressChooser help",
},
{
name => "sameShippingAsBilling",
description => "sameShippingAsBilling help",
},
{
name => "shippingPrice",
description => "shippingPrice help",
@ -164,19 +172,27 @@ our $HELP = {
name => "tax",
description => "tax help",
},
{
name => "userIsVisitor",
description => "userIsVisitor help",
},
{
name => "shippableItemsInCart",
},
{
name => "hasShippingAddress",
description => "hasShippingAddress help",
},
{
name => "shippingAddress",
description => "shippingAddress help",
},
{
name => "shippingOptions",
description => "shippingOptions help",
required => 1,
},
{
name => "paymentOptions",
description => "paymentOptions help",
required => 1,
},
{
name => "totalPrice",
description => "totalPrice help",
@ -190,6 +206,158 @@ our $HELP = {
name => "inShopCreditDeduction",
description => "inShopCreditDeduction help",
},
{
name => "isCashier",
},
{
name => "posLookupForm",
},
{
name => "posUsername",
},
{
name => "posUserId",
},
{
name => "loginFormHeader",
description => "loginFormHeader help",
required => 1,
},
{
name => "loginFormFooter",
description => "loginFormFooter help",
required => 1,
},
{
name => "loginFormUsername",
description => "loginFormUsername help",
required => 1,
},
{
name => "loginFormPassword",
description => "loginFormPassword help",
required => 1,
},
{
name => "loginFormButton",
description => "loginFormButton help",
required => 1,
},
{
name => "registerLink",
description => "registerLink help",
required => 1,
},
{
name => "billing_address1Field",
description => "address1Field help",
required => 1,
},
{
name => "billing_address2Field",
description => "address2Field help",
required => 1,
},
{
name => "billing_address3Field",
description => "address3Field help",
required => 1,
},
{
name => "billing_labelField",
description => "address labelField help",
required => 1,
},
{
name => "billing_nameField",
description => "address nameField help",
required => 1,
},
{
name => "billing_cityField",
description => "cityField help",
required => 1,
},
{
name => "billing_stateField",
description => "stateField help",
required => 1,
},
{
name => "billing_countryField",
description => "countryField help",
required => 1,
},
{
name => "billing_codeField",
description => "codeField help",
required => 1,
},
{
name => "billing_phoneNumberField",
description => "phoneNumberField help",
required => 1,
},
{
name => "billing_emailField",
description => "emailField help",
required => 1,
},
{
name => "shipping_address1Field",
description => "address1Field help",
required => 1,
},
{
name => "shipping_address2Field",
description => "address2Field help",
required => 1,
},
{
name => "shipping_address3Field",
description => "address3Field help",
required => 1,
},
{
name => "shipping_labelField",
description => "address labelField help",
required => 1,
},
{
name => "shipping_nameField",
description => "address nameField help",
required => 1,
},
{
name => "shipping_cityField",
description => "cityField help",
required => 1,
},
{
name => "shipping_stateField",
description => "stateField help",
required => 1,
},
{
name => "shipping_countryField",
description => "countryField help",
required => 1,
},
{
name => "shipping_codeField",
description => "codeField help",
required => 1,
},
{
name => "shipping_phoneNumberField",
description => "phoneNumberField help",
required => 1,
},
{
name => "shipping_emailField",
description => "emailField help",
required => 1,
},
],
related => [
{
@ -379,6 +547,11 @@ our $HELP = {
description => "phoneNumberField help",
required => 1,
},
{
name => "emailField",
description => "emailField help",
required => 1,
},
],
related => [
{

58
lib/WebGUI/Macro/TwitterLogin.pm Normal file
View file

@ -0,0 +1,58 @@
package WebGUI::Macro::TwitterLogin;
#-------------------------------------------------------------------
# WebGUI is Copyright 2001-2009 Plain Black Corporation.
#-------------------------------------------------------------------
# Please read the legal notices (docs/legal.txt) and the license
# (docs/license.txt) that came with this distribution before using
# this software.
#-------------------------------------------------------------------
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
use strict;
use List::MoreUtils qw( any );
=head1 NAME
Package WebGUI::Macro::TwitterLogin
=head1 DESCRIPTION
Display a twitter login button
=head2 process( $session )
=over 4
=item *
A session variable
=item *
A URL to an image to log in via Twitter
=back
=cut
#-------------------------------------------------------------------
sub process {
my $session = shift;
return "" unless any { $_ eq 'Twitter' } @{ $session->config->get( 'authMethods' ) };
return "" unless $session->user->isVisitor;
return "" unless $session->setting->get('twitterEnabled'); # Don't allow if twitter login is disabled
my $loginUrl = $session->url->page('op=auth;authType=Twitter;method=login');
my $imgUrl = shift || $session->url->extras( 'twitter_login.png' );
my $output = sprintf '<a href="%s"><img src="%s" border="0" /></a>', $loginUrl, $imgUrl;
return $output;
}
1;
#vim:ft=perl

1
lib/WebGUI/Mail/Send.pm
View file

@ -512,7 +512,6 @@ sub send {
my $status = 1;
if ($mail->parts <= 1) {
warn "making singlepart";
$mail->make_singlepart;
}
if ($mail->head->get("To")) {

22
lib/WebGUI/Operation/Auth.pm
View file

@ -14,6 +14,7 @@ package WebGUI::Operation::Auth;
# logic that defines how Authentication should happen
use strict qw(vars subs);
use List::MoreUtils qw( any );
use URI;
use WebGUI::Operation::Shared;
use WebGUI::Pluggable;
@ -33,9 +34,16 @@ Get the instance of this object or create a new instance if none exists
sub getInstance {
my $session = shift;
#Get Auth Settings
my $authMethod = $session->user->authMethod || $session->setting->get("authMethod");
$authMethod = $session->setting->get("authMethod") if($session->user->isVisitor);
$authMethod = $_[0] if($_[0] && isIn($_[0], @{$session->config->get("authMethods")}));
my $authMethod = $_[0]
|| ( !$session->user->isVisitor && $session->user->authMethod ) # Visitor has no authType
|| $session->form->get('authType')
|| $session->setting->get("authMethod")
;
# Verify is in auth method list
if ( !any { $_ eq $authMethod } @{$session->config->get('authMethods')} ) {
$authMethod = $session->setting->get('authMethod');
}
my $userId = $_[1];
#Create Auth Object
my $auth = eval { WebGUI::Pluggable::instanciate("WebGUI::Auth::".$authMethod, "new", [ $session, $authMethod, $userId ] ) };
@ -68,11 +76,15 @@ sub www_auth {
my $authMethod = getInstance($session,$auth);
my $methodCall = shift || $session->form->process("method") || "init";
if(!$authMethod->isCallable($methodCall)){
$session->errorHandler->security("access uncallable auth method");
$session->errorHandler->security("access uncallable auth method: $methodCall");
my $i18n = WebGUI::International->new($session);
return $i18n->get(1077);
}
my $out = $authMethod->$methodCall;
# Determine if we have a www_ method
my $method = $authMethod->can( 'www_' . $methodCall )
|| $authMethod->can( $methodCall );
my $out = $method->( $authMethod );
if (substr($session->http->getMimeType(),0,9) eq "text/html") {
return $session->style->userStyle($out);
}

7
lib/WebGUI/Paginator.pm
View file

@ -17,6 +17,7 @@ package WebGUI::Paginator;
use strict;
use WebGUI::International;
use WebGUI::Utility;
use List::Util qw/min/;
=head1 NAME
@ -428,10 +429,10 @@ sub getPageData {
}
#Handle setByArrayRef or the old setDataByQuery method
my @pageRows = ();
my $rowsPerPage = $self->{_rpp};
my $rowsPerPage = $self->{_rpp};
my $pageStartRow = ($pageNumber*$rowsPerPage)-$rowsPerPage;
my $pageEndRow = $pageNumber*$rowsPerPage;
my $pageEndRow = min($pageNumber*$rowsPerPage, $#{$allRows}+1);
my @pageRows = ();
for (my $i=$pageStartRow; $i<$pageEndRow; $i++) {
$pageRows[$i-$pageStartRow] = $allRows->[$i] if ($i <= $#{$self->{_rowRef}});
}

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

@ -762,6 +762,15 @@ sub updateFromForm {
$error{id $self} = $i18n->get('mixed items warning');
}
my @cartItemIds = $form->process('remove_item', 'checkList');
foreach my $cartItemId (@cartItemIds) {
my $item = eval { $self->getItem($cartItemId); };
$item->remove if ! Exception::Class->caught();
}
##Visitor cannot have an address book, or set a payment gateway, so skip the rest of this.
return 1 if $session->user->isVisitor;
my $book = $self->getAddressBook;
my $cartProperties = {};
@ -825,12 +834,6 @@ sub updateFromForm {
$cartProperties->{ shipperId } = $form->process( 'shipperId' ) if $form->process( 'shipperId' );
$cartProperties->{ gatewayId } = $form->process( 'gatewayId' ) if $form->process( 'gatewayId' );
$self->update( $cartProperties );
my @cartItemIds = $form->process('remove_item', 'checkList');
foreach my $cartItemId (@cartItemIds) {
my $item = eval { $self->getItem($cartItemId); };
$item->remove if ! Exception::Class->caught();
}
}
#-------------------------------------------------------------------

4
lib/WebGUI/Workflow/Activity/RequestApprovalForVersionTag.pm
View file

@ -306,6 +306,7 @@ sub setApproved {
my $self = shift;
my $instance = shift;
$instance->setScratch( "status", "approved" );
$instance->set({}); ##Bump spectre to get it to run right now.
}
#----------------------------------------------------------------------------
@ -325,7 +326,8 @@ sub setDenied {
my $self = shift;
my $instance = shift;
$instance->setScratch( "status", "denied" );
}
$instance->set({}); ##Bump spectre to get it to run right now.
}
#----------------------------------------------------------------------------

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

@ -48,6 +48,12 @@ editing an existing Post.|,
lastUpdated => 1149829706,
},
'isSubscribedToCs' => {
message => q|A boolean which will be true if the current user is subscribed to the CS containing this Post.|,
context => q|Template variable description|,
lastUpdated => 1149829706,
},
'subscribe.form' => {
message => q|A yes/no button to allow the user to subscribe to the thread this post belongs to.|,
lastUpdated => 1149829706,

18
lib/WebGUI/i18n/English/Asset_Thingy.pm
View file

@ -584,14 +584,12 @@ you wish to appear, one per line. <br />
<br />If you want a different label for a value, the possible values list has to be
formatted as follows:
<pre>
&#123;
"key1"=>"value1",
"key2"=>"value2",
"key3"=>"value3"
key1|value1
key2|value2
key3|value3
...
&#125;
</pre>
Braces, quotes and all. You simply replace "key1"/"value1" with your own name/value pairs},
Simply replace "key1"/"value1" with your own name/value pairs},
lastUpdated => 1223372150,
},
@ -972,11 +970,17 @@ search has been done.|,
},
'searchFields_is__fieldType__' => {
message => q|A boolean indicating wether this field is of type __fieldType__. The first letter of __fieldType__ is always uppercase. Example: for a select box the value of &lt;tmpl_var searchFields_isSelectBox&gt; is true.|,
message => q|A boolean indicating whether this field is of type __fieldType__. The first letter of __fieldType__ is always uppercase. Example: for a select box the value of &lt;tmpl_var searchFields_isSelectBox&gt; is true.|,
lastUpdated => 1104630516,
context => q|Description of a tmpl_var for the template help.|,
},
'searchFields_listType' => {
message => q|A boolean indicating whether this field is a List type field.|,
lastUpdated => 1277849256,
context => q|Description of a tmpl_var for the template help.|,
},
'displayInSearchFields_loop' => {
message => q|A loop containing the fields that are displayed in the search results.|,
lastUpdated => 1104630516,

80
lib/WebGUI/i18n/English/Auth_Twitter.pm Normal file
View file

@ -0,0 +1,80 @@
package WebGUI::i18n::English::Auth_Twitter;
use strict;
our $I18N = {
'enabled' => {
message => q{Enabled},
lastUpdated => 0,
context => q{Label for auth setting field},
},
'enabled help' => {
message => q{Enabled Twitter-based login},
lastUpdated => 0,
context => q{Hover help for auth setting field},
},
'get key' => {
message => q{Get a Twitter API key from <a href="%s">%s</a>},
lastUpdated => 0,
context => q{Link to get a twitter API key},
},
'consumer key' => {
message => q{Twitter Consumer Key},
lastUpdated => 0,
context => q{Label for auth setting field},
},
'consumer key help' => {
message => q{The Consumer Key from your application settings},
lastUpdated => 0,
context => q{Hover help for auth setting field},
},
'consumer secret' => {
message => q{Twitter Consumer Secret},
lastUpdated => 0,
context => q{Label for auth setting field},
},
'consumer secret help' => {
message => q{The Consumer Secret from your application settings},
lastUpdated => 0,
context => q{Hover help for auth setting field},
},
'choose username title' => {
message => q{Choose a Username},
lastUpdated => 0,
context => q{Title for screen to choose a username},
},
'twitter screen name taken' => {
message => q{Your twitter screen name "%s" is taken. Please choose a new username.},
lastUpdated => 0,
context => q{An error message for the choose a username screen},
},
'webgui username taken' => {
message => q{That username "%s" is taken. Please choose another.},
lastUpdated => 0,
context => q{An error message for the choose a username screen},
},
'choose username template' => {
message => q{Choose Username Template},
lastUpdated => 0,
context => q{Label for auth setting field},
},
'choose username template help' => {
message => q{The template to choose a username if the user's screen name already exists},
lastUpdated => 0,
context => q{Hover help for auth setting field},
},
};
1;
#vim:ft=perl

110
lib/WebGUI/i18n/English/Shop.pm
View file

@ -165,18 +165,6 @@ our $I18N = {
context => q|a help description|,
},
'removeButton help' => {
message => q|Clicking this button will remove the item from the cart.|,
lastUpdated => 0,
context => q|a help description|,
},
'item shipToButton help' => {
message => q|Clicking this button will set an alternate address as the destination of this item.|,
lastUpdated => 0,
context => q|a help description|,
},
'shippingAddress help' => {
message => q|The HTML formatted address to ship to.|,
lastUpdated => 0,
@ -189,6 +177,12 @@ our $I18N = {
context => q|a help description|,
},
'message help' => {
message => q|If the cart is empty, this internationalized message should be displayed to the user.|,
lastUpdated => 0,
context => q|a help description|,
},
'formHeader help' => {
message => q|The top of the form.|,
lastUpdated => 0,
@ -243,6 +237,12 @@ our $I18N = {
context => q|a help description|,
},
'paymentOptions help' => {
message => q|A select list containing all the configured payment options for this order.|,
lastUpdated => 0,
context => q|a help description|,
},
'inShopCreditAvailable help' => {
message => q|The amount of in-shop credit the user has.|,
lastUpdated => 0,
@ -447,6 +447,12 @@ our $I18N = {
context => q|a help description|,
},
'emailField help' => {
message => q|A field to contain the email address for this address.|,
lastUpdated => 0,
context => q|a help description|,
},
'phoneNumber help' => {
message => q|A phone number for this address.|,
lastUpdated => 0,
@ -1782,7 +1788,7 @@ our $I18N = {
'shippableItemsInCart' => {
message => q|A boolean which will be true if any item in the cart requires shipping.|,
lastUpdated => 0,
context => q|form label for the cart. Allows user to choose a payment method. Bart Jol for Minister in 2012!|
context => q|Template variable help.|
},
'no billing address' => {
@ -1905,6 +1911,84 @@ our $I18N = {
context => q|Cart error message|
},
'minimumCartAmount help' => {
message => q|The minimum cart amount, from the settings, formatted to two decimal places.|,
lastUpdated => 0,
context => q|Template variable help|
},
'userIsVisitor help' => {
message => q|A boolean which will be true if the currrent user is Visitor|,
lastUpdated => 0,
context => q|Template variable help|
},
'removeBox help' => {
message => q|A checkbox that will allow this item to be removed from the cart.|,
lastUpdated => 0,
context => q|Template variable help|
},
'itemAddressChooser help' => {
message => q|A dropdown for choosing an address to ship an individual item in the cart to, enabling per-item shipping.|,
lastUpdated => 0,
context => q|Template variable help|
},
'shippingAddressChooser help' => {
message => q|A dropdown for choosing a default shipping address for all items in the cart. Also contains actions for editing and adding new addresses.|,
lastUpdated => 0,
context => q|Template variable help|
},
'billingAddressChooser help' => {
message => q|A dropdown for choosing a default billing address.|,
lastUpdated => 0,
context => q|Template variable help|
},
'sameShippingAsBilling help' => {
message => q|A checkbox to tell the cart that the user wants to use the same shipping address, as their billing address.|,
lastUpdated => 0,
context => q|Template variable help|
},
'loginFormHeader help' => {
message => q|The start of the form to help a user log in. This variable will only be populated if the current user is Visitor.|,
lastUpdated => 0,
context => q|Template variable help|
},
'loginFormFooter help' => {
message => q|The end of the form to help a user log in. This variable will only be populated if the current user is Visitor.|,
lastUpdated => 0,
context => q|Template variable help|
},
'loginFormUsername help' => {
message => q|A text box for the user to enter in their name. This variable will only be populated if the current user is Visitor.|,
lastUpdated => 0,
context => q|Template variable help|
},
'loginFormPassword help' => {
message => q|A text box for the user to enter in their password, obscured. This variable will only be populated if the current user is Visitor.|,
lastUpdated => 0,
context => q|Template variable help|
},
'loginFormButton help' => {
message => q|The end of the form to help a user log in. This variable will only be populated if the current user is Visitor.|,
lastUpdated => 0,
context => q|Template variable help|
},
'registerLink help' => {
message => q|A link for a user to register an account on this site, if they do not already have one. This variable will only be populated if the current user is Visitor.|,
lastUpdated => 0,
context => q|Template variable help|
},
};
1;

1
sbin/testEnvironment.pl
View file

@ -154,6 +154,7 @@ checkModule( "Cache::FastMmap", );
checkModule('IO::Socket::SSL', );
checkModule('Package::Stash', );
checkModule('HTTP::Exception', );
checkModule('Net::Twitter', "3.13006" );
failAndExit("Required modules are missing, running no more checks.") if $missingModule;

12
t/Asset/AssetMetaData.t
View file

@ -56,6 +56,12 @@ my $snippet = $folder->addChild({
$versionTag->commit;
WebGUI::Test->addToCleanup(sub {
foreach my $metaDataFieldId (keys %{ $snippet->getMetaDataFields }) {
$snippet->deleteMetaDataField($metaDataFieldId);
}
});
##Note that there is no MetaData field master class. New fields can be added
##from _ANY_ asset, and be available to all assets.
@ -226,8 +232,4 @@ sub buildNameIndex {
return $nameStruct;
}
END {
foreach my $metaDataFieldId (keys %{ $snippet->getMetaDataFields }) {
$snippet->deleteMetaDataField($metaDataFieldId);
}
}
#vim:ft=perl

119
t/Asset/Post/archiving.t Normal file
View file

@ -0,0 +1,119 @@
#-------------------------------------------------------------------
# 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
#-------------------------------------------------------------------
## Test that archiving a post works, and checking side effects like updating
## lastPost information in the Thread, and CS.
use FindBin;
use strict;
use lib "$FindBin::Bin/../../lib";
use WebGUI::Test;
use WebGUI::Session;
use Test::More tests => 13; # increment this value for each test you create
use WebGUI::Asset::Wobject::Collaboration;
use WebGUI::Asset::Post;
use WebGUI::Asset::Post::Thread;
my $session = WebGUI::Test->session;
# Do our work in the import node
my $node = WebGUI::Asset->getImportNode($session);
# Grab a named version tag
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"Collab setup"});
# Need to create a Collaboration system in which the post lives.
my @addArgs = ( undef, undef, { skipAutoCommitWorkflows => 1, skipNotification => 1 } );
my $collab = $node->addChild({className => 'WebGUI::Asset::Wobject::Collaboration'}, @addArgs);
# finally, add posts and threads to the collaboration system
my $first_thread = $collab->addChild(
{ className => 'WebGUI::Asset::Post::Thread', },
undef,
WebGUI::Test->webguiBirthday,
{ skipAutoCommitWorkflows => 1, skipNotification => 1 }
);
my $second_thread = $collab->addChild(
{ className => 'WebGUI::Asset::Post::Thread', },
undef,
WebGUI::Test->webguiBirthday,
{ skipAutoCommitWorkflows => 1, skipNotification => 1 }
);
##Thread 1, Post 1 => t1p1
my $t1p1 = $first_thread->addChild(
{ className => 'WebGUI::Asset::Post', },
undef,
WebGUI::Test->webguiBirthday,
{ skipAutoCommitWorkflows => 1, skipNotification => 1 }
);
my $t1p2 = $first_thread->addChild(
{ className => 'WebGUI::Asset::Post', },
undef,
WebGUI::Test->webguiBirthday + 1,
{ skipAutoCommitWorkflows => 1, skipNotification => 1 }
);
my $past = time()-15;
my $t2p1 = $second_thread->addChild(
{ className => 'WebGUI::Asset::Post', },
undef,
$past,
{ skipAutoCommitWorkflows => 1, skipNotification => 1 }
);
my $t2p2 = $second_thread->addChild(
{ className => 'WebGUI::Asset::Post', },
undef,
undef,
{ skipAutoCommitWorkflows => 1, skipNotification => 1 }
);
$versionTag->commit();
WebGUI::Test->addToCleanup($versionTag);
foreach my $asset ($collab, $t1p1, $t1p2, $t2p1, $t2p2, $first_thread, $second_thread, ) {
$asset = $asset->cloneFromDb;
}
is $collab->getChildCount, 2, 'collab has correct number of children';
is $collab->get('lastPostId'), $t2p2->getId, 'lastPostId set in collab';
is $collab->get('lastPostDate'), $t2p2->get('creationDate'), 'lastPostDate, too';
$t2p2->setStatusArchived;
is $t2p2->get('status'), 'archived', 'setStatusArchived set the post to be archived';
$second_thread = $second_thread->cloneFromDb;
is $second_thread->get('lastPostId'), $t2p1->getId, '.. updated lastPostId in the thread';
is $second_thread->get('lastPostDate'), $t2p1->get('creationDate'), '... lastPostDate, too';
$collab = $collab->cloneFromDb;
is $collab->get('lastPostId'), $t2p1->getId, '.. updated lastPostId in the CS';
is $collab->get('lastPostDate'), $t2p1->get('creationDate'), '... lastPostDate, too';
$t2p2->setStatusUnarchived;
is $t2p2->get('status'), 'approved', 'setStatusUnarchived sets the post back to approved';
$second_thread = $second_thread->cloneFromDb;
is $second_thread->get('lastPostId'), $t2p2->getId, '.. updated lastPostId in the thread';
is $second_thread->get('lastPostDate'), $t2p2->get('creationDate'), '... lastPostDate, too';
$collab = $collab->cloneFromDb;
is $collab->get('lastPostId'), $t2p2->getId, '.. updated lastPostId in the CS';
is $collab->get('lastPostDate'), $t2p2->get('creationDate'), '... lastPostDate, too';
#vim:ft=perl

119
t/Asset/Post/trashing.t Normal file
View file

@ -0,0 +1,119 @@
#-------------------------------------------------------------------
# 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
#-------------------------------------------------------------------
## Test that trashing a post works, and checking side effects like updating
## lastPost information in the Thread, and CS.
use FindBin;
use strict;
use lib "$FindBin::Bin/../../lib";
use WebGUI::Test;
use WebGUI::Session;
use Test::More tests => 13; # increment this value for each test you create
use WebGUI::Asset::Wobject::Collaboration;
use WebGUI::Asset::Post;
use WebGUI::Asset::Post::Thread;
my $session = WebGUI::Test->session;
# Do our work in the import node
my $node = WebGUI::Asset->getImportNode($session);
# Grab a named version tag
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"Collab setup"});
# Need to create a Collaboration system in which the post lives.
my @addArgs = ( undef, undef, { skipAutoCommitWorkflows => 1, skipNotification => 1 } );
my $collab = $node->addChild({className => 'WebGUI::Asset::Wobject::Collaboration'}, @addArgs);
# finally, add posts and threads to the collaboration system
my $first_thread = $collab->addChild(
{ className => 'WebGUI::Asset::Post::Thread', },
undef,
WebGUI::Test->webguiBirthday,
{ skipAutoCommitWorkflows => 1, skipNotification => 1 }
);
my $second_thread = $collab->addChild(
{ className => 'WebGUI::Asset::Post::Thread', },
undef,
WebGUI::Test->webguiBirthday,
{ skipAutoCommitWorkflows => 1, skipNotification => 1 }
);
##Thread 1, Post 1 => t1p1
my $t1p1 = $first_thread->addChild(
{ className => 'WebGUI::Asset::Post', },
undef,
WebGUI::Test->webguiBirthday,
{ skipAutoCommitWorkflows => 1, skipNotification => 1 }
);
my $t1p2 = $first_thread->addChild(
{ className => 'WebGUI::Asset::Post', },
undef,
WebGUI::Test->webguiBirthday + 1,
{ skipAutoCommitWorkflows => 1, skipNotification => 1 }
);
my $past = time()-15;
my $t2p1 = $second_thread->addChild(
{ className => 'WebGUI::Asset::Post', },
undef,
$past,
{ skipAutoCommitWorkflows => 1, skipNotification => 1 }
);
my $t2p2 = $second_thread->addChild(
{ className => 'WebGUI::Asset::Post', },
undef,
undef,
{ skipAutoCommitWorkflows => 1, skipNotification => 1 }
);
$versionTag->commit();
WebGUI::Test->addToCleanup($versionTag);
foreach my $asset ($collab, $t1p1, $t1p2, $t2p1, $t2p2, $first_thread, $second_thread, ) {
$asset = $asset->cloneFromDb;
}
is $collab->getChildCount, 2, 'collab has correct number of children';
is $collab->get('lastPostId'), $t2p2->getId, 'lastPostId set in collab';
is $collab->get('lastPostDate'), $t2p2->get('creationDate'), 'lastPostDate, too';
$t2p2->trash;
is $t2p2->get('state'), 'trash', 'cut set the post to be in the clipboard';
$second_thread = $second_thread->cloneFromDb;
is $second_thread->get('lastPostId'), $t2p1->getId, '.. updated lastPostId in the thread';
is $second_thread->get('lastPostDate'), $t2p1->get('creationDate'), '... lastPostDate, too';
$collab = $collab->cloneFromDb;
is $collab->get('lastPostId'), $t2p1->getId, '.. updated lastPostId in the CS';
is $collab->get('lastPostDate'), $t2p1->get('creationDate'), '... lastPostDate, too';
$t2p2->restore;
is $t2p2->get('state'), 'published', 'publish sets the post normal';
$second_thread = $second_thread->cloneFromDb;
is $second_thread->get('lastPostId'), $t2p2->getId, '.. updated lastPostId in the thread';
is $second_thread->get('lastPostDate'), $t2p2->get('creationDate'), '... lastPostDate, too';
$collab = $collab->cloneFromDb;
is $collab->get('lastPostId'), $t2p2->getId, '.. updated lastPostId in the CS';
is $collab->get('lastPostDate'), $t2p2->get('creationDate'), '... lastPostDate, too';
#vim:ft=perl

3
t/Asset/Wobject/Gallery/00base.t
View file

@ -25,6 +25,7 @@ my $session = WebGUI::Test->session;
my $node = WebGUI::Asset->getImportNode($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"Gallery Test"});
WebGUI::Test->addToCleanup($versionTag);
#----------------------------------------------------------------------------
# Tests
@ -65,3 +66,5 @@ $gallery->purge;
eval { WebGUI::Asset->newById($session, $properties->{assetId}); };
ok( Exception::Class->caught(), 'Gallery no longer able to be instanciated after purge');
#vim:ft=perl

3
t/Asset/Wobject/GalleryAlbum/00base.t
View file

@ -25,6 +25,7 @@ my $session = WebGUI::Test->session;
my $node = WebGUI::Asset->getImportNode($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"Album Test"});
WebGUI::Test->addToCleanup($versionTag);
my $gallery
= $node->addChild({
className => "WebGUI::Asset::Wobject::Gallery",
@ -69,3 +70,5 @@ $album->purge;
eval { WebGUI::Asset->newById($session, $properties->{assetId}); };
ok( Exception::Class->caught(), 'Album no longer able to be instanciated');
#vim:ft=perl

3
t/Asset/Wobject/GalleryAlbum/ajax.t
View file

@ -25,6 +25,7 @@ use WebGUI::Asset::Wobject::GalleryAlbum;
my $session = WebGUI::Test->session;
my $node = WebGUI::Asset->getImportNode($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
WebGUI::Test->addToCleanup($versionTag);
my %user;
$user{'1'} = WebGUI::User->new( $session, "new" );
@ -254,3 +255,5 @@ sub callAjaxService {
# Call ajax service function and decode reply
return decode_json( $album->www_ajax() );
}
#vim:ft=perl

2
t/Asset/Wobject/GalleryAlbum/delete.t
View file

@ -28,6 +28,7 @@ $session->user({ userId => 3 });
my $node = WebGUI::Asset->getImportNode($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"Album Test"});
WebGUI::Test->addToCleanup($versionTag);
my $gallery
= $node->addChild({
className => "WebGUI::Asset::Wobject::Gallery",
@ -102,3 +103,4 @@ $maker->run;
eval { WebGUI::Asset->newById( $session, $assetId ); };
ok (Exception::Class->caught(), "GalleryAlbum cannot be instanciated after www_deleteConfirm");
#vim:ft=perl

7
t/Asset/Wobject/GalleryAlbum/navigation.t
View file

@ -23,6 +23,7 @@ use Test::More;
my $session = WebGUI::Test->session;
my $node = WebGUI::Asset->getImportNode($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
WebGUI::Test->addToCleanup($versionTag);
$versionTag->set({name=>"Album Test"});
@ -99,8 +100,4 @@ is( $album->getNextFileId(''), undef, 'Return undef if empty string specified');
is( $album->getNextFileId('123456'), undef, 'Return undef if non-existing id specified');
is( $album->getNextFileId($album->getId), undef, 'Return undef if non-child id specified');
#----------------------------------------------------------------------------
# Cleanup
END {
$versionTag->rollback();
}
#vim:ft=perl

7
t/Asset/Wobject/GalleryAlbum/slideshow.t
View file

@ -61,6 +61,7 @@ for my $i ( 0 .. 5 ) {
}
$versionTag->commit;
WebGUI::Test->addToCleanup($versionTag);
#----------------------------------------------------------------------------
# Tests
@ -78,8 +79,4 @@ TODO: {
# Test www_slideshow
#----------------------------------------------------------------------------
# Cleanup
END {
$versionTag->rollback();
}
#vim:ft=perl

7
t/Asset/Wobject/GalleryAlbum/thumbnails.t
View file

@ -26,6 +26,7 @@ my $maker = WebGUI::Test::Maker::HTML->new;
my $session = WebGUI::Test->session;
my $node = WebGUI::Asset->getImportNode($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
WebGUI::Test->addToCleanup($versionTag);
$versionTag->set({name=>"Album Test"});
my $gallery
= $node->addChild({
@ -77,8 +78,4 @@ TODO: {
#----------------------------------------------------------------------------
# Test www_thumbnails
#----------------------------------------------------------------------------
# Cleanup
END {
$versionTag->rollback();
}
#vim:ft=perl

8
t/Asset/Wobject/GalleryAlbum/view.t
View file

@ -27,6 +27,7 @@ my $maker = WebGUI::Test::Maker::HTML->new;
my $session = WebGUI::Test->session;
my $node = WebGUI::Asset->getImportNode($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
WebGUI::Test->addToCleanup($versionTag);
$versionTag->set({name=>"Album Test"});
my $gallery
= $node->addChild({
@ -150,8 +151,5 @@ SKIP: {
});
$maker->run;
}
#----------------------------------------------------------------------------
# Cleanup
END {
$versionTag->rollback();
}
#vim:ft=perl

12
t/Asset/Wobject/StoryArchive.t
View file

@ -85,6 +85,7 @@ $archive = $home->addChild({
$versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->commit;
WebGUI::Test->addToCleanup($versionTag);
$archive = $archive->cloneFromDb;
$archive = $archive->cloneFromDb;
@ -144,6 +145,17 @@ undef $sameFolder;
$todayFolder->purge;
is($archive->getChildCount, 0, 'leaving with an empty archive');
{
my $archive2 = $home->addChild({
className => 'WebGUI::Asset::Wobject::StoryArchive',
title => 'Uncommitted',
url => 'uncommitted_archive',
});
my $guard = WebGUI::Test->cleanupGuard($archive2);
my $new_folder = $archive2->getFolder;
is $archive2->get('tagId'), $new_folder->get('tagId'), 'folder added to uncommitted archive uses the same version tag';
}
################################################################
#
# addChild

2
t/Asset/Wobject/Survey/ExpressionEngine.t
View file

@ -261,3 +261,5 @@ cmp_deeply( $e->run( $session, qq{jump {taggedX('$url', ext_tag) == 199} target}
cmp_deeply( $e->run( $session, qq{jump {taggedX('$url', ext_tag) == 199} target}, {userId => $user->userId} ),
{ jump => 'target', tags => {} }, 'first external tag lookups still works' );
}
#vim:ft=perl

20
t/Asset/Wobject/Survey/Reports.t
View file

@ -25,19 +25,19 @@ plan tests => 3;
# put your tests here
use_ok('WebGUI::Asset::Wobject::Survey');
my ($survey);
# Returns the contents of the Survey_tempReport table
sub getAll { $session->db->buildArrayRefOfHashRefs('select * from Survey_tempReport where assetId = ?', [$survey->getId]) }
my $user = WebGUI::User->new( $session, 'new' );
WebGUI::Test->addToCleanup($user);
my $import_node = WebGUI::Asset->getImportNode($session);
# Create a Survey
$survey = $import_node->addChild( { className => 'WebGUI::Asset::Wobject::Survey', } );
my $survey = $import_node->addChild( { className => 'WebGUI::Asset::Wobject::Survey', } );
WebGUI::Test->addToCleanup($survey);
isa_ok($survey, 'WebGUI::Asset::Wobject::Survey');
# Returns the contents of the Survey_tempReport table
sub getAll { $session->db->buildArrayRefOfHashRefs('select * from Survey_tempReport where assetId = ?', [$survey->getId]) }
my $sJSON = $survey->getSurveyJSON;
# Load bare-bones survey, containing a single section (S0)
@ -124,12 +124,4 @@ superhashof({
value => 20, # e.g. score
})]);
#----------------------------------------------------------------------------
# Cleanup
END {
$survey->purge() if $survey;
my $versionTag = WebGUI::VersionTag->getWorking( $session, 1 );
$versionTag->rollback() if $versionTag;
}
#vim:ft=perl

5
t/Asset/Wobject/Survey/Test.t
View file

@ -726,7 +726,4 @@ Hashes differ on element: a
expect : '2'
END_CMP
#----------------------------------------------------------------------------
# Cleanup
END {
}
#vim:ft=perl

103
t/Auth/Twitter.t Normal file
View file

@ -0,0 +1,103 @@
# vim:syntax=perl
#-------------------------------------------------------------------
# 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
#------------------------------------------------------------------
# Test the Auth::Twitter module
#
#
use FindBin;
use strict;
use lib "$FindBin::Bin/../lib";
use Test::More;
use WebGUI::Test; # Must use this before any other WebGUI modules
use WebGUI::Session;
#----------------------------------------------------------------------------
# Init
my $session = WebGUI::Test->session;
#----------------------------------------------------------------------------
# Tests
plan tests => 15; # Increment this number for each test you create
#----------------------------------------------------------------------------
# Object creation
use_ok( 'WebGUI::Auth::Twitter' );
my $auth = WebGUI::Auth::Twitter->new( $session, "Twitter" );
isa_ok( $auth, 'WebGUI::Auth::Twitter' );
#----------------------------------------------------------------------------
# API methods
my $user = $auth->createTwitterUser( "1234", "AndyDufresne" );
WebGUI::Test->addToCleanup( $user );
isa_ok( $user, 'WebGUI::User' );
is(
$session->db->quickScalar(
"SELECT fieldData FROM authentication WHERE userId=? AND authMethod=? AND fieldName=?",
[ $user->userId, "Twitter", "twitterUserId" ],
),
"1234",
"Twitter User ID saved in authentication table",
);
my $tmpl = $auth->getTemplateChooseUsername;
isa_ok( $tmpl, 'WebGUI::Asset::Template' );
is( $tmpl->getId, $session->setting->get('twitterTemplateIdChooseUsername'), "Template taken from settings" );
$session->setting->set( 'twitterConsumerKey' => '3hvJpBr73pa4FycNrqw' );
$session->setting->set( 'twitterConsumerSecret' => 'E4M5DJ66RAXiHgNCnJES96yTqglttsUes6OBcw9A' );
my $nt = $auth->getTwitter;
isa_ok( $nt, 'Net::Twitter' );
#----------------------------------------------------------------------------
# www_ methods
# www_login
is( $auth->www_login, "redirect", "www_login always returns redirect" );
ok( $session->scratch->get('AuthTwitterToken'), 'auth token gets set to scratch' );
ok( $session->scratch->get('AuthTwitterTokenSecret'), 'auth token secret gets set to scratch' );
like( $session->http->getRedirectLocation, qr/twitter[.]com/, "redirect to twitter.com" );
# www_callback
# I have no idea how to test this...
# www_setUsername
ok( !$auth->www_setUsername, "setUsername doesn't work unless a scratch is set" );
$session->scratch->set( 'AuthTwitterUserId' => '2345' );
$session->request->setup_body( {
newUsername => "RedHerring",
} );
$auth->www_setUsername;
# User gets created with given twitter user id
my $userId = $session->db->quickScalar(
"SELECT userId FROM authentication WHERE authMethod=? AND fieldName=? AND fieldData=?",
[ "Twitter", "twitterUserId", "2345" ],
);
ok( $userId, 'user exists in authentication table' );
$user = WebGUI::User->new( $session, $userId );
is( $user->username, "RedHerring", "correct username is set" );
WebGUI::Test->addToCleanup( $user );
like(
$auth->www_setUsername, qr/username "RedHerring" is taken/,
"setUsername with existing username returns error",
);
#vim:ft=perl

7
t/Group.t
View file

@ -96,6 +96,7 @@ plan tests => (168 + (scalar(@scratchTests) * 2) + scalar(@ipTests)); # incremen
my $session = WebGUI::Test->session;
$session->cache->remove('myTestKey');
WebGUI::Test->addToCleanup(sub { $session->cache->remove('myTestKey'); });
foreach my $gid ('new', '') {
my $g = WebGUI::Group->new($session, $gid);
@ -466,6 +467,7 @@ cmp_ok($expirationDate-time(), '>', 50, 'checking expire offset override on addU
################################################################
$session->db->dbh->do('DROP TABLE IF EXISTS myUserTable');
WebGUI::Test->addToCleanup(SQL => 'DROP TABLE IF EXISTS myUserTable');
$session->db->dbh->do(q!CREATE TABLE myUserTable (userId CHAR(22) binary NOT NULL default '', PRIMARY KEY(userId)) TYPE=InnoDB!);
my $sth = $session->db->prepare('INSERT INTO myUserTable VALUES(?)');
@ -826,7 +828,4 @@ ok( WebGUI::Group->vitalGroup(3), '... 3');
ok( WebGUI::Group->vitalGroup('pbgroup000000000000015'), '... pbgroup000000000000015');
ok(! WebGUI::Group->vitalGroup('27'), '... 27 is not vital');
END {
$session->db->dbh->do('DROP TABLE IF EXISTS myUserTable');
$session->cache->remove('myTestKey');
}
#vim:ft=perl

68
t/Macro/TwitterLogin.t Normal file
View file

@ -0,0 +1,68 @@
# vim:syntax=perl
#-------------------------------------------------------------------
# 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
#------------------------------------------------------------------
# Test the TwitterLogin macro
#
#
use FindBin;
use strict;
use lib "$FindBin::Bin/../lib";
use Test::More;
use WebGUI::Test; # Must use this before any other WebGUI modules
use WebGUI::Session;
#----------------------------------------------------------------------------
# Init
my $session = WebGUI::Test->session;
#----------------------------------------------------------------------------
# Tests
plan tests => 10; # Increment this number for each test you create
#----------------------------------------------------------------------------
# TwitterLogin macro
use_ok( 'WebGUI::Macro::TwitterLogin' );
# Twitter auth must be enabled
my $authMethods = $session->config->get('authMethods');
$session->config->set('authMethods', ["WebGUI","LDAP"]);
is( WebGUI::Macro::TwitterLogin::process($session), "", "Twitter must be enabled in config" );
$session->config->set('authMethods', [ @{$authMethods}, "Twitter" ]);
$session->user({userId => 3});
is( WebGUI::Macro::TwitterLogin::process($session), "", "User must be Visitor" );
$session->user({userId => 1});
my $twitterEnabled = $session->setting->get('twitterEnabled');
$session->setting->set('twitterEnabled', 0 );
is( WebGUI::Macro::TwitterLogin::process( $session ), "", "Twitter Auth must be enabled in settings" );
$session->setting->set('twitterEnabled', 1 );
# Default twitter login image
my $output = WebGUI::Macro::TwitterLogin::process( $session );
like( $output, qr/<a href/, "macro contains link" );
like( $output, qr/op=auth/, "link to auth" );
like( $output, qr/authType=Twitter/, "contains authType specifically" );
like( $output, qr/twitter_login[.]png/, "contains default twitter login image" );
# Custom twitter login image
my $output = WebGUI::Macro::TwitterLogin::process( $session, "custom_image.png" );
unlike( $output, qr/twitter_login[.]png/, "doesn't contain default twitter login image" );
like( $output, qr/custom_image[.]png/, "contains custom login image" );
$session->setting->set('twitterEnabled', $twitterEnabled );
$session->config->set( 'authMethods', $authMethods );
#vim:ft=perl

88
t/Operation/Auth.t
View file

@ -25,20 +25,74 @@ use WebGUI::Operation::Auth;
# Init
my $session = WebGUI::Test->session;
#----------------------------------------------------------------------------
# Test package for method dispatch
BEGIN { $INC{'WebGUI/Auth/TestAuth.pm'} = __FILE__; }
package WebGUI::Auth::TestAuth;
use base 'WebGUI::Auth';
sub new {
my $self = shift->SUPER::new(@_);
$self->setCallable( ['callable'] );
return bless $self, 'WebGUI::Auth::TestAuth'; # Auth requires rebless
}
sub callable {
return "callable";
}
sub not_callable {
return "not callable";
}
sub www_verify {
return "verify";
}
package main;
#----------------------------------------------------------------------------
# Tests
plan tests => 4; # Increment this number for each test you create
plan tests => 10; # Increment this number for each test you create
#----------------------------------------------------------------------------
# Test the getInstance method
# By default, it returns a WebGUI::Auth::WebGUI object
my $auth = WebGUI::Operation::Auth::getInstance( $session );
ok($auth, 'getInstance returned something');
isa_ok($auth, 'WebGUI::Auth::WebGUI');
isa_ok($auth, 'WebGUI::Auth::' . $session->setting->get('authMethod') );
# Test setting authType by form var
$session->request->setup_body({
authType => 'TestAuth',
});
isa_ok(
WebGUI::Operation::Auth::getInstance( $session ),
'WebGUI::Auth::' . $session->setting->get('authMethod'),
'AuthType not in config file, so return default authType',
);
$session->config->addToArray( 'authMethods', 'TestAuth' );
isa_ok(
WebGUI::Operation::Auth::getInstance( $session ),
'WebGUI::Auth::TestAuth',
'AuthType in config file, so return instance of authType',
);
$session->user({ userId => 3 });
isa_ok(
WebGUI::Operation::Auth::getInstance( $session ),
'WebGUI::Auth::WebGUI',
'AuthType is defined by the logged-in user',
);
#----------------------------------------------------------------------------
# Test the web method for auth operation
# First a clean session, without an authenticated user
$session->user({ userId => 1 });
my $output = WebGUI::Operation::Auth::www_auth($session);
like(
$output,
@ -54,3 +108,33 @@ unlike(
qr/<input type="hidden" name="method" value="login" /,
"Hidden form elements for login NOT displayed to valid user",
);
# Go back to visitor and test callable dispatch
$session->user({ userId => 1 });
$session->request->setup_body({
authType => 'TestAuth',
method => 'callable',
});
eval { $output = WebGUI::Operation::Auth::www_auth( $session ); };
like( $output, qr{\bcallable\b}, 'Callable method is callable' );
# Test a method not in callable
$session->user({ userId => 1 });
$session->request->setup_body({
authType => 'TestAuth',
method => 'not_callable',
});
my $i18n = WebGUI::International->new($session);
my $error = $i18n->get(1077);
eval { $output = WebGUI::Operation::Auth::www_auth( $session ); };
like( $output, qr{$error}, 'not_callable method gives error message' );
# Test www_ dispatch
$session->user({ userId => 1 });
$session->request->setup_body({
authType => 'TestAuth',
method => 'verify',
});
eval { $output = WebGUI::Operation::Auth::www_auth( $session ); };
like( $output, qr{verify}, 'www_ callable without being setCallable' );

7
t/PassiveProfiling.t
View file

@ -31,6 +31,8 @@ plan tests => 1 + $numTests;
my $loaded = use_ok('WebGUI::PassiveProfiling');
my $versionTag = WebGUI::VersionTag->getWorking($session);
WebGUI::Test->addToCleanup(SQL => ['delete from passiveProfileLog where dateOfEntry >= ?', $startingTime-1]);
WebGUI::Test->addToCleanup($versionTag);
my $home = WebGUI::Asset->getDefault($session);
my $pageProperties = {
@ -120,7 +122,4 @@ cmp_bag(
}
END {
$session->db->write('delete from passiveProfileLog where dateOfEntry >= ?',[$startingTime-1]);
$versionTag->rollback;
}
#vim:ft=perl

3
t/Workflow/Activity/ArchiveOldStories.t
View file

@ -63,6 +63,9 @@ $creationDateSth->execute([$weekAgo, $weekStory->getId]);
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->commit;
WebGUI::Test->addToCleanup($versionTag);
foreach my $asset ($archive1, $archive2) {
$asset = $asset->cloneFromDb;
}
my $workflow = WebGUI::Workflow->create($session,
{

12
t/Workflow/Activity/BucketPassiveAnalytics.t
View file

@ -17,6 +17,9 @@ plan tests => 1; # increment this value for each test you create
my $session = WebGUI::Test->session;
$session->user({userId => 3});
WebGUI::Test->addToCleanup(SQL => 'delete from passiveLog');
WebGUI::Test->addToCleanup(SQL => 'delete from analyticRule');
my $workflow = WebGUI::Workflow->new($session, 'PassiveAnalytics000001');
my $activities = $workflow->getActivities();
##Note, they're in order, and the order is known.
@ -30,6 +33,7 @@ my $instance = WebGUI::Workflow::Instance->create($session,
priority => 1,
}
);
WebGUI::Test->addToCleanup($instance);
##Rule label, url, and regexp
my @ruleSets = (
['home', '/home', '^\/home' ],
@ -76,12 +80,6 @@ PAUSE: while (my $retval = $instance->run()) {
ok(1, 'One test');
END {
$session->db->write('delete from passiveLog');
$session->db->write('delete from analyticRule');
$instance->delete;
}
sub loadLogData {
my ($session, @urls) = @_;
$session->db->write('delete from passiveLog');
@ -99,3 +97,5 @@ sub loadLogData {
$startTime += int(rand(10))+1;
}
}
#vim:ft=perl

6
t/Workflow/Activity/ExtendCalendarRecurrences.t
View file

@ -30,7 +30,9 @@ my $calendar = $temp->addChild(
{ className => 'WebGUI::Asset::Wobject::Calendar' }
);
my $one_year_ago = DateTime->today->subtract(years => 1)->ymd;
my $eventStartDate = DateTime->today->truncate(to => 'month')->subtract(years => 1);
my $one_year_ago = $eventStartDate->ymd;
my $event = $calendar->addChild(
{ className => 'WebGUI::Asset::Event',
@ -43,7 +45,7 @@ my $recurId = $event->setRecurrence(
{ recurType => 'monthDay',
every => 2,
startDate => $event->get('startDate'),
dayNumber => DateTime->today->day,
dayNumber => $eventStartDate->day,
}
);

0
var/upgrades/upgrade_7.9.4-8.0.0.pl → var/upgrades/upgrade_7.9.8-8.0.0.pl
View file

BIN
www/extras/twitter_login.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 2.4 KiB

0
www/uploads/4f/8c/4f8cdd8196c4dbdfb4813125e49cd771/search-field.jpg → www/uploads/04/2f/042fe9d813d388dbc2d1188174ffbe06/search-field.jpg
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 355 B

After

Width:  |  Height:  |  Size: 355 B

Before After
Before After

0
www/uploads/4f/8c/4f8cdd8196c4dbdfb4813125e49cd771/thumb-search-field.jpg → www/uploads/04/2f/042fe9d813d388dbc2d1188174ffbe06/thumb-search-field.jpg
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 218 B

After

Width:  |  Height:  |  Size: 218 B

Before After
Before After

0
www/uploads/fb/c6/fbc6046688df8c59954142f2bb4a9770/pagination_button.jpg → www/uploads/05/1e/051e04bd094843b0f80f2d25bce1a4be/pagination_button.jpg
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 629 B

After

Width:  |  Height:  |  Size: 629 B

Before After
Before After

0
www/uploads/fb/c6/fbc6046688df8c59954142f2bb4a9770/thumb-pagination_button.jpg → www/uploads/05/1e/051e04bd094843b0f80f2d25bce1a4be/thumb-pagination_button.jpg
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 550 B

After

Width:  |  Height:  |  Size: 550 B

Before After
Before After

0
www/uploads/09/51/0951082ab7513a947b569914fd7b1110/next-btn.gif → www/uploads/07/c9/07c947159808530b2bec1c72d6e802d4/next-btn.gif
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 1.6 KiB

After

Width:  |  Height:  |  Size: 1.6 KiB

Before After
Before After

0
www/uploads/09/51/0951082ab7513a947b569914fd7b1110/thumb-next-btn.gif → www/uploads/07/c9/07c947159808530b2bec1c72d6e802d4/thumb-next-btn.gif
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 1.6 KiB

After

Width:  |  Height:  |  Size: 1.6 KiB

Before After
Before After

0
www/uploads/bb/a9/bba91ef5ff8acddd94dd06ac546689cb/search-field-r.jpg → www/uploads/0a/da/0ada3cf70e029ec6c550c99aaacbb08b/search-field-r.jpg
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 443 B

After

Width:  |  Height:  |  Size: 443 B

Before After
Before After

0
www/uploads/bb/a9/bba91ef5ff8acddd94dd06ac546689cb/thumb-search-field-r.jpg → www/uploads/0a/da/0ada3cf70e029ec6c550c99aaacbb08b/thumb-search-field-r.jpg
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 285 B

After

Width:  |  Height:  |  Size: 285 B

Before After
Before After

0
www/uploads/93/b2/93b21c67e07d87c6d01209bdf883269c/pic-title-bg.jpg → www/uploads/0c/1d/0c1d8bc28a3fdb34dd80cbeb4dca019e/pic-title-bg.jpg
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 470 B

After

Width:  |  Height:  |  Size: 470 B

Before After
Before After

0
www/uploads/93/b2/93b21c67e07d87c6d01209bdf883269c/thumb-pic-title-bg.jpg → www/uploads/0c/1d/0c1d8bc28a3fdb34dd80cbeb4dca019e/thumb-pic-title-bg.jpg
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 194 B

After

Width:  |  Height:  |  Size: 194 B

Before After
Before After

0
www/uploads/42/5f/425fb9eede05ff10b513d9c8594c4e88/previous-photo-button.png → www/uploads/13/d1/13d14e438168d653569b2ca760ba56dc/previous-photo-button.png
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 536 B

After

Width:  |  Height:  |  Size: 536 B

Before After
Before After

0
www/uploads/42/5f/425fb9eede05ff10b513d9c8594c4e88/thumb-previous-photo-button.png → www/uploads/13/d1/13d14e438168d653569b2ca760ba56dc/thumb-previous-photo-button.png
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 602 B

After

Width:  |  Height:  |  Size: 602 B

Before After
Before After

0
www/uploads/06/a7/06a73556e59fbaed38bd9a82644c87ee/addtl-info.gif → www/uploads/17/78/1778875702490c9b79c9ac2103c77c9b/addtl-info.gif
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 529 B

After

Width:  |  Height:  |  Size: 529 B

Before After
Before After

0
www/uploads/06/a7/06a73556e59fbaed38bd9a82644c87ee/thumb-addtl-info.gif → www/uploads/17/78/1778875702490c9b79c9ac2103c77c9b/thumb-addtl-info.gif
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 348 B

After

Width:  |  Height:  |  Size: 348 B

Before After
Before After

0
www/uploads/80/0a/800ad6ead3dacd161496fd9779c5add1/rss.gif → www/uploads/2b/59/2b59358ce8218fb982f321b17cb99d36/rss.gif
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 1 KiB

After

Width:  |  Height:  |  Size: 1 KiB

Before After
Before After

0
www/uploads/80/0a/800ad6ead3dacd161496fd9779c5add1/thumb-rss.gif → www/uploads/2b/59/2b59358ce8218fb982f321b17cb99d36/thumb-rss.gif
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 1 KiB

After

Width:  |  Height:  |  Size: 1 KiB

Before After
Before After

0
www/uploads/ff/c5/ffc58513ba67fb09e70836c97dc621f9/play.gif → www/uploads/2c/c0/2cc0dd8c552ec621737d6a455108435f/play.gif
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 1.7 KiB

After

Width:  |  Height:  |  Size: 1.7 KiB

Before After
Before After

0
www/uploads/ff/c5/ffc58513ba67fb09e70836c97dc621f9/thumb-play.gif → www/uploads/2c/c0/2cc0dd8c552ec621737d6a455108435f/thumb-play.gif
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 1.7 KiB

After

Width:  |  Height:  |  Size: 1.7 KiB

Before After
Before After

0
www/uploads/a1/dc/a1dc9775fd04c410b754c4207185fc31/moveUp.gif → www/uploads/2e/8c/2e8cebc357dca59ae83c99e256fdd42d/moveUp.gif
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 408 B

After

Width:  |  Height:  |  Size: 408 B

Before After
Before After

0
www/uploads/a1/dc/a1dc9775fd04c410b754c4207185fc31/thumb-moveUp.gif → www/uploads/2e/8c/2e8cebc357dca59ae83c99e256fdd42d/thumb-moveUp.gif
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 408 B

After

Width:  |  Height:  |  Size: 408 B

Before After
Before After

0
www/uploads/81/6c/816c86b926a1b698b9ba94ff2a0b487f/pagination_bg.jpg → www/uploads/35/ce/35ce9ad7ae21e6fb8526d365978a9b75/pagination_bg.jpg
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 730 B

After

Width:  |  Height:  |  Size: 730 B

Before After
Before After

0
www/uploads/81/6c/816c86b926a1b698b9ba94ff2a0b487f/thumb-pagination_bg.jpg → www/uploads/35/ce/35ce9ad7ae21e6fb8526d365978a9b75/thumb-pagination_bg.jpg
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 328 B

After

Width:  |  Height:  |  Size: 328 B

Before After
Before After

0
www/uploads/1a/eb/1aeba1113d33db041dd3c717af44d493/sub-btn.jpg → www/uploads/39/b8/39b86b97116138d94c025a0ac4806b4f/sub-btn.jpg
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 332 B

After

Width:  |  Height:  |  Size: 332 B

Before After
Before After

Some files were not shown because too many files have changed in this diff Show more