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

Merge branch 'master' into HEAD

Browse source 
Conflicts:
	docs/changelog/7.x.x.txt
This commit is contained in:
David Delikat 2011-09-30 03:47:09 +00:00
commit 3fbf953c9f
62 changed files with 1864 additions and 732 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1,10 +1,30 @@
7.10.24
- fixed #12256: Calendar Search doesn't show admin controls
7.10.23
- fixed #12225: Stock asset, multiple instances on a page
- fixed #12229: Indexed thingy data has gateway url prepended to it
- fixed #12195: Visitor group by scratch membership shared among all Visitors (Dale Trexel)
- fixed #12227: Corrected AssetReport such that OrderBy works correctly.
- fixed #12238: Old template attachement in search template slows down sites
- fixed #12239: Still get cart error message after removing extra recurring items from the cart
- fixed #12240: Empty Extend Calendar Recurrance version tags
- fixed #12241: Account Shop
- fixed #12246: Layout inherits mobileStyleTemplateId and mobileTemplateId from parent Layouts
- fixed #12246: added extra_www_add_properties as properties fix-up hook in child for www_add
- fixed #12231: Thingy reindex fails on upgrade
- fixed #12245: Encrypt Login and Display Message on Login conflict
- fixed #12211: Recurring Item error message in Cart
7.10.22
- rfe #12223: Add date type to content profiling (metadata)
- rfe #12207: Thingy. Field_name info returned by www_editThingDataSaveViaAjax
- fixed #12206: Bad Subscription Groups in Duplicated Threads
- fixed #12208: replacements don't work
- fixed #12213: Unable to view cart when an asset is deleted.
- added: Better integration between User Profile fields, the Shop address book and the EMS.
- fixed #12218: Failed INSERT in Passive Profiling causes leak
- fixed #12173: CrystalX theme Thingy drop down problem
7.10.21
- added #9668 extension template variable to attachment loops for the following assets:

393
docs/create.sql
View file

File diff suppressed because one or more lines are too long

12
docs/gotcha.txt
View file

@ -7,6 +7,18 @@ upgrading from one version to the next, or even between multiple
versions. Be sure to heed the warnings contained herein as they will
save you many hours of grief.
7.10.24
--------------------------------------------------------------------
* WebGUI now depends on Business::OnlinePayment::AuthorizeNet. This version
should install automatically via the testEnvironment.pl script, or the
perl-standard CPAN module.
7.10.23
--------------------------------------------------------------------
* The default_search2 template had a bad template attachment pointing to
an old WebGUI CSS Snippet called /webgui.css. Any attachment with that
URL will be removed from ALL templates in the Search namespace.
7.10.21
--------------------------------------------------------------------
* WebGUI now depends on Kwargs.

2
docs/legal.txt
View file

@ -2,7 +2,7 @@
# WebGUI Legal Information #
####################################################################
WebGUI is Copyright 2001-2009 Plain Black Corporation. All rights
WebGUI is Copyright 2001-2011 Plain Black Corporation. All rights
reserved.
WebGUI Content Engine, WebGUI Runtime Environment, and Plain Black

393
docs/previousVersion.sql
View file

File diff suppressed because one or more lines are too long

4
docs/templates.txt
View file

@ -1,6 +1,10 @@
This is a running list of template changes made during upgrades. If you have copied the default
templates, you will need to apply these changes manually to your copies.
7.10.22
* Thingy CSS file - root/import/thingy-templates/thingy.css
Add CSS to make sure that overflows are visible, to handle style that hide overflow by default.
7.10.18
* Collaboration System Default Notification Template /default_forum_notification
Replace table with divs to make inline replying easier.

BIN
docs/upgrades/packages-7.10.22/root_import_thingy-templates_thingy.css.wgpkg Normal file
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.10.23/shopping-cart-collateral-items_my-purchases-default.wgpkg Normal file
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.10.23/stockdatatmpl000000001.wgpkg Normal file
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.10.24/root_import_calendar-templates_default-calendar-search.wgpkg Normal file
View file

Binary file not shown.

BIN
docs/upgrades/packages-7.9.34-7.10.22/merged.wgpkg Normal file
View file

Binary file not shown.

141
docs/upgrades/upgrade_7.10.22-7.10.23.pl Normal file
View file

@ -0,0 +1,141 @@
#!/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.10.23';
my $quiet; # this line required
my $session = start(); # this line required
# upgrade functions go here
fixBadTemplateAttachments($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 fixBadTemplateAttachments {
my $session = shift;
print "\tRemove template attachements in search templates that refer to an old, deleted CSS snippet... " unless $quiet;
# and here's our code
use WebGUI::Asset::Template;
my $get_template = WebGUI::Asset::Template->getIsa($session);
TEMPLATE: while (1) {
my $template = eval {$get_template->()};
next TEMPLATE if Exception::Class->caught;
last TEMPLATE unless $template;
next TEMPLATE unless $template->get('namespace') eq 'Search';
$template->removeAttachments(['^/(webgui.css);']);
}
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
docs/upgrades/upgrade_7.10.23-7.10.24.pl Normal file
View file

@ -0,0 +1,123 @@
#!/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.10.24';
my $quiet; # this line required
my $session = start(); # this line required
# upgrade functions go here
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;
#}
# -------------- 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

561
docs/upgrades/upgrade_7.9.34-7.10.22.pl Normal file
View file

@ -0,0 +1,561 @@
#!/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 = "0.0.0"; # make this match what version you're going to
my $quiet; # this line required
my $session = start(); # this line required
# upgrade functions go here
i18nForAddonsTitle($session);
addForkTable($session);
installForkCleanup($session);
addVersioningToMetadata($session);
installNewDashboardTables($session);
addStockDataCacheColumn($session);
addWeatherDataCacheColumn($session);
addLastModifiedByMacro($session);
addAutoPlayToCarousel( $session );
addProcessorDropdownToSnippet( $session );
addRichEditToCarousel($session);
alterAssetIndexTable($session);
reindexAllThingys($session);
use WebGUI::Asset::MapPoint;
WebGUI::AssetAspect::Installable::upgrade("WebGUI::Asset::MapPoint",$session);
addRenderThingDataMacro($session);
addAssetPropertyMacro($session);
createThingyDBColumns($session);
addAssetManagerSortPreferences($session);
addTicketLimitToBadgeGroup( $session );
addFormFieldMacroToConfig();
addWaitForConfirmationWorkflow($session);
addCreateUsersEnabledSetting($session);
addAuthorizePaymentDriver($session);
createAddressField($session);
addLinkedProfileAddress($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;
#}
#----------------------------------------------------------------------------
# This internationalizes the link text of the addons link in the adminconsole
sub i18nForAddonsTitle {
my $session = shift;
print "\tInternationalize the text of the addons link in the adminconsole... " unless $quiet;
$session->config->set('adminConsole/addons',
{
icon => "addons.png",
uiLevel => 1,
group => "12",
url => "http://www.webgui.org/addons",
title => "^International(Addons title,WebGUI);"
}
);
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
# Creates a new table for tracking background processes
sub addForkTable {
my $session = shift;
my $db = $session->db;
my $sth = $db->dbh->table_info('', '', 'Fork', 'TABLE');
return if ($sth->fetch);
print "\tAdding Fork table..." unless $quiet;
my $sql = q{
CREATE TABLE Fork (
id CHAR(22),
userId CHAR(22),
groupId CHAR(22),
status LONGTEXT,
error TEXT,
startTime BIGINT(20),
endTime BIGINT(20),
finished BOOLEAN DEFAULT FALSE,
latch BOOLEAN DEFAULT FALSE,
PRIMARY KEY(id)
);
};
$db->write($sql);
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
# install a workflow to clean up old background processes
sub installForkCleanup {
my $session = shift;
print "\tInstalling Fork Cleanup workflow..." unless $quiet;
my $class = 'WebGUI::Workflow::Activity::RemoveOldForks';
$session->config->addToArray('workflowActivities/None', $class);
my $wf = WebGUI::Workflow->new($session, 'pbworkflow000000000001');
use List::Util qw/first/;
my $a = first { ref $_ eq $class } @{ $wf->getActivities };
unless ($a) {
$a = $wf->addActivity($class);
$a->set(title => 'Remove Old Forks');
};
print "DONE!\n" unless $quiet;
}
sub addVersioningToMetadata {
my $session = shift;
print "\tAltering metadata tables for versioning..." unless $quiet;
my $db = $session->db;
$db->write(q{
alter table metaData_values
add column revisionDate bigint,
drop primary key,
add primary key (fieldId, assetId, revisionDate);
});
$db->write(q{
create table metaData_classes (
className char(255),
fieldId char(22)
);
});
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
# Describe what our function does
sub addLastModifiedByMacro {
my $session = shift;
print "\tAdd LastModifiedBy macro to the config file... " unless $quiet;
# and here's our code
$session->config->addToHash('macros', 'LastModifiedBy', 'LastModifiedBy');
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
# Describe what our function does
sub installNewDashboardTables {
my $session = shift;
print "\tInstall new Dashboard tables... " unless $quiet;
$session->db->write(<<EOSQL);
CREATE TABLE IF NOT EXISTS Dashboard_dashlets (
dashboardAssetId CHAR(22) BINARY,
dashletAssetId CHAR(22) BINARY,
isStatic BOOLEAN,
isRequired BOOLEAN,
PRIMARY KEY (dashboardAssetId, dashletAssetId)
) TYPE=MyISAM CHARSET=utf8;
EOSQL
$session->db->write(<<EOSQL);
CREATE TABLE IF NOT EXISTS Dashboard_userPrefs (
dashboardAssetId CHAR(22) BINARY,
dashletAssetId CHAR(22) BINARY,
userId CHAR(22) BINARY,
isMinimized BOOLEAN,
properties LONGTEXT,
PRIMARY KEY (dashboardAssetId, dashletAssetId, userId)
) TYPE=MyISAM CHARSET=utf8;
EOSQL
# and here's our code
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
# Describe what our function does
sub addStockDataCacheColumn {
my $session = shift;
print "\tAdd cache column for the StockData asset... " unless $quiet;
$session->db->write(<<EOSQL);
ALTER TABLE StockData ADD COLUMN cacheTimeout BIGINT
EOSQL
# and here's our code
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
# Describe what our function does
sub addWeatherDataCacheColumn {
my $session = shift;
print "\tAdd cache column for the WeatherData asset... " unless $quiet;
$session->db->write(<<EOSQL);
ALTER TABLE WeatherData ADD COLUMN cacheTimeout BIGINT
EOSQL
# and here's our code
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
# Add AutoPlay fields to the Carousel
sub addAutoPlayToCarousel {
my $session = shift;
print "\tAdding Auto Play to Carousel... " unless $quiet;
$session->db->write(
"ALTER TABLE Carousel ADD COLUMN autoPlay INT, ADD COLUMN autoPlayInterval INT"
);
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
sub addProcessorDropdownToSnippet {
my $session = shift;
my $db = $session->db;
print "\tUpdating the Snippet table to add templateProcessor option..."
unless $quiet;
my $rows = $db->buildArrayRefOfHashRefs(q{
select assetId, revisionDate from snippet where processAsTemplate = 1
});
$db->write(q{
alter table snippet
drop column processAsTemplate,
add column templateParser char(255)
});
my $default = $session->config->get('defaultTemplateParser');
for my $row (@$rows) {
$db->write(q{
update snippet
set templateParser = ?
where assetId = ? and revisionDate = ?
}, [ $default, $row->{assetId}, $row->{revisionDate} ]);
}
print "Done!\n";
}
#----------------------------------------------------------------------------
# Describe what our function does
sub addRichEditToCarousel {
my $session = shift;
print "\tAdd RichEdit option to the Carousel... " unless $quiet;
# and here's our code
$session->db->write('ALTER TABLE Carousel ADD COLUMN richEditor CHAR(22) BINARY');
$session->db->write(q!update Carousel set richEditor='PBrichedit000000000001'!);
print "DONE!\n" unless $quiet;
}
sub addRenderThingDataMacro {
my $session = shift;
print "\tAdd the new RenderThingData macro to the site config... " unless $quiet;
$session->config->addToHash('macros', 'RenderThingData', 'RenderThingData');
print "DONE!\n" unless $quiet;
}
sub alterAssetIndexTable {
my $session = shift;
print "\tExtend the assetIndex table so we can search things other than assets... " unless $quiet;
$session->db->write(<<EOSQL);
alter table assetIndex
drop primary key,
add column subId char(255) CHARACTER SET utf8 COLLATE utf8_bin DEFAULT NULL,
add primary key (assetId, url)
EOSQL
print "DONE!\n" unless $quiet;
}
sub reindexAllThingys {
my $session = shift;
print "\tReindex all Thingys... " unless $quiet;
use WebGUI::Asset::Wobject::Thingy;
my $get_thingy = WebGUI::Asset::Wobject::Thingy->getIsa($session);
THINGY: while (1) {
my $thingy = eval { $get_thingy->() };
next THINGY if Exception::Class->caught();
last THINGY unless $thingy;
$thingy->indexContent;
}
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
sub addAssetPropertyMacro {
my $session = shift;
my $c = $session->config;
my $hash = $c->get('macros');
unless (grep { $_ eq 'AssetProperty' } values %$hash) {
print "\tAdding AssetProperty macro... " unless $quiet;
$c->set('macros/AssetProperty' => 'AssetProperty');
print "DONE!\n" unless $quiet;
}
}
#----------------------------------------------------------------------------
# Creates new column in tables for Thingy_fields and Thingy_things
sub createThingyDBColumns {
my $session = shift;
print "\tAdding db. columns Thingy_fields.isUnique and Thingy_things.maxEntriesTotal.." unless $quiet;
# and here's our code
my %tfHash = $session->db->quickHash("show columns from Thingy_fields where Field='isUnique'");
my %ttHash = $session->db->quickHash("show columns from Thingy_things where Field='maxEntriesTotal'");
unless ( $tfHash{'Field'}) { $session->db->write("alter table Thingy_fields add isUnique int(1) default 0"); }
unless ( $ttHash{'Field'}) { $session->db->write("alter table Thingy_things add maxEntriesTotal int default null"); }
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
sub addAssetManagerSortPreferences {
my $cn = 'assetManagerSortColumn';
my $on = 'assetManagerSortDirection';
use WebGUI::ProfileField;
unless (WebGUI::ProfileField->new($session, $cn)) {
print 'Adding Asset Manager Sort Column profile field...'
unless $quiet;
WebGUI::ProfileField->create($session, $cn => {
label =>
"WebGUI::International::get('$cn label', 'Account_Profile')",
protected => 1,
fieldType => 'selectBox',
dataDefault => 'lineage',
possibleValues => <<'VALUES',
{
lineage => WebGUI::International::get('rank', 'Asset'),
title => WebGUI::International::get(99, 'Asset'),
className => WebGUI::International::get('type', 'Asset'),
revisionDate => WebGUI::International::get('revision date', 'Asset'),
assetSize => WebGUI::International::get('size', 'Asset'),
lockedBy => WebGUI::International::get('locked', 'Asset'),
}
VALUES
}, 4);
print "Done!\n" unless $quiet;
}
unless (WebGUI::ProfileField->new($session, $on)) {
print 'Adding Asset Manager Sort Direction profile field...'
unless $quiet;
WebGUI::ProfileField->create($session, $on => {
label =>
"WebGUI::International::get('$on label', 'Account_Profile')",
protected => 1,
fieldType => 'selectBox',
dataDefault => 'asc',
possibleValues => <<'VALUES',
{
asc => WebGUI::International::get('ascending', 'Account_Profile'),
desc => WebGUI::International::get('descending', 'Account_Profile'),
}
VALUES
}, 4);
print "Done!\n" unless $quiet;
}
}
#----------------------------------------------------------------------------
# Add a ticket limit to badges in a badge group
sub addTicketLimitToBadgeGroup {
my $session = shift;
print "\tAdd ticket limit to badge groups... " unless $quiet;
# Make sure it hasn't been done already...
my $columns = $session->db->buildHashRef('describe EMSBadgeGroup');
if(! grep { /ticketsPerBadge/ } keys %{$columns}) {
$session->db->write(q{
ALTER TABLE EMSBadgeGroup ADD COLUMN `ticketsPerBadge` INTEGER
});
}
print "DONE!\n" unless $quiet;
}
sub addFormFieldMacroToConfig {
print "\tAdd FormField macro to config... " unless $quiet;
$session->config->addToHash( 'macros', FormField => 'FormField' );
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
sub addWaitForConfirmationWorkflow {
my $session = shift;
my $c = $session->config;
my $exists = $c->get('workflowActivities/WebGUI::User');
my $class = 'WebGUI::Workflow::Activity::WaitForUserConfirmation';
unless (grep { $_ eq $class } @$exists) {
print "Adding WaitForUserConfirmation workflow..." unless $quiet;
$c->addToArray('workflowActivities/WebGUI::User' => $class);
print "Done!\n" unless $quiet;
}
}
#----------------------------------------------------------------------------
sub addCreateUsersEnabledSetting {
my $session = shift;
my $s = $session->setting;
my $name = 'enableUsersAfterAnonymousRegistration';
return if $s->has($name);
print "Adding $name setting..." unless $quiet;
$s->add($name => 1);
print "Done!\n" unless $quiet;
}
#----------------------------------------------------------------------------
# Add the Authorize.net payment driver to each config file
sub addAuthorizePaymentDriver {
my $session = shift;
print "\tAdd the Authorize.net payment driver... " unless $quiet;
# and here's our code
$session->config->addToArray('paymentDrivers', 'WebGUI::Shop::PayDriver::CreditCard::AuthorizeNet');
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
sub addLinkedProfileAddress {
my $session = shift;
print "\tAdding linked profile addresses for existing users... " unless $quiet;
my $users = $session->db->buildArrayRef( q{
select userId from users where userId not in ('1','3')
} );
use WebGUI::User;
use WebGUI::Shop::AddressBook;
foreach my $userId (@$users) {
#check to see if there is user profile information available
my $u = WebGUI::User->new($session,$userId);
#skip if user does not have any homeAddress fields filled in
next unless (
$u->profileField("homeAddress")
|| $u->profileField("homeCity")
|| $u->profileField("homeState")
|| $u->profileField("homeZip")
|| $u->profileField("homeCountry")
|| $u->profileField("homePhone")
);
#Get the address book for the user (one is created if it does not exist)
my $addressBook = WebGUI::Shop::AddressBook->newByUserId($session,$userId);
#Add the profile address for the user
$addressBook->addAddress({
label => "Profile Address",
firstName => $u->profileField("firstName"),
lastName => $u->profileField("lastName"),
address1 => $u->profileField("homeAddress"),
city => $u->profileField("homeCity"),
state => $u->profileField("homeState"),
country => $u->profileField("homeCountry"),
code => $u->profileField("homeZip"),
phoneNumber => $u->profileField("homePhone"),
email => $u->profileField("email"),
isProfile => 1,
});
}
print "DONE!\n" unless $quiet;
}
#----------------------------------------------------------------------------
sub createAddressField {
my $session = shift;
#skip if field exists
my $columns = $session->db->buildArrayRef("show columns from address where Field='isProfile'");
return if(scalar(@$columns));
print "\tAdding profile link to Address... " unless $quiet;
$session->db->write( q{
alter table address add isProfile tinyint default 0
} );
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;
print "\tUpdating packages.\n" unless ($quiet);
addPackage( $session, 'packages-7.9.34-7.10.22/merged.wgpkg' );
}
#vim:ft=perl

3
etc/WebGUI.conf.original
View file

@ -190,7 +190,7 @@
# List the authentication plug-ins you wish to be available on
# this site.
"authMethods" : [ "LDAP", "WebGUI" ],
"authMethods" : [ "LDAP", "WebGUI", "Twitter" ],
# List the merchant gateways you have installed and wish to be
# available on this site.
@ -856,6 +856,7 @@
"r" : "r_printable",
"Spacer" : "Spacer",
"SpectreCheck" : "SpectreCheck",
"TwitterLogin" : "TwitterLogin",
"Thumbnail" : "Thumbnail",
"User" : "User",
"UsersOnline" : "UsersOnline",

116
lib/WebGUI.pm
View file

@ -1,8 +1,8 @@
package WebGUI;
our $VERSION = '7.10.22';
our $STATUS = 'beta';
our $VERSION = '7.10.24';
our $STATUS = 'stable';
=head1 LEGAL
@ -54,9 +54,13 @@ These subroutines are available from this package:
#-------------------------------------------------------------------
=head2 authen ( requestObject, [ user, pass, config ])
=head2 authen ( requestObject, user || undef, pass || undef, session ])
HTTP Basic auth for WebGUI.
Either called from L<WebGUI::Content::URL> directly or indirectly when pushed back on the L<mod_perl> handler stack.
HTTP Basic auth is an alternative authentication mechanism for WebGUI for robots such as RSS feed readers.
L<WebGUI::Content::URL> does nothing with the return codes from here, but L<mod_perl> uses them if this routine
gets pushed as a handler.
=head3 requestObject
@ -70,16 +74,17 @@ The username to authenticate with. Will pull from the request object if not spec
The password to authenticate with. Will pull from the request object if not specified.
=head3 config
=head3 session
A reference to a WebGUI::Config object. One will be created if it isn't specified.
A reference to a WebGUI::Session object.
=cut
sub authen {
my ($request, $username, $password, $config) = @_;
my ($request, $username, $password, $session) = @_;
$request = Apache2::Request->new($request);
my $log = $session->log;
my $server = Apache2::ServerUtil->server;
my $status = Apache2::Const::OK;
@ -88,67 +93,46 @@ sub authen {
if ($request->auth_type eq "Basic") {
($status, $password) = $request->get_basic_auth_pw;
$username = $request->user;
$username or return Apache2::Const::HTTP_UNAUTHORIZED;
}
else {
return Apache2::Const::HTTP_UNAUTHORIZED;
# per http://www.webgui.org/use/bugs/tracker/12198, failures result in the user remaining visitor, not them
# being denied access entirely.
# $status = Apache2::Const::HTTP_UNAUTHORIZED; # no
return $status;
}
}
$config ||= WebGUI::Config->new($server->dir_config('WebguiRoot'),$request->dir_config('WebguiConfig'));
my $cookies = eval { APR::Request::Apache2->handle($request)->jar(); };
if (blessed $@ && $@->isa('APR::Request::Error')) {
$cookies = $@->jar;
my $user = WebGUI::User->newByUsername($session, $username);
if ( ! defined $user ) {
# $status = Apache2::Const::HTTP_UNAUTHORIZED; # no
return $status;
}
else {
$cookies = {};
}
# determine session id
my $sessionId = $cookies->{$config->getCookieName};
my $session = WebGUI::Session->open($server->dir_config('WebguiRoot'),$config->getFilename, $request, $server, $sessionId);
my $log = $session->log;
$request->pnotes(wgSession => $session);
if (defined $sessionId && $session->user->isRegistered) { # got a session id passed in or from a cookie
$log->info("BASIC AUTH: using cookie");
return Apache2::Const::OK;
}
elsif ($status != Apache2::Const::OK) { # prompt the user for their username and password
$log->info("BASIC AUTH: prompt for user/pass");
return $status;
}
elsif (defined $username && $username ne "") { # no session cookie, let's try to do basic auth
$log->info("BASIC AUTH: using user/pass");
my $user = WebGUI::User->newByUsername($session, $username);
if (defined $user) {
my $authMethod = $user->authMethod;
if ($authMethod) { # we have an auth method, let's try to instantiate
my $auth = eval { WebGUI::Pluggable::instanciate("WebGUI::Auth::".$authMethod, "new", [ $session, $authMethod ] ) };
if ($@) { # got an error
$log->error($@);
return Apache2::Const::SERVER_ERROR;
}
elsif ($auth->authenticate($username, $password)) { # lets try to authenticate
$log->info("BASIC AUTH: authenticated successfully");
$sessionId = $session->db->quickScalar("select sessionId from userSession where userId=?",[$user->userId]);
unless (defined $sessionId) { # no existing session found
$log->info("BASIC AUTH: creating new session");
$sessionId = $session->id->generate;
$auth->_logLogin($user->userId, "success (HTTP Basic)");
}
$session->{_var} = WebGUI::Session::Var->new($session, $sessionId);
$session->user({user=>$user});
return Apache2::Const::OK;
}
}
}
$log->security($username." failed to login using HTTP Basic Authentication");
$request->auth_type('Basic');
$request->note_basic_auth_failure;
return Apache2::Const::HTTP_UNAUTHORIZED;
}
$log->info("BASIC AUTH: skipping");
return Apache2::Const::HTTP_UNAUTHORIZED;
my $authMethod = $user->authMethod;
if ($authMethod) { # we have an auth method, let's try to instantiate
my $auth = eval { WebGUI::Pluggable::instanciate("WebGUI::Auth::".$authMethod, "new", [ $session, $authMethod ] ) };
if ($@) { # got an error
$log->error($@);
return Apache2::Const::SERVER_ERROR;
}
elsif ($auth->authenticate($username, $password)) { # lets try to authenticate
$log->info("BASIC AUTH: authenticated successfully");
my $sessionId = $session->db->quickScalar("select sessionId from userSession where userId=?",[$user->userId]);
unless (defined $sessionId) { # no existing session found
$log->info("BASIC AUTH: creating new session");
$sessionId = $session->id->generate;
$auth->_logLogin($user->userId, "success (HTTP Basic)");
}
$session->{_var} = WebGUI::Session::Var->new($session, $sessionId);
$session->user({user=>$user});
return Apache2::Const::OK;
}
}
$log->security($username." failed to login using HTTP Basic Authentication");
# $status = Apache2::Const::HTTP_UNAUTHORIZED; # no
return $status;
}
#-------------------------------------------------------------------
@ -175,18 +159,6 @@ sub handler {
$matchUri =~ s{^$gateway}{/};
my $gotMatch = 0;
# handle basic auth
my $auth = $request->headers_in->{'Authorization'};
if ($auth =~ m/^Basic/) { # machine oriented
# Get username and password from Apache and hand over to authen
$auth =~ s/Basic //;
authen($request, split(":", MIME::Base64::decode_base64($auth), 2), $config);
}
else { # realm oriented
$request->push_handlers(PerlAuthenHandler => sub { return WebGUI::authen($request, undef, undef, $config)});
}
# url handlers
WEBGUI_FATAL: foreach my $handler (@{$config->get("urlHandlers")}) {
my ($regex) = keys %{$handler};

80
lib/WebGUI/Asset.pm
View file

@ -2891,20 +2891,51 @@ sub view {
=head2 www_add ( )
Adds a new Asset based upon the class of the current form. Returns the Asset calling method www_edit(); The
new Asset will inherit security and style properties from the current asset, the parent.
Create a new, unsaved asset with a parent of this asset from C<class>, C<url>, and optional C<prototype> parameters and present the
edit screen for it.
Calls C<get_add_instance> to configure the new asset; the default implementation inherits security and
style properties from the current asset, the parent.
=cut
sub www_add {
my $self = shift;
my %prototypeProperties;
my $class = $self->loadModule($self->session, $self->session->form->process("class","className"));
my $prototype = $self->session->form->process('prototype');
my $url = scalar($self->session->form->param("url"));
return undef unless (defined $class);
return $self->session->privilege->insufficient() unless ($class->canAdd($self->session));
if ($self->session->form->process('prototype')) {
my $prototype = WebGUI::Asset->new($self->session, $self->session->form->process("prototype"),$class);
foreach my $definition (@{$prototype->definition($self->session)}) { # cycle through rather than copying properties to avoid grabbing stuff we shouldn't grab
my $newAsset = $class->get_add_instance( $self->session, $self, $url, $prototype );
$newAsset->{_parent} = $self;
return $newAsset->www_edit();
}
#-------------------------------------------------------------------
=head2 get_add_instance ( $session, $parentAsset, $url, $prototype )
Class method.
Called from C<www_add> by the parent asset on the class of the new asset being constructed.
Configures the new asset with defaults, including inheriting security and style properties from the current asset.
C<$prototype> is the optional assetId of an asset to initialize the new asset from.
=cut
sub get_add_instance {
my $class = shift;
my $session = shift;
my $parentAsset = shift;
my $url = shift;
my $prototype = shift;
my %prototypeProperties;
if ($prototype) {
my $prototype = WebGUI::Asset->new($session, $prototype, $class);
foreach my $definition (@{$prototype->definition($session)}) { # cycle through rather than copying properties to avoid grabbing stuff we shouldn't grab
foreach my $property (keys %{$definition->{properties}}) {
next if (isIn($property,qw(title menuTitle url isPrototype isPackage)));
next if ($definition->{properties}{$property}{noFormPost});
@ -2912,24 +2943,25 @@ sub www_add {
}
}
}
my %properties = (
%prototypeProperties,
parentId => $self->getId,
groupIdView => $self->get("groupIdView"),
groupIdEdit => $self->get("groupIdEdit"),
ownerUserId => $self->get("ownerUserId"),
encryptPage => $self->get("encryptPage"),
styleTemplateId => $self->get("styleTemplateId"),
printableStyleTemplateId => $self->get("printableStyleTemplateId"),
isHidden => $self->get("isHidden"),
className=>$class,
assetId=>"new",
url=>scalar($self->session->form->param("url")),
);
$properties{isHidden} = 1 unless $self->session->config->get("assets/".$class."/isContainer");
my $newAsset = WebGUI::Asset->newByPropertyHashRef($self->session,\%properties);
$newAsset->{_parent} = $self;
return $newAsset->www_edit();
my %properties = (
%prototypeProperties,
parentId => $parentAsset->getId,
groupIdView => $parentAsset->get("groupIdView"),
groupIdEdit => $parentAsset->get("groupIdEdit"),
ownerUserId => $parentAsset->get("ownerUserId"),
encryptPage => $parentAsset->get("encryptPage"),
styleTemplateId => $parentAsset->get("styleTemplateId"),
printableStyleTemplateId => $parentAsset->get("printableStyleTemplateId"),
isHidden => $parentAsset->get("isHidden"),
className => $class,
assetId => "new",
url => $url,
);
$properties{isHidden} = 1 unless $session->config->get("assets/".$class."/isContainer");
return WebGUI::Asset->newByPropertyHashRef($session, \%properties);
}
#-------------------------------------------------------------------

4
lib/WebGUI/Asset/Template.pm
View file

@ -646,15 +646,15 @@ sub prepare {
$style->setRawHeadTags($headBlock);
my %props = ( type => 'text/css', rel => 'stylesheet' );
foreach my $sheet ( @{ $self->getAttachments('stylesheet') } ) {
my %props = ( type => 'text/css', rel => 'stylesheet' );
$style->setLink($sheet->{url}, \%props);
}
my $doScripts = sub {
my ($type, $body) = @_;
my %props = ( type => 'text/javascript' );
foreach my $script ( @{ $self->getAttachments($type) } ) {
my %props = ( type => 'text/javascript' );
$style->setScript($script->{url}, \%props, $body);
}
};

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

@ -159,9 +159,8 @@ sub getTemplateVars {
$rules->{'whereClause'} .= qq{$prop $op $value};
}
if($rules->{'whereClause'}) {
$rules->{'joinClass'} = $settings->{className};
}
# Always join to the class, asset and assetData are excluded by getLineageSql
$rules->{'joinClass'} = $settings->{className};
#Build the order by condition
my $order = $settings->{order};

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

@ -1681,7 +1681,7 @@ sub update {
my $instance_data = {
workflowId => 'xR-_GRRbjBojgLsFx3dEMA',
className => 'WebGUI::Asset',
methodName => 'newByDynamicClass',
methodName => 'newPending',
parameters => $self->getId,
};
my $instance = WebGUI::Workflow::Instance->create($self->session, $instance_data);

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

@ -514,5 +514,35 @@ sub www_view {
return $self->SUPER::www_view;
}
#-------------------------------------------------------------------
=head2 get_add_instance ()
Subclass the standard C<get_add_instance> to inherit
C<mobileStyleTemplateId> and C<mobileTemplateId> from the parent asset if it is an instance of
L<WebGUI::Asset::Wobject::Layout>.
=cut
sub get_add_instance {
my $class = shift;
my $session = shift;
my $parentAsset = shift;
my $url = shift;
my $prototype = shift;
my $instance = $class->SUPER::get_add_instance( $session, $parentAsset, $url, $prototype, @_ );
if( $parentAsset->isa('WebGUI::Asset::Wobject::Layout') ) {
$instance->update({
mobileStyleTemplateId => $parentAsset->get("mobileStyleTemplateId"),
mobileTemplateId => $parentAsset->get("mobileTemplateId"),
});
}
return $instance;
}
1;

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

@ -1061,7 +1061,7 @@ sub getFieldValue {
# TODO: The otherThing field type is probably also handled by getFormPlugin, so the elsif below can probably be
# safely removed. However, this requires more testing than I can provide right now, so for now this stays the
# way it was.
elsif ($field->{fieldType} =~ m/^otherthing/x) {
elsif ($fieldType =~ m/^otherthing/x) {
my $otherThingId = $field->{fieldType};
$otherThingId =~ s/^otherThing_//x;
my $tableName = 'Thingy_'.$otherThingId;
@ -1611,11 +1611,11 @@ sub indexThing {
return unless $thing;
my $index = WebGUI::Search::Index->new($self);
$index->addRecord(
url => $self->getUrl($self->getThingUrl($thing)),
groupIdView => $thing->{groupIdView},
title => $thing->{label},
subId => $thing->{thingId},
keywords => join(' ', @{$thing}{qw/label editScreenTitle editInstructions searchScreenTitle searchDescription/}),
url => $self->session->url->append($self->get('url'), $self->getThingUrl($thing)),
);
##Easy update of all thingData fields for this thing. This is in lieu of deleting all records
##And rebuilding them all.
@ -1687,7 +1687,7 @@ sub indexThingData {
|| $self->getTitle;
$index->addRecord(
assetId => $self->getId,
url => $self->getUrl('func=viewThingData;thingId='. $thing->{thingId} . ';thingDataId='. $thingData->{thingDataId}),
url => $session->url->append($self->get('url'), 'func=viewThingData;thingId='. $thing->{thingId} . ';thingDataId='. $thingData->{thingDataId}),
groupIdView => $thing->{groupIdView},
title => $title,
subId => $thing->{thingId} . '-' . $thingData->{thingDataId},

2
lib/WebGUI/AssetMetaData.pm
View file

@ -378,7 +378,7 @@ sub www_editMetaDataField {
-label=>$i18n->get(486),
-hoverHelp=>$i18n->get('Data Type description'),
-value=>$fieldInfo->{fieldType} || "text",
-types=> [ qw /text integer yesNo selectBox radioList checkList/ ]
-types=> [ qw /text integer yesNo selectBox radioList checkList date/ ]
);
my $default = WebGUI::Asset->definition($self->session)->[0]->{assetName};

32
lib/WebGUI/Auth.pm
View file

@ -32,6 +32,7 @@ use WebGUI::Workflow::Instance;
use WebGUI::Shop::AddressBook;
use WebGUI::Inbox;
use WebGUI::Friends;
use URI;
# Profile field name for the number of times the showMessageOnLogin has been
# seen.
@ -894,12 +895,6 @@ sub login {
$u->karma($self->session->setting->get("karmaPerLogin"),"Login","Just for logging in.") if ($self->session->setting->get("useKarma"));
$self->_logLogin($uid,"success");
if ($self->session->setting->get('encryptLogin')) {
my $currentUrl = $self->session->url->page(undef,1);
$currentUrl =~ s/^https:/http:/;
$self->session->http->setRedirect($currentUrl);
}
# Run on login
my $command = $self->session->config->get("runOnLogin");
if ($command ne "") {
@ -927,6 +922,11 @@ sub login {
$self->session->http->setRedirect($self->session->setting->get("redirectAfterLoginUrl"));
$self->session->scratch->delete("redirectAfterLogin");
}
elsif ($self->session->setting->get('encryptLogin')) {
my $currentUrl = $self->session->url->page(undef,1);
$currentUrl =~ s/^https:/http:/;
$self->session->http->setRedirect($currentUrl);
}
# Get open version tag. This is needed if we want
# to reclaim a version right after login (singlePerUser and siteWide mode)
@ -1100,20 +1100,26 @@ sub showMessageOnLogin {
# Add the link to continue
my $session = $self->session;
$session->log->warn("returnUrl: >".$self->session->form->get( 'returnUrl' )."<");
$session->log->warn("redirectAfterLoginUrl: >".$self->session->form->get( 'returnUrl' )."<");
my $redirectUrl = $self->session->form->get( 'returnUrl' )
|| $self->session->setting->get("redirectAfterLoginUrl")
|| $self->session->scratch->get( 'redirectAfterLogin' )
|| $self->session->url->getBackToSiteURL
my $redirectUrl = $session->form->get( 'returnUrl' )
|| $session->setting->get("redirectAfterLoginUrl")
|| $session->scratch->get( 'redirectAfterLogin' )
|| $session->url->getBackToSiteURL
;
if ($session->setting->get('encryptLogin') && ( ! $redirectUrl =~ /^http/)) {
##A scheme-less URL has been supplied. We need to make it an absolute one
##with a non-encrypted scheme. Otherwise the user will stay in SSL mode.
##We assume that the user put the gateway URL into their URL.
my $uri = URI->new_abs($redirectUrl, $session->url->getSiteURL);
$uri->scheme('http');
$redirectUrl = $uri->as_string;
}
$output .= '<p><a href="' . $redirectUrl . '">' . $i18n->get( 'showMessageOnLogin return' )
. '</a></p>'
;
# No matter what, we won't be redirecting after this
$self->session->scratch->delete( 'redirectAfterLogin' );
$session->scratch->delete( 'redirectAfterLogin' );
return $output;
}

2
lib/WebGUI/Form/Combo.pm
View file

@ -57,7 +57,7 @@ sub definition {
defaultValue=>undef
},
});
return $definition;
return $class->SUPER::definition($session, $definition);
}
#-------------------------------------------------------------------

33
lib/WebGUI/Group.pm
View file

@ -1091,12 +1091,19 @@ Membership will always be false if no IpFilter has been set
id of the user to check for membership
=head3 sessionId
id of the session to check for user data. If no sessionId is passed in, then the
group's session will be used to find one.
=cut
sub hasIpUser {
my $self = shift;
my $userId = shift;
my $session = $self->session;
my $userId = shift;
my $userSessionId = shift || $session->getId;
my $IpFilter = $self->ipFilter();
return 0 unless ($IpFilter && $userId);
@ -1104,9 +1111,9 @@ sub hasIpUser {
$IpFilter =~ s/\s//g;
my @filters = split /;/, $IpFilter;
my @ips = $session->db->buildArray(
q{ select lastIP from userSession where expires > ? and userId = ? }
,[ time(), $userId ]
my @ips = $session->db->buildArray(
q{ select lastIP from userSession where expires > ? and userId = ? and sessionId=?}
,[ time(), $userId, $userSessionId, ]
);
foreach my $ip (@ips) {
@ -1207,7 +1214,7 @@ sub hasLDAPUser {
#-------------------------------------------------------------------
=head2 hasScratchUser ( userId )
=head2 hasScratchUser ( userId, [ $sessionId ] )
Determine if the user passed in is a member of this group via session scratch
variable settings and this group's scratchFilter.
@ -1218,12 +1225,18 @@ If no scratchFilter has been set for this group, membership will always be false
id of the user to check for membership
=head3 sessionId
id of the session for the user being checked for membership. If no sessionId is passed in, then the
group's session will be used to find one.
=cut
sub hasScratchUser {
my $self = shift;
my $userId = shift;
my $session = $self->session;
my $userId = shift;
my $userSessionId = shift || $self->session;
my $scratchFilter = $self->scratchFilter();
return 0 unless ($scratchFilter && $userId);
@ -1232,7 +1245,7 @@ sub hasScratchUser {
my @filters = split /;/, $scratchFilter;
my @scratchClauses = ();
my @scratchPlaceholders = ( $userId, time() );
my @scratchPlaceholders = ( $userSessionId, $userId, time() );
foreach my $filter (@filters) {
my ($name, $value) = split /=/, $filter;
push @scratchClauses, "(s.name=? AND s.value=?)";
@ -1246,6 +1259,7 @@ sub hasScratchUser {
from
userSession u, userSessionScratch s
where
u.sessionId = ? AND
u.sessionId=s.sessionId AND
u.userId = ? AND
u.expires > ? AND
@ -1273,6 +1287,7 @@ sub hasUser {
my $self = shift;
my $session = $self->session;
my $user = shift || WebGUI::User->new($session,3); #Check the admin account if no user is passed in
my $uSessionId = $user->session->getId;
my $gid = $self->getId;
my $db = $session->db;
@ -1359,9 +1374,9 @@ sub hasUser {
my $groupToCheck = __PACKAGE__->new($session,$groupIdInGroup);
### Check the 'has' method for each of the 'other' group methods available for this user
### perform checks in a least -> most expensive manner. If we find the user, stow the cache and return true
if( $groupToCheck->hasIpUser($uid)
if( $groupToCheck->hasIpUser($uid, $uSessionId)
|| $groupToCheck->hasKarmaUser($uid)
|| $groupToCheck->hasScratchUser($uid)
|| $groupToCheck->hasScratchUser($uid, $uSessionId)
|| $groupToCheck->hasDatabaseUser($uid)
|| $groupToCheck->hasLDAPUser($uid)
) {

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

@ -336,7 +336,7 @@ sub getRequestedUrl {
=head2 getSiteURL ( )
Returns a constructed site url. The returned value can be overridden using the setSiteURL function.
Returns a constructed site url without the gateway. The returned value can be overridden using the setSiteURL function.
=cut

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

@ -758,17 +758,18 @@ sub updateFromForm {
$item->update({shippingAddressId => $itemAddressId});
}
}
if ($self->hasMixedItems) {
my $i18n = WebGUI::International->new($self->session, "Shop");
$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();
}
##Remove the items BEFORE we check to see if there are duplicates.
if ($self->hasMixedItems) {
my $i18n = WebGUI::International->new($self->session, "Shop");
$error{id $self} = $i18n->get('mixed items warning');
}
##Visitor cannot have an address book, or set a payment gateway, so skip the rest of this.
return 1 if $session->user->isVisitor;
@ -1023,6 +1024,10 @@ sub www_view {
return $session->style->userStyle($template->process(\%var));
}
if ($self->hasMixedItems) {
$error{id $self} = $i18n->get('mixed items warning');
}
my %var = (
%{$self->get},
formHeader => WebGUI::Form::formHeader($session, { extras => q|id="wgCartId"|, })
@ -1046,7 +1051,6 @@ sub www_view {
shippableItemsInCart => $self->requiresShipping,
);
# get the shipping address
my $address = eval { $self->getShippingAddress };
if (my $e = WebGUI::Error->caught("WebGUI::Error::ObjectNotFound") && $self->get('shippingAddressId')) {

18
lib/WebGUI/URL/Content.pm
View file

@ -64,12 +64,30 @@ to the user, instead of displaying the Page Not Found page.
sub handler {
my ($request, $server, $config) = @_;
$request->push_handlers(PerlResponseHandler => sub {
my $request = shift;
$request = Apache2::Request->new($request);
my $session = $request->pnotes('wgSession');
WEBGUI_FATAL: {
unless (defined $session) {
$session = WebGUI::Session->open($server->dir_config('WebguiRoot'), $config->getFilename, $request, $server);
return Apache2::Const::OK if ! defined $session;
}
# if there's no session cookie but there is HTTP auth, try to log in using that
my $auth = $request->headers_in->{'Authorization'};
if( $session->user->isVisitor and $auth ) {
if( $auth =~ m/^Basic/ ) {
$auth =~ s/Basic //;
WebGUI::authen($request, split(":", MIME::Base64::decode_base64($auth), 2), $session);
}
else { # realm oriented
$request->push_handlers(PerlAuthenHandler => sub { return WebGUI::authen($request, undef, undef, $session)});
}
}
WebGUI::Asset::Template->processVariableHeaders($session);
foreach my $handler (@{$config->get("contentHandlers")}) {
my $output = eval { WebGUI::Pluggable::run($handler, "handler", [ $session ] )};

24
lib/WebGUI/User.pm
View file

@ -954,21 +954,17 @@ sub isInGroup {
### Check stow before we check the cache. Stow is in memory and much faster
my $stow = $session->stow->get("isInGroup", { noclone => 1 }) || {};
return $stow->{$uid}->{$gid} if (exists $stow->{$uid}->{$gid});
### Don't bother checking File Cache if we already have a stow for this group.
### We can find what we need there and save ourselves a bunch of time
my $cache = undef;
my $groupMembers = undef;
unless ($stow->{$uid}->{$gid}) {
$cache = WebGUI::Cache->new($session,["groupMembers",$gid]);
$groupMembers = $cache->get || {};
#If we have this user's membership cached, return what we have stored
if (exists $groupMembers->{$uid}) {
return $groupMembers->{$uid}->{isMember} if (!$self->isVisitor);
return $groupMembers->{$uid}->{$session->getId}->{isMember} #Include the session check for visitors
}
}
my $cache = WebGUI::Cache->new($session,["groupMembers",$gid]);
my $groupMembers = $cache->get || {};
#If we have this user's membership cached, return what we have stored
if (exists $groupMembers->{$uid}) {
return $groupMembers->{$uid}->{isMember} if (!$self->isVisitor);
return $groupMembers->{$uid}->{$session->getId}->{isMember} if exists $groupMembers->{$uid}->{$session->getId}; #Include the session check for visitors
}
### Instantiate the group
my $group = WebGUI::Group->new($session,$gid);
if ( !$group ) {
@ -978,7 +974,7 @@ sub isInGroup {
#Check the group for membership
my $isInGroup = $group->hasUser($self);
#Write what we found to file cache
$group->cacheGroupings( $self, $isInGroup, $cache, $groupMembers );
return $isInGroup;

86
lib/WebGUI/Workflow/Activity/BucketPassiveAnalytics.pm
View file

@ -51,6 +51,20 @@ sub definition {
return $class->SUPER::definition($session,$definition);
}
#-------------------------------------------------------------------
=head2 get_statement( session, counter )
Return a statement handle at the desired offset.
=cut
sub get_statement {
my ($session, $logIndex) = @_;
my $deltaSql = q{select SQL_CALC_FOUND_ROWS userId, assetId, url, delta, from_unixtime(timeStamp) as stamp from deltaLog order by timestamp limit ?, 500000};
my $sth = $session->db->read($deltaSql, [$logIndex+0]);
return $sth;
}
#-------------------------------------------------------------------
@ -85,47 +99,49 @@ sub execute {
my %bucketCache = ();
##Configure all the SQL
my $deltaSql = <<"EOSQL1";
select userId, assetId, url, delta, from_unixtime(timeStamp) as stamp
from deltaLog order by timestamp limit $logIndex, 1234567890
EOSQL1
my $deltaSth = $session->db->read($deltaSql);
my $bucketSth = $session->db->prepare('insert into bucketLog (userId, Bucket, duration, timeStamp) VALUES (?,?,?,?)');
my $deltaSth = get_statement($session, $logIndex);
my $total_rows = $session->db->quickScalar('select found_rows()');
my $bucketSth = $session->db->prepare('insert into bucketLog (userId, Bucket, duration, timeStamp) VALUES (?,?,?,?)');
##Walk through the log file entries, one by one. Run each entry against
##all the rules until 1 matches. If it doesn't match any rule, then bin it
##into the "Other" bucket.
DELTA_ENTRY: while (my $entry = $deltaSth->hashRef()) {
++$logIndex;
my $bucketFound = 0;
my $url = $entry->{url};
if (exists $bucketCache{$url}) {
$bucketSth->execute([$entry->{userId}, $bucketCache{$url}, $entry->{delta}, $entry->{stamp}]);
}
else {
RULE: foreach my $rule (@rules) {
next RULE unless $url =~ $rule->[1];
# Into the bucket she goes..
$bucketCache{$url} = $rule->[0];
$bucketSth->execute([$entry->{userId}, $rule->[0], $entry->{delta}, $entry->{stamp}]);
$bucketFound = 1;
last RULE;
DELTA_CHUNK: while (1) {
DELTA_ENTRY: while (my $entry = $deltaSth->hashRef()) {
++$logIndex;
my $bucketFound = 0;
my $url = $entry->{url};
if (exists $bucketCache{$url}) {
$bucketSth->execute([$entry->{userId}, $bucketCache{$url}, $entry->{delta}, $entry->{stamp}]);
}
if (!$bucketFound) {
$bucketCache{$url} = 'Other';
$bucketSth->execute([$entry->{userId}, 'Other', $entry->{delta}, $entry->{stamp}]);
}
}
if (time() > $endTime) {
$expired = 1;
last DELTA_ENTRY;
}
}
else {
RULE: foreach my $rule (@rules) {
next RULE unless $url =~ $rule->[1];
if ($expired) {
$instance->setScratch('logIndex', $logIndex);
return $self->WAITING(1);
# Into the bucket she goes..
$bucketCache{$url} = $rule->[0];
$bucketSth->execute([$entry->{userId}, $rule->[0], $entry->{delta}, $entry->{stamp}]);
$bucketFound = 1;
last RULE;
}
if (!$bucketFound) {
$bucketCache{$url} = 'Other';
$bucketSth->execute([$entry->{userId}, 'Other', $entry->{delta}, $entry->{stamp}]);
}
}
if (time() > $endTime) {
$expired = 1;
last DELTA_ENTRY;
}
}
if ($expired) {
$instance->setScratch('logIndex', $logIndex);
return $self->WAITING(1);
}
last DELTA_CHUNK if $logIndex >= $total_rows;
$deltaSth = get_statement($session, $logIndex);
}
my $message = 'Passive analytics is done.';
if ($session->setting->get('passiveAnalyticsDeleteDelta')) {

8
lib/WebGUI/Workflow/Activity/ExtendCalendarRecurrences.pm
View file

@ -194,7 +194,13 @@ sub processRecurrence {
$event->generateRecurrence($d);
}
$versionTag->commit;
##If nothing needed to happen, then don't keep the tag around.
if ($versionTag->getAssetCount > 0) {
$versionTag->commit;
}
else {
$versionTag->rollback;
}
return $time_limit ? 1 : 0;
} ## end sub processRecurrence

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

@ -101,7 +101,7 @@ sub execute {
if ($versionTag->getAssetCount) {
# if there's only one asset in the tag, we might as well give them a direct link to it
my $asset = $versionTag->getAssets->[0];
$urlOfSingleAsset = "\n\n".$self->session->url->getSiteURL().$asset->getUrl("func=view;revision=".$asset->get("revisionDate"));
$urlOfSingleAsset = $self->session->url->getSiteURL().$asset->getUrl("func=view;revision=".$asset->get("revisionDate"));
}
my $var = {
message => $self->get('message'),

79
lib/WebGUI/Workflow/Activity/SummarizePassiveAnalytics.pm
View file

@ -49,6 +49,20 @@ sub definition {
return $class->SUPER::definition($session,$definition);
}
#-------------------------------------------------------------------
=head2 get_statement( session, counter )
Return a statement handle at the desired offset.
=cut
sub get_statement {
my ($session, $counter) = @_;
my $passive = q{select SQL_CALC_FOUND_ROWS * from passiveLog where userId <> '1' order by userId, sessionId, timeStamp limit ?, 500000};
my $sth = $session->db->read($passive, [$counter+0]);
return $sth;
}
#-------------------------------------------------------------------
@ -72,17 +86,14 @@ sub execute {
my $endTime = time() + $self->getTTL;
my $deltaInterval = $self->get('deltaInterval');
my $passive = q{select * from passiveLog where userId <> '1' order by userId, sessionId, timeStamp};
my $sth;
my $lastUserId;
my $lastSessionId;
my $lastTimeStamp;
my $lastAssetId;
my $lastUrl;
my $counter = $instance->getScratch('counter');
my $sth = get_statement($session, $counter);
if ($counter) {
$passive .= ' limit '. $counter .', 1234567890';
$sth = $session->db->read($passive);
$lastUserId = $instance->getScratch('lastUserId');
$lastSessionId = $instance->getScratch('lastSessionId');
$lastTimeStamp = $instance->getScratch('lastTimeStamp');
@ -90,46 +101,52 @@ sub execute {
$lastUrl = $instance->getScratch('lastUrl');
}
else {
$sth = $session->db->read($passive);
my $logLine = $sth->hashRef();
$lastUserId = $logLine->{userId};
$lastSessionId = $logLine->{sessionId};
$lastTimeStamp = $logLine->{timeStamp};
$lastAssetId = $logLine->{assetId};
$lastUrl = $logLine->{url};
$session->db->write('delete from deltaLog'); ##Only if we're starting out
}
$session->db->write('delete from deltaLog'); ##Only if we're starting out
my $total_rows = $session->db->quickScalar('select found_rows()');
my $deltaLog = $session->db->prepare('insert into deltaLog (userId, assetId, delta, timeStamp, url) VALUES (?,?,?,?,?)');
my $expired = 0;
LOG_ENTRY: while (my $logLine = $sth->hashRef()) {
$counter++;
my $delta = $logLine->{timeStamp} - $lastTimeStamp;
if ( $logLine->{userId} eq $lastUserId
&& $logLine->{sessionId} eq $lastSessionId
&& $delta < $deltaInterval ) {
$deltaLog->execute([$lastUserId, $lastAssetId, $delta, $lastTimeStamp, $lastUrl]);
LOG_CHUNK: while (1) {
LOG_ENTRY: while (my $logLine = $sth->hashRef()) {
$counter++;
my $delta = $logLine->{timeStamp} - $lastTimeStamp;
if ( $logLine->{userId} eq $lastUserId
&& $logLine->{sessionId} eq $lastSessionId
&& $delta < $deltaInterval ) {
$deltaLog->execute([$lastUserId, $lastAssetId, $delta, $lastTimeStamp, $lastUrl]);
}
$lastUserId = $logLine->{userId};
$lastSessionId = $logLine->{sessionId};
$lastTimeStamp = $logLine->{timeStamp};
$lastAssetId = $logLine->{assetId};
$lastUrl = $logLine->{url};
if (time() > $endTime) {
$instance->setScratch('lastUserId', $lastUserId);
$instance->setScratch('lastSessionId', $lastSessionId);
$instance->setScratch('lastTimeStamp', $lastTimeStamp);
$instance->setScratch('lastAssetId', $lastAssetId);
$instance->setScratch('lastUrl', $lastUrl);
$instance->setScratch('counter', $counter);
$expired = 1;
last LOG_ENTRY;
}
}
$lastUserId = $logLine->{userId};
$lastSessionId = $logLine->{sessionId};
$lastTimeStamp = $logLine->{timeStamp};
$lastAssetId = $logLine->{assetId};
$lastUrl = $logLine->{url};
if (time() > $endTime) {
$instance->setScratch('lastUserId', $lastUserId);
$instance->setScratch('lastSessionId', $lastSessionId);
$instance->setScratch('lastTimeStamp', $lastTimeStamp);
$instance->setScratch('lastAssetId', $lastAssetId);
$instance->setScratch('lastUrl', $lastUrl);
$instance->setScratch('counter', $counter);
$expired = 1;
last LOG_ENTRY;
$sth->finish;
if ($expired) {
return $self->WAITING(1);
}
}
if ($expired) {
return $self->WAITING(1);
last LOG_CHUNK if $counter >= $total_rows;
$sth = get_statement($session, $counter);
}
$instance->deleteScratch('lastUserId');

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

@ -99,6 +99,12 @@ our $I18N = {
lastUpdated => 1230844137,
},
'Return to Account' => {
message => q{Return to Account},
context => q{label for templates that want to provide a link back to the main account page},
lastUpdated => 1230844137,
},
};
1;

3
sbin/testEnvironment.pl
View file

@ -107,6 +107,7 @@ checkModule("Template", 2.20, 2 );
checkModule("XML::FeedPP", 0.40 );
checkModule("XML::FeedPP::MediaRSS", 0.02 );
checkModule("JSON", 2.12 );
checkModule("JSON::PP", 0.00 );
checkModule("Config::JSON", "1.3.1" );
checkModule("Text::CSV_XS", "0.64" );
checkModule("Net::CIDR::Lite", 0.20 );
@ -145,7 +146,7 @@ checkModule("JavaScript::Minifier::XS", "0.05" );
checkModule("Readonly", "1.03" );
checkModule("Business::PayPal::API", "0.62" );
checkModule("Business::OnlinePayment", "3.01" );
checkModule("Business::OnlinePayment::AuthorizeNet", "3.21" );
checkModule("Business::OnlinePayment::AuthorizeNet", "3.22" );
checkModule("Locales", "0.10" );
checkModule("Test::Harness", "3.17" );
checkModule("DateTime::Event::ICal", "0.10" );

2
sbin/userImport.pl
View file

@ -374,7 +374,7 @@ user will be set to. It can be overridden in the import file for
specific users.
You can specify a unique expiration date for a group by adding it
after the group ID, seperated by a colon. The date/time should be in
after the group ID, separated by a colon. The date/time should be in
"YYYY-MM-DD HH:NN:SS" format.
groupId:2000-01-01 01:00:00,groupId2:2001-01-02 02:00:00

4
t/Asset/EMSSubmissionForm.t
View file

@ -432,10 +432,10 @@ my $expected = {
},
'description' => undef,
'_isValid' => 1,
'deleteCreatedItems' => undef,
'deleteCreatedItems' => 0,
'canSubmitGroupId' => '2',
'assetId' => 'new',
'url' => undef,
'url' => '',
'daysBeforeCleanup' => '7',
'title' => 'Untitled',
} ;

3
t/Asset/Post.t
View file

@ -175,9 +175,6 @@ $storage->addFileFromFilesystem(WebGUI::Test->getTestCollateralPath('lamp.jpg'))
$storage->addFileFromFilesystem(WebGUI::Test->getTestCollateralPath('littleTextFile'));
my $attachment_loop = $post1->getTemplateVars()->{attachment_loop};
use Data::Dumper;
diag Dumper($attachment_loop);
my @extensions = map { [ $_->{filename}, $_->{extension} ] } @{ $attachment_loop };
cmp_bag(

24
t/Asset/Wobject/Layout.t
View file

@ -16,8 +16,9 @@ use lib "$FindBin::Bin/../../lib";
use Test::MockTime qw/:all/; ##Must be loaded before all other code
use WebGUI::Test;
use WebGUI::Session;
use Test::More tests => 3; # increment this value for each test you create
use Test::More tests => 5; # increment this value for each test you create
use WebGUI::Asset::Wobject::Layout;
use WebGUI::Asset::Template;
my $session = WebGUI::Test->session;
@ -64,4 +65,25 @@ set_relative_time(-100);
$snip1 = $snip1->addRevision({ title => 'titular', }, 18);
is $page->getContentLastModifiedBy, $revised_user1->userId, '... check that a new revision tracks';
# inheriting mobileStyleTemplateId and mobileTemplateId; from ``Mobile template is not being inherited (#12246)''
my $importNode = WebGUI::Asset::Template->getImportNode($session);
my $template1 = $importNode->addChild({className=>"WebGUI::Asset::Template"});
my $template2 = $importNode->addChild({className=>"WebGUI::Asset::Template"});
WebGUI::Test->addToCleanup($template1, $template2);
my $mobileStyleTemplateId = $template1->getId;
my $mobileTemplateId = $template2->getId;
$page->update({ mobileStyleTemplateId => $mobileStyleTemplateId, mobileTemplateId => $mobileTemplateId });
my $url = $page->get('url') . '/layout_child_test';
my $html = WebGUI::Test->getPage($page, "www_add", {
userId => 3,
formParams => {
class => 'WebGUI::Asset::Wobject::Layout',
url => $page->get('url') . '/layout_child_test',
},
});
like $html, qr/name="mobileTemplateId" value="$mobileTemplateId"/, 'child PageLayout inherited parents mobileTempaleId';
like $html, qr/name="mobileStyleTemplateId" value="$mobileStyleTemplateId"/, 'child PageLayout inherited parents mobileStyleTempaleId';

8
t/Asset/Wobject/Thingy/indexing.t
View file

@ -75,12 +75,12 @@ is $session->db->quickScalar('select count(*) from assetIndex where assetId=?',[
my $record;
$record = $session->db->quickHashRef('select * from assetIndex where assetId=?',[$thingy->getId]);
$record = $session->db->quickHashRef('select * from assetIndex where assetId=? AND subId IS NOT NULL',[$thingy->getId]);
cmp_deeply(
$record,
superhashof({
subId => 'THING_RECORD',
url => $thingy->getUrl('func=search;thingId=THING_RECORD'),
url => $session->url->append($thingy->get('url'), 'func=search;thingId=THING_RECORD'),
title => 'Label',
groupIdView => 2,
keywords => all(
@ -165,7 +165,7 @@ cmp_deeply(
score => ignore(),
synopsis => ignore(),
title => 'Label', ##From the Thing's label
url => $thingy->getUrl('func=viewThingData;thingId='.$thingId.';thingDataId=THING_DATA'),
url => $session->url->append($thingy->get('url'), 'func=viewThingData;thingId='.$thingId.';thingDataId=THING_DATA'),
}
],
'Checking indexed data for the thingData'
@ -214,7 +214,7 @@ cmp_deeply(
score => ignore(),
synopsis => ignore(),
title => '8/16/2001', ##From viewScreenTitle, which is $birthday in user's preferred date format
url => $thingy->getUrl('func=viewThingData;thingId='.$thingId.';thingDataId=THING_DATA'),
url => $session->url->append($thingy->get('url'), 'func=viewThingData;thingId='.$thingId.';thingDataId=THING_DATA'),
}
],
'Checking indexed data for the thingData'

11
t/Auth/LDAP.t
View file

@ -22,6 +22,12 @@ use WebGUI::Session;
use Test::Deep;
use Scope::Guard;
#----------------------------------------------------------------------------
# Tests
#plan tests => 9; # Increment this number for each test you create
plan skip_all => 'Test server for LDAP down'; # Increment this number for each test you create
#----------------------------------------------------------------------------
# Init
my $session = WebGUI::Test->session;
@ -43,11 +49,6 @@ $ldapGroup->set( "ldapGroupProperty", "member" );
$ldapGroup->set( "ldapRecursiveProperty", "uid" );
addToCleanup($ldapGroup);
#----------------------------------------------------------------------------
# Tests
plan tests => 9; # Increment this number for each test you create
#----------------------------------------------------------------------------
# Test Login of existing user
my $user = WebGUI::User->create( $session );

14
t/Auth/mech.t
View file

@ -56,8 +56,13 @@ my ($mech, $redirect, $response, $url);
# Get the site's base URL
my $baseUrl = 'http://' . $session->config->get('sitename')->[0];
# $baseUrl .= ':8000'; # no easy way to automatically find this
$baseUrl .= $session->config->get('gateway');
my $httpAuthUrl = 'http://' . $USERNAME . ':' . $IDENTIFIER . '@' . $session->config->get('sitename')->[0];
# $httpAuthUrl .= ':8000'; # no easy way to automatically find this
$httpAuthUrl .= $session->config->get('gateway');
# Make an asset we can login on
my $asset
= $node->addChild({
@ -84,7 +89,7 @@ if ( !$mech->success ) {
plan skip_all => "Cannot load URL '$baseUrl'. Will not test.";
}
plan tests => 40; # Increment this number for each test you create
plan tests => 42; # Increment this number for each test you create
#----------------------------------------------------------------------------
# no form: Test logging in on a normal page sends the user back to the same page
@ -276,3 +281,10 @@ $mech->submit_form_ok(
);
$mech->base_is( $assetUrl, "We don't get redirected" );
#----------------------------------------------------------------------------
# HTTP basic auth
$mech = Test::WWW::Mechanize->new;
$mech->get( $httpAuthUrl );
$mech->content_contains( "Hello, $USERNAME", "We are greeted by name" );
$mech->get( $httpAuthUrl . $asset->get('url') );
$mech->content_contains( "ARTICLE", "We are shown the article" );

104
t/Group.t
View file

@ -74,26 +74,6 @@ my @ipTests = (
},
);
my @ldapTests = (
{
dn => 'uid=Byron Hadley,o=shawshank',
comment => 'bad dn for group',
expect => 0,
},
{
dn => 'uid=Andy Dufresne,o=shawshank',
comment => 'good dn for group',
expect => 1,
},
{
dn => 'uid=Bogs Diamond,o=shawshank',
comment => 'another good dn for group',
expect => 1,
},
);
plan tests => (173 + (scalar(@scratchTests) * 2) + scalar(@ipTests)); # increment this value for each test you create
my $session = WebGUI::Test->session;
my $testCache = WebGUI::Cache->new($session, 'myTestKey');
@ -180,61 +160,6 @@ my $getGroupsIn = $optionGroup->getGroupsIn();
cmp_deeply($getGroupsIn, [], 'new: noAdmin prevents the admin group from being added to this group');
$optionGroup->delete;
################################################################
#
# LDAP specific group properties
# These tests have to be done on an isolated group that will NEVER
# have getGroups called on it
#
################################################################
my $ldapProps = WebGUI::Test->getSmokeLDAPProps();
$session->db->setRow('ldapLink', 'ldapLinkId', $ldapProps, $ldapProps->{ldapLinkId});
my $ldap = WebGUI::LDAPLink->new($session, $ldapProps->{ldapLinkId});
is($ldap->getValue("ldapLinkId"),$ldapProps->{ldapLinkId},'ldap link created properly');
addToCleanup($ldap);
my @shawshank;
foreach my $idx (0..$#ldapTests) {
$shawshank[$idx] = WebGUI::User->new($session, "new");
$shawshank[$idx]->username("shawshank$idx");
$shawshank[$idx]->authMethod("LDAP");
my $auth = $shawshank[$idx]->authInstance;
$auth->saveParams($shawshank[$idx]->getId,$shawshank[$idx]->authMethod,{
connectDN => $ldapTests[$idx]->{dn},
ldapConnection => $ldap->getValue("ldapLinkId"),
ldapUrl => $ldap->getValue("ldapUrl"),
});
}
WebGUI::Test->addToCleanup(@shawshank);
my $lGroup = WebGUI::Group->new($session, 'new');
$lGroup->ldapGroup('cn=Convicts,o=shawshank');
is($lGroup->ldapGroup(), 'cn=Convicts,o=shawshank', 'ldapGroup set and fetched correctly');
$lGroup->ldapGroupProperty('member');
is($lGroup->ldapGroupProperty(), 'member', 'ldapGroup set and fetched correctly');
$lGroup->ldapLinkId($ldapProps->{ldapLinkId});
is($lGroup->ldapLinkId(),$ldapProps->{ldapLinkId}, 'ldapLinkId set and fetched correctly');
is_deeply(
[ (map { $lGroup->hasLDAPUser($_->getId) } @shawshank) ],
[0, 1, 1],
'shawshank user 2, and 3 found in lGroup users from LDAP'
);
$lGroup->ldapRecursiveProperty('LDAP recursive property');
is($lGroup->ldapRecursiveProperty(), 'LDAP recursive property', 'ldapRecursiveProperty set and fetched correctly');
$lGroup->ldapRecursiveFilter('LDAP recursive filter');
is($lGroup->ldapRecursiveFilter(), 'LDAP recursive filter', 'ldapRecursiveFilter set and fetched correctly');
$lGroup->delete;
my $gid = $g->getId;
is (length($gid), 22, "GroupId is proper length");
@ -640,15 +565,17 @@ WebGUI::Test->addToCleanup(@sessionBank);
#isInGroup test
foreach my $scratchTest (@scratchTests) {
is($scratchTest->{user}->isInGroup($gS->getId), $scratchTest->{expect}, $scratchTest->{comment});
is($scratchTest->{user}->isInGroup($gS->getId), $scratchTest->{expect}, $scratchTest->{comment});
}
WebGUI::Cache->new($session, $gS->getId)->delete(); ##Delete cached key for testing
$session->stow->delete("isInGroup");
#hasScratchUser test
foreach my $scratchTest (@scratchTests) {
is($gS->hasScratchUser($scratchTest->{user}->getId), $scratchTest->{expect}, $scratchTest->{comment}." - hasScratchUser");
foreach my $idx (0..$#scratchTests) {
my $scratchTest = $scratchTests[$idx];
my $sessionId = $sessionBank[$idx]->getId;
is($gS->hasScratchUser($scratchTest->{user}->getId, $sessionId), $scratchTest->{expect}, $scratchTest->{comment}." - hasScratchUser");
}
@ -666,7 +593,7 @@ cmp_bag(
{ ##Add scope to force cleanup
note "Checking for user Visitor session leak";
note "Checking for user Visitor session leak with scratch";
my $remoteSession = WebGUI::Test->newSession;
$remoteSession->user({userId => 1});
@ -681,13 +608,13 @@ cmp_bag(
my $localSession = WebGUI::Test->newSession;
WebGUI::Test->addToCleanup($localScratchGroup, $remoteSession, $localSession);
$localSession->user({userId => 1});
$remoteSession->scratch->set('local','ok');
$localSession->scratch->set('local','ok');
$localScratchGroup->clearCaches;
ok $localSession->user->isInGroup($localScratchGroup->getId), 'Local Visitor is in the scratch group';
$remoteSession->stow->delete('isInGroup');
ok !$remoteSession->user->isInGroup($localScratchGroup->getId), 'Remove Visitor is not in the scratch group, even though a different Visitor passed';
ok !$remoteSession->user->isInGroup($localScratchGroup->getId), 'Remote Visitor is not in the scratch group, even though a different Visitor passed';
}
@ -709,8 +636,9 @@ foreach my $idx (0..$#ipTests) {
##Name this user for convenience
$tcps[$idx]->username("tcp$idx");
##Assign this user to this test to be fetched later
$ipTests[$idx]->{user} = $tcps[$idx];
##Assign this user and session to this test to be fetched later
$ipTests[$idx]->{user} = $tcps[$idx];
$ipTests[$idx]->{session} = $sessionBank[$idx];
}
WebGUI::Test->addToCleanup(@tcps);
WebGUI::Test->addToCleanup(@sessionBank);
@ -733,7 +661,7 @@ cmp_bag(
);
is_deeply(
[ (map { $gI->hasIpUser($_->{user}->getId) } @ipTests) ],
[ (map { $gI->hasIpUser($_->{user}->getId, $_->{session}->getId) } @ipTests) ],
[ (map { $_->{expect} } @ipTests) ],
'hasIpUsers for group with IP filter'
);
@ -744,7 +672,7 @@ foreach my $ipTest (@ipTests) {
{ ##Add scope to force cleanup
note "Checking for user Visitor session leak";
note "Checking for user Visitor session leak via IP address";
$ENV{REMOTE_ADDR} = '191.168.1.1';
my $remoteSession = WebGUI::Test->newSession;
@ -765,7 +693,8 @@ foreach my $ipTest (@ipTests) {
ok $localSession->user->isInGroup($localIpGroup->getId), 'Local Visitor is in the group';
$remoteSession->stow->delete('isInGroup');
ok !$remoteSession->user->isInGroup($localIpGroup->getId), 'Remove Visitor is not in the group, even though a different Visitor passed';
$localIpGroup->clearCaches;
ok !$remoteSession->user->isInGroup($localIpGroup->getId), 'Remote Visitor is not in the group, even though a different Visitor passed';
}
@ -840,7 +769,7 @@ ok(! WebGUI::Group->vitalGroup('27'), '... 27 is not vital');
# Normal group
my $happyDude = WebGUI::User->create( $session );
$happyDude->username(" Happy Dude ");
addToCleanup( $happyDude );
WebGUI::Test->addToCleanup( $happyDude );
$gA->addUsers([ $happyDude->getId ]);
$gB->addUsers([ $happyDude->getId ]);
@ -866,5 +795,6 @@ ok(
"registered users: don't get the users in both groups",
);
done_testing;
#vim:ft=perl

46
t/Group/group_scratch.t
View file

@ -20,27 +20,49 @@ use WebGUI::Group;
#----------------------------------------------------------------------------
# Init
my $session = WebGUI::Test->session;
my $session1 = WebGUI::Test->session;
my $session2 = WebGUI::Session->open(WebGUI::Test::root, WebGUI::Test::file);
#----------------------------------------------------------------------------
# Tests
### Updates by DRT test that group membership is restricted by user session
### ...specifically for Visitors to have separate scratch group memberships
plan tests => 5; # Increment this number for each test you create
plan tests => 14; # Increment this number for each test you create
my $group = WebGUI::Group->new($session, 'new');
my $group = WebGUI::Group->new($session1, 'new');
WebGUI::Test->addToCleanup($group);
$group->scratchFilter("itchy=test_value");
is( $group->scratchFilter(), "itchy=test_value",'Group->scratchFilter is properly set and retrieved');
$group->groupCacheTimeout(0);
is( $group->groupCacheTimeout(), 0, 'set groupCacheTimeout to 0');
$session->user({userId => 1});
ok( !$session->user->isInGroup($group->getId), 'Visitor is NOT in the group BEFORE scratch value is set');
$session->scratch->set('itchy', 'test_value');
is ($group->hasScratchUser($session->user->getId), 1, 'Group->hasScratchUser correctly returns 1 immediately after scratch is set');
$session1->user({userId => 1});
$session2->user({userId => 1});
##Simulate another page view by clearing stow, which is volatile
$session->stow->deleteAll;
$session->scratch->delete('itchy');
is ($group->hasScratchUser($session->user->getId), 0, 'after clearing scratch, user is not in the group any longer');
### Test group membership before scratch is set
### NOTE: test hasScratchUser first, because isInGroup sets stow & cache
is ($group->hasScratchUser($session1->user->getId,$session1->user->session->getId), 0, 'Group->hasScratchUser correctly returns 0 for Visitor 1 before scratch is set');
is ($group->hasScratchUser($session2->user->getId,$session2->user->session->getId), 0, 'Group->hasScratchUser correctly returns 0 for Visitor 2 before scratch is set');
ok( !$session1->user->isInGroup($group->getId), 'user1->isInGroup correctly returns 0 before scratch is set');
ok( !$session2->user->isInGroup($group->getId), 'user2->isInGroup correctly returns 0 before scratch is set');
### Test group membership after scratch is set
### Clear stow, which is volatile, to simulate new page view
$session1->stow->deleteAll;
$session2->stow->deleteAll;
$session1->scratch->set('itchy', 'test_value');
is ($group->hasScratchUser($session1->user->getId,$session1->user->session->getId), 1, 'Group->hasScratchUser correctly returns 1 for Visitor 1 after scratch for Visitor 1 is set');
is ($group->hasScratchUser($session2->user->getId,$session2->user->session->getId), 0, 'Group->hasScratchUser correctly returns 0 for Visitor 2 after scratch for Visitor 1 is set');
ok( $session1->user->isInGroup($group->getId), 'user1->isInGroup correctly returns 1 after scratch for Visitor 1 is set');
ok( !$session2->user->isInGroup($group->getId), 'user2->isInGroup correctly returns 0 after scratch for Visitor 1 is set');
### Test group membership after scratch is deleted
### Clear stow, which is volatile, to simulate new page view
$session1->stow->deleteAll;
$session2->stow->deleteAll;
$session1->scratch->delete('itchy');
is ($group->hasScratchUser($session1->user->getId,$session1->user->session->getId), 0, 'Group->hasScratchUser for Visitor 1 correctly returns 0 after clearing scratch for Visitor 1');
is ($group->hasScratchUser($session2->user->getId,$session2->user->session->getId), 0, 'Group->hasScratchUser for Visitor 2 correctly returns 0 after clearing scratch for Visitor 1');
ok( !$session1->user->isInGroup($group->getId), 'user1->isInGroup correctly returns 0 after scratch for Visitor 1 is deleted');
ok( !$session2->user->isInGroup($group->getId), 'user2->isInGroup correctly returns 0 after scratch for Visitor 1 is deleted');

101
t/Group/ldap_groups.t Normal file
View file

@ -0,0 +1,101 @@
#-------------------------------------------------------------------
# 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 FindBin;
use strict;
use lib "$FindBin::Bin/../lib";
use WebGUI::Test;
use WebGUI::Session;
use WebGUI::Utility;
use WebGUI::User;
use WebGUI::Group;
use WebGUI::Cache;
use Test::More skip_all => 'Disabled until the test LDAP server is rejuvenated';
use Test::Deep;
my @ldapTests = (
{
dn => 'uid=Byron Hadley,o=shawshank',
comment => 'bad dn for group',
expect => 0,
},
{
dn => 'uid=Andy Dufresne,o=shawshank',
comment => 'good dn for group',
expect => 1,
},
{
dn => 'uid=Bogs Diamond,o=shawshank',
comment => 'another good dn for group',
expect => 1,
},
);
################################################################
#
# LDAP specific group properties
# These tests have to be done on an isolated group that will NEVER
# have getGroups called on it
#
################################################################
my $ldapProps = WebGUI::Test->getSmokeLDAPProps();
$session->db->setRow('ldapLink', 'ldapLinkId', $ldapProps, $ldapProps->{ldapLinkId});
my $ldap = WebGUI::LDAPLink->new($session, $ldapProps->{ldapLinkId});
is($ldap->getValue("ldapLinkId"),$ldapProps->{ldapLinkId},'ldap link created properly');
WebGUI::Test->addToCleanup($ldap);
my @shawshank;
foreach my $idx (0..$#ldapTests) {
$shawshank[$idx] = WebGUI::User->new($session, "new");
$shawshank[$idx]->username("shawshank$idx");
$shawshank[$idx]->authMethod("LDAP");
my $auth = $shawshank[$idx]->authInstance;
$auth->saveParams($shawshank[$idx]->getId,$shawshank[$idx]->authMethod,{
connectDN => $ldapTests[$idx]->{dn},
ldapConnection => $ldap->getValue("ldapLinkId"),
ldapUrl => $ldap->getValue("ldapUrl"),
});
}
WebGUI::Test->addToCleanup(@shawshank);
my $lGroup = WebGUI::Group->new($session, 'new');
$lGroup->ldapGroup('cn=Convicts,o=shawshank');
is($lGroup->ldapGroup(), 'cn=Convicts,o=shawshank', 'ldapGroup set and fetched correctly');
$lGroup->ldapGroupProperty('member');
is($lGroup->ldapGroupProperty(), 'member', 'ldapGroup set and fetched correctly');
$lGroup->ldapLinkId($ldapProps->{ldapLinkId});
is($lGroup->ldapLinkId(),$ldapProps->{ldapLinkId}, 'ldapLinkId set and fetched correctly');
is_deeply(
[ (map { $lGroup->hasLDAPUser($_->getId) } @shawshank) ],
[0, 1, 1],
'shawshank user 2, and 3 found in lGroup users from LDAP'
);
$lGroup->ldapRecursiveProperty('LDAP recursive property');
is($lGroup->ldapRecursiveProperty(), 'LDAP recursive property', 'ldapRecursiveProperty set and fetched correctly');
$lGroup->ldapRecursiveFilter('LDAP recursive filter');
is($lGroup->ldapRecursiveFilter(), 'LDAP recursive filter', 'ldapRecursiveFilter set and fetched correctly');
$lGroup->delete;
done_testing;

6
t/LDAPLink.t
View file

@ -52,7 +52,8 @@ plan tests => 9; # Increment this number for each test you create
#
###########################################################################
{
SKIP: {
skip "Test LDAP server is down", 3;
my $ldapProps = WebGUI::Test->getSmokeLDAPProps();
$session->db->setRow('ldapLink', 'ldapLinkId', $ldapProps, $ldapProps->{ldapLinkId});
my $ldap = WebGUI::LDAPLink->new($session, $ldapProps->{ldapLinkId});
@ -70,7 +71,8 @@ plan tests => 9; # Increment this number for each test you create
#
###########################################################################
{
SKIP: {
skip "Test LDAP server is down", 4;
my $ldapProps = WebGUI::Test->getSmokeLDAPProps();
$ldapProps->{identifier} = 'hadley';
$session->db->setRow('ldapLink', 'ldapLinkId', $ldapProps, $ldapProps->{ldapLinkId});

1
t/SQL.t
View file

@ -225,6 +225,7 @@ SKIP: {
}
$session->db->dbh->do('DROP TABLE IF EXISTS testTable');
$session->db->dbh->do('CREATE TABLE testTable (myIndex int(8) NOT NULL default 0, message CHAR(64), myKey varchar(32), PRIMARY KEY(myIndex))');
my @tableData = (

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

@ -18,6 +18,8 @@ my $session = WebGUI::Test->session;
$session->user({userId => 3});
WebGUI::Test->addToCleanup(SQL => 'delete from passiveLog');
WebGUI::Test->addToCleanup(SQL => 'delete from deltaLog');
WebGUI::Test->addToCleanup(SQL => 'delete from bucketLog');
WebGUI::Test->addToCleanup(SQL => 'delete from analyticRule');
my $workflow = WebGUI::Workflow->new($session, 'PassiveAnalytics000001');

2
t/Workflow/Activity/WaitForUserConfirmation.t
View file

@ -14,6 +14,8 @@ use Kwargs;
use URI;
my $session = WebGUI::Test->session;
WebGUI::Test->originalConfig('templateParsers');
$session->config->addToArray('templateParsers', 'WebGUI::Asset::Template::TemplateToolkit');
my $act = WebGUI::Workflow::Activity->newByPropertyHashRef(
$session, {

2
t/lib/WebGUI/PseudoRequest.pm
View file

@ -87,7 +87,7 @@ sub body {
return keys %{ $self->{body} } if wantarray;
return { %{ $self->{body} } };
}
if ($self->{body}->{$value}) {
if (defined $self->{body}->{$value}) {
if (wantarray && ref $self->{body}->{$value} eq "ARRAY") {
return @{$self->{body}->{$value}};
}

58
t/templateAttachments.t Normal file
View file

@ -0,0 +1,58 @@
#-------------------------------------------------------------------
# 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 FindBin;
use strict;
use warnings;
use lib "$FindBin::Bin/lib"; ##t/lib
use WebGUI::Test;
use WebGUI::Session;
use Data::Dumper;
use WebGUI::Asset;
use WebGUI::Asset::Template;
use WebGUI::Macro;
#The goal of this test is to find template attachments that do not resolve.
use Test::More; # increment this value for each test you create
my $numTests = 0;
my $session = WebGUI::Test->session;
# put your tests here
$numTests = $session->db->quickScalar('select count(distinct(assetId)) from template');
my $getATemplate = WebGUI::Asset::Template->getIsa($session);
WebGUI::Test->originalConfig('extrasURL');
$session->config->set('extrasURL', '');
TEMPLATE: while (my $templateAsset = $getATemplate->()) {
my $bad_attachments = 0;
foreach my $attachment (@{ $templateAsset->getAttachments }) {
my $url = $attachment->{url};
WebGUI::Macro::process($session, \$url);
my $url_exists = 0;
if ($attachment->{url} =~ /\^Extras/) {
##File system path for /extras, adjust the URL for that.
$url = $session->config->get('extrasPath') . $url;
$url_exists = -e $url;
}
else {
my $asset = eval { WebGUI::Asset->newByUrl($session, $url) };
$url_exists = defined $asset;
}
ok $url_exists, sprintf "%s: %s (%s) has a bad attachment url: %s", $templateAsset->getTitle, $templateAsset->getId, $templateAsset->getUrl, $attachment->{url};
}
}
done_testing;

BIN
www/uploads/5c/d2/5cd2d045be1d0967e47276fd6c2d3242/thumb-top-left.jpg → www/uploads/38/93/389319e91b251464dc3ccf559de5c691/thumb-top-left.jpg
View file

Binary file not shown.
Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 31 KiB

After

Width:  |  Height:  |  Size: 31 KiB

Before After
Before After

0
www/uploads/5c/d2/5cd2d045be1d0967e47276fd6c2d3242/top-left.jpg → www/uploads/38/93/389319e91b251464dc3ccf559de5c691/top-left.jpg
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 31 KiB

After

Width:  |  Height:  |  Size: 31 KiB

Before After
Before After

0
www/uploads/08/52/0852d6c3186fd9a9e52eab8fd8d1ad77/input_bg.jpg → www/uploads/3c/e1/3ce1c9490aa981a19c9228f47be0eeda/input_bg.jpg
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 29 KiB

After

Width:  |  Height:  |  Size: 29 KiB

Before After
Before After

BIN
www/uploads/08/52/0852d6c3186fd9a9e52eab8fd8d1ad77/thumb-input_bg.jpg → www/uploads/3c/e1/3ce1c9490aa981a19c9228f47be0eeda/thumb-input_bg.jpg
View file

Binary file not shown.
Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 28 KiB

After

Width:  |  Height:  |  Size: 28 KiB

Before After
Before After

BIN
www/uploads/37/c8/37c8ed37c9f44558525c0fd5c648d3e1/thumb-top-right.jpg → www/uploads/48/d9/48d94a1f46e6369767982bde8e4ff194/thumb-top-right.jpg
View file

Binary file not shown.
Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 31 KiB

After

Width:  |  Height:  |  Size: 31 KiB

Before After
Before After

0
www/uploads/37/c8/37c8ed37c9f44558525c0fd5c648d3e1/top-right.jpg → www/uploads/48/d9/48d94a1f46e6369767982bde8e4ff194/top-right.jpg
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 31 KiB

After

Width:  |  Height:  |  Size: 31 KiB

Before After
Before After

0
www/uploads/c3/43/c343e82e0cddb9ac924d05ec41d45f75/bottom-right.jpg → www/uploads/56/6a/566a9ad05defc721d369ccf5a230b8f5/bottom-right.jpg
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 31 KiB

After

Width:  |  Height:  |  Size: 31 KiB

Before After
Before After

BIN
www/uploads/c3/43/c343e82e0cddb9ac924d05ec41d45f75/thumb-bottom-right.jpg → www/uploads/56/6a/566a9ad05defc721d369ccf5a230b8f5/thumb-bottom-right.jpg
View file

Binary file not shown.
Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 31 KiB

After

Width:  |  Height:  |  Size: 31 KiB

Before After
Before After

0
www/uploads/b3/0b/b30b065dfd4de937335e8bb7cd5db1cf/bottom-left.jpg → www/uploads/7a/37/7a37d34156e8e11a579f3926cbc2ab12/bottom-left.jpg
View file

Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 31 KiB

After

Width:  |  Height:  |  Size: 31 KiB

Before After
Before After

BIN
www/uploads/b3/0b/b30b065dfd4de937335e8bb7cd5db1cf/thumb-bottom-left.jpg → www/uploads/7a/37/7a37d34156e8e11a579f3926cbc2ab12/thumb-bottom-left.jpg
View file

Binary file not shown.
Side by side Swipe Overlay

Before

Width:  |  Height:  |  Size: 31 KiB

After

Width:  |  Height:  |  Size: 31 KiB

Before After
Before After