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

Merge branch 'WebGUI8' into psgi

Browse source
This commit is contained in:
Graham Knop 2010-05-10 17:03:17 -05:00
commit 65dfb6e683
36 changed files with 378 additions and 741 deletions
Download patch file Download diff file Expand all files Collapse all files

145
t/Cache.t
View file

@ -1,145 +0,0 @@
# 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
#------------------------------------------------------------------
# Write a little about what this script tests.
#
#
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;
use WebGUI::Cache;
#----------------------------------------------------------------------------
# Init
my $session = WebGUI::Test->session;
#----------------------------------------------------------------------------
# Tests
plan tests => 11; # Increment this number for each test you create
#----------------------------------------------------------------------------
my $cache = WebGUI::Cache->new($session, 1);
isa_ok($cache, 'WebGUI::Cache');
is($cache->parseKey("andy"), $session->config->getFilename.":andy", "parseKey single key");
is($cache->parseKey(["andy","red"]), $session->config->getFilename.":andy:red", "parseKey composite key");
$cache->set("Shawshank","Prison");
is($cache->get("Shawshank"), "Prison", "set/get");
$cache->set(["andy", "dufresne"], "Prisoner");
is($cache->get(["andy", "dufresne"]), "Prisoner", "set/get composite");
my ($a, $b) = @{$cache->mget(["Shawshank",["andy", "dufresne"]])};
is($a, "Prison", "mget first value");
is($b, "Prisoner", "mget second value");
$cache->delete("Shawshank");
is(eval{$cache->get("Shawshank")}, undef, 'delete');
$cache->flush;
is(eval{$cache->get(["andy", "dufresne"])}, undef, 'flush');
$cache->setByHttp("http://www.google.com/");
cmp_ok($cache->get("http://www.google.com/"), 'ne', '', 'setByHttp');
my $longValue ='abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
abcdefghijklmnopqrstuvwxyz 0123456789 !@#$%^&*(
';
$cache->set("really-long-value",$longValue);
is($cache->get("really-long-value"), $longValue, "set/get really long value");
#----------------------------------------------------------------------------
# Cleanup
END {
}
#vim:ft=perl

79
t/Cache/Database.t
View file

@ -1,79 +0,0 @@
# 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
#------------------------------------------------------------------
# Write a little about what this script tests.
#
#
use FindBin;
use strict;
use lib "$FindBin::Bin/../lib";
use Storable qw(freeze thaw);
use Test::More;
use Time::HiRes;
use WebGUI::Test; # Must use this before any other WebGUI modules
use WebGUI::Session;
use WebGUI::Cache::Database;
#----------------------------------------------------------------------------
# Init
my $session = WebGUI::Test->session;
# presupposes that there are cached items to test
my $cacheEntries = $session->db->buildArrayRefOfHashRefs("select expires,cachekey,namespace,content from cache order by rand() limit 100");
#----------------------------------------------------------------------------
# Tests
plan tests => 2 + scalar(@{$cacheEntries}); # Increment this number for each test you create
#----------------------------------------------------------------------------
# put your tests here
my $cache = WebGUI::Cache::Database->new($session, "this", "that");
my $testValue = "a rock that has no earthly business in that field";
$cache->set($testValue);
is($cache->get, $testValue, "set/get works");
$cache->delete;
is($cache->get, undef, "delete works");
# performance tests
my $numTests = 0;
my $totalTime = 0;
foreach my $entry (@{$cacheEntries}) {
my $start = [Time::HiRes::gettimeofday];
my $cache = WebGUI::Cache::Database->new($session, $entry->{cachekey}, $entry->{namespace});
$cache->{_key} = $entry->{cachekey}; # evil: don't do this at home kids
my $value = $cache->get;
if ($entry->{expires} > time()) {
my $entryValue = $entry->{content};
eval { $entryValue = thaw($entryValue); };
$entryValue = ($entryValue && ref $entryValue) ? $$entryValue : undef;
is_deeply($value, $entryValue, "cache entry is valid");
}
else {
is($value, undef, "cache entry has timed out");
}
$numTests++;
$totalTime += Time::HiRes::tv_interval($start);
}
print "\nTime to run $numTests cache tests is $totalTime seconds. Average time per test is ".($totalTime/$numTests)." seconds.\n" if ($numTests > 0);
# end performance tests
#----------------------------------------------------------------------------
# Cleanup
END {
}

115
t/Cache/FileCache.t
View file

@ -1,115 +0,0 @@
# 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
#------------------------------------------------------------------
# Write a little about what this script tests.
#
#
use FindBin;
use strict;
use lib "$FindBin::Bin/../lib";
use Test::More;
use Test::Deep;
use Path::Class;
use File::Path;
use File::Basename qw(basename);
use WebGUI::Test; # Must use this before any other WebGUI modules
use WebGUI::Session;
use WebGUI::Cache;
#----------------------------------------------------------------------------
# Init
my $session = WebGUI::Test->session;
#----------------------------------------------------------------------------
# Tests
my $tests = 14;
plan tests => 1 + $tests;
#----------------------------------------------------------------------------
# put your tests here
my $origCacheType = $session->config->get('cacheType');
$session->config->set('cacheType', 'WebGUI::Cache::FileCache');
my $origCacheRoot = $session->config->get('fileCacheRoot');
$session->config->delete('fileCacheRoot');
my $loaded = use_ok('WebGUI::Cache::FileCache');
SKIP: {
skip 'Unable to load module WebGUI::Cache::FileCache', $tests unless $loaded;
my $cacher = WebGUI::Cache->new($session, 'ReservedForTests');
isa_ok($cacher, 'WebGUI::Cache::FileCache', 'WebGUI::Cache creates the correct object type');
isa_ok($cacher->session, 'WebGUI::Session', 'session method returns a session object');
cmp_deeply(
$cacher,
noclass({
_session => ignore(),
_namespace => basename(WebGUI::Test->file),
_key => re('[a-zA-Z0-9+\-]{22}'),
}),
'New FileCache object has correct defaults',
);
$cacher = WebGUI::Cache->new($session, 'ReservedForTests', 'ReservedForTests');
cmp_deeply(
$cacher,
noclass({
_session => ignore(),
_namespace => 'ReservedForTests',
_key => re('[a-zA-Z0-9+\-]{22}'),
}),
'Second fileCache object was recreated with custom namespace',
);
my $root = '/tmp'; ##Default for Unix testing. Need to extend this for Windows someday...
my $namespace = Path::Class::Dir->new($root, qw/WebGUICache ReservedForTests/);
is($cacher->getNamespaceRoot, $namespace->stringify, 'getNamespaceRoot returns the correct path');
ok(! -e $cacher->getNamespaceRoot, 'The namespace does not exist in the filesystem');
my $folder = $namespace->subdir($cacher->{_key});
is($cacher->getFolder, $folder->stringify, 'getFolder returns the correct path, which is the namespace with a key subdirectory');
ok(! -e $cacher->getFolder, 'The folder does not exist in the filesystem');
$cacher->set('Some value');
ok( -e $namespace->stringify, 'setting data into the cache creates the namespace dir');
ok( -e $folder->stringify, 'setting data into the cache creates the folder dir');
ok( -e $folder->file('expires')->stringify, 'expiry file was created');
ok( -e $folder->file('cache')->stringify, 'cache file was created');
$cacher->delete();
ok(! -e $cacher->getFolder, 'delete removes the cache folder');
$cacher->flush();
ok(! -e $cacher->getNamespaceRoot, 'purge removes the namespace folder');
undef $cacher;
}
#----------------------------------------------------------------------------
# Cleanup
END {
$session->config->set('cacheType', $origCacheType);
if ($origCacheRoot) {
$session->config->get('fileCacheRoot', $origCacheRoot);
}
}

11
t/Help/compiled.t
View file

@ -14,6 +14,7 @@ use lib "$FindBin::Bin/../lib";
use WebGUI::Test;
use WebGUI::Session;
use WebGUI::Pluggable;
use WebGUI::Operation::Help;
#The goal of this test is to verify that all entries in the lib/WebGUI/Help
@ -26,14 +27,14 @@ my $numTests = 0;
my $session = WebGUI::Test->session;
my @helpFileSet = WebGUI::Operation::Help::_getHelpFilesList($session);
my @helpFileSet = WebGUI::Pluggable::findAndLoad('WebGUI::Help');
$numTests = scalar @helpFileSet; #One for each help compile
plan tests => $numTests;
foreach my $helpSet (@helpFileSet) {
my $helpName = $helpSet->[1];
my $help = WebGUI::Operation::Help::_load($session, $helpName);
ok(keys %{ $help }, "$helpName compiled");
foreach my $helpFile (@helpFileSet) {
my ($namespace) = $helpFile =~ m{WebGUI::Help::(.+$)};
my $help = WebGUI::Operation::Help::_load($session, $namespace);
ok(keys %{ $help }, "$namespace compiled");
}

4
t/ProfileField.t
View file

@ -33,7 +33,7 @@ WebGUI::Test->usersToDelete($newUser);
#----------------------------------------------------------------------------
# Tests
plan tests => 48; # Increment this number for each test you create
plan tests => 50; # Increment this number for each test you create
#----------------------------------------------------------------------------
# Test the creation of ProfileField
@ -91,6 +91,8 @@ my $newProfileField = WebGUI::ProfileField->create($session, 'testField', {
});
is($newProfileField->get('fieldType'), 'Float', 'create: makes field with correct type');
is $newProfileField->get('fieldName'), 'testField', '...correct fieldName';
is $newProfileField->getId, 'testField', '...correct id';
is($newProfileField->get('label'), 'Test Field', 'correct label');
is($newProfileField->getLabel, 'Test Field', 'getLabel works, too');

4
t/SQL.t
View file

@ -17,7 +17,7 @@ use WebGUI::Session;
use Data::Dumper;
use Test::Deep;
use Test::More tests => 56; # increment this value for each test you create
use Test::More tests => 57; # increment this value for each test you create
my $session = WebGUI::Test->session;
@ -145,6 +145,8 @@ my $setRowId = $session->db->setRow("incrementer","incrementerId",{incrementerId
ok($setRowId ne "", "setRow() - return ID");
my ($setRowResult) = $session->db->quickArray("select nextValue from incrementer where incrementerId=".$session->db->quote($setRowId));
is($setRowResult, 47, "setRow() - set data");
is $session->db->setRow("incrementer", "incrementerId",{incrementerId=>'new', nextValue => 48}, 'oogeyBoogeyBoo'),
'oogeyBoogeyBoo', 'overriding default id with a custom one';
# getRow
my $getRow = $session->db->getRow("incrementer","incrementerId",$setRowId);

13
t/Session/Style.t
View file

@ -328,14 +328,14 @@ TODO: {
####################################################
#
# process
# no duped headBlockContent
# no duped extraHeadTagsContent
#
####################################################
$style->useEmptyStyle(1);
$style->sent(0);
$session->scratch->set('personalStyleId', $templates->{headBlock}->getId);
$session->scratch->set('personalStyleId', $templates->{extraHeadTags}->getId);
$styled = $style->process('body.content', 'notATemplateId');
@ -369,7 +369,8 @@ $expectedMetas = [
'content' => 'must-revalidate'
},
];
cmp_bag(\@metas, $expectedMetas, 'process, headBlock:no duped headBlock from style template');
cmp_bag(\@metas, $expectedMetas, 'process, extraHeadTags:no duped extraHeadTags from style template');
####################################################
#
# process
@ -480,16 +481,16 @@ sub setup_assets {
};
$templates->{personal} = $importNode->addChild($properties, $properties->{id});
$properties = {
title => 'personal style test template with headBlock',
title => 'personal style test template with extraHeadTags',
className => 'WebGUI::Asset::Template',
url => 'headblock_style',
namespace => 'Style',
template => 'HEADBLOCK STYLE TEMPLATE\n\nBODY=<tmpl_var body.content>\n\nHEAD=<tmpl_var head.tags>',
headBlock => q|<meta name="keywords" content="keyword1,keyword2" />|,
extraHeadTags => q|<meta name="keywords" content="keyword1,keyword2" />|,
id => 'testTemplate_headblock',
# '1234567890123456789012'
};
$templates->{headBlock} = $importNode->addChild($properties, $properties->{id});
$templates->{extraHeadTags} = $importNode->addChild($properties, $properties->{id});
$properties = {
title => 'personal style test template for printing',
className => 'WebGUI::Asset::Template',

6
t/Session/Url.t
View file

@ -417,21 +417,21 @@ my $statefulAsset = WebGUI::Asset->getRoot($session)->addChild({ className => 'W
$versionTag->commit;
$session->asset( $statefulAsset );
$statefulAsset->{_properties}{state} = 'published';
$statefulAsset->state('published');
is(
$session->url->getBackToSiteURL,
WebGUI::Asset->getRoot($session)->getUrl,
q!getBackToSiteURL: When asset state is published, it returns you to the Assets container!
);
$statefulAsset->{_properties}{state} = 'trash';
$statefulAsset->state( 'trash');
is(
$session->url->getBackToSiteURL,
$defaultAssetUrl,
q!getBackToSiteURL: When asset state is trash, it returns you to the default Asset!
);
$statefulAsset->{_properties}{state} = 'clipboard';
$statefulAsset->state('clipboard');
is(
$session->url->getBackToSiteURL,
$defaultAssetUrl,

10
t/Session/Var.t
View file

@ -138,13 +138,13 @@ $session->db->write("update userSession set expires=? where sessionId=?",
my %copyOfVar2 = %{$var2->{_var}};
$copyOfVar2{expires} = $var2->get('lastPageView')-1;
$copyOfVar2{userId} = 3;
$session->cache->set(['session',$var2->getId], \%copyOfVar2);
$session->cache->set($var2->getId, \%copyOfVar2);
my $var3 = WebGUI::Session::Var->new($session, $var2->getId);
is($var3->getId, $var2->getId, 'new Var object has correct id');
isnt($var3->isAdminOn, $var2->isAdminOn, 'new adminOn not equal to old adminOn');
is($var3->isAdminOn, 0, 'new Var object has default adminOn');
isnt($var3->get('userId'), 3, 'new userId not equal to old userId');
is $var3->getId, $var2->getId, 'new Var object has correct id';
isnt $var3->isAdminOn, $var2->isAdminOn, 'new adminOn not equal to old adminOn';
is $var3->isAdminOn, 0, 'new Var object has default adminOn';
isnt $var3->get('userId'), 3, 'new userId not equal to old userId';
$var2->end;
$var3->end;

4
t/Storage.t
View file

@ -289,7 +289,7 @@ ok (!(-e $storage1->getPath("testfile-hash.file")), "rename file original file i
####################################################
$storage1->addFileFromFilesystem(
WebGUI::Test->getTestCollateralPath('WebGUI.pm'),
WebGUI::Test->getTestCollateralPath('International/lib/WebGUI/i18n/PigLatin/WebGUI.pm'),
);
ok(
@ -473,7 +473,7 @@ is($formStore->addFileFromFormPost('files'), undef, 'addFileFromFormPost returns
$session->request->uploadFiles(
'oneFile',
[ WebGUI::Test->getTestCollateralPath('WebGUI.pm') ],
[ WebGUI::Test->getTestCollateralPath('International/lib/WebGUI/i18n/PigLatin/WebGUI.pm') ],
);
is($formStore->addFileFromFormPost('oneFile'), 'WebGUI.pm', '... returns the name of the uploaded file');
cmp_bag($formStore->getFiles, [ qw/WebGUI.pm/ ], '... adds the file to the storage location');

6
t/User.t
View file

@ -15,7 +15,6 @@ use lib "$FindBin::Bin/lib";
use WebGUI::Test;
use WebGUI::Session;
use WebGUI::Utility;
use WebGUI::Cache;
#use Exception::Class;
use WebGUI::User;
@ -28,8 +27,7 @@ use Data::Dumper;
my $session = WebGUI::Test->session;
my $testCache = WebGUI::Cache->new($session, 'myTestKey');
$testCache->flush;
$session->cache->remove('myTestKey');
my $user;
my $lastUpdate;
@ -1063,6 +1061,6 @@ END {
$newProfileField->delete() if $newProfileField;
$testCache->flush;
$session->cache->remove('myTestKey');
}

4
t/VersionTag.t
View file

@ -236,7 +236,7 @@ is($siteWideTag->getId(), $siteWideTagId, 'versionTagMode siteWide: reclaim site
## Through in a new session as different user
my $admin_session = WebGUI::Session->open($WebGUI::Test->file);
my $admin_session = WebGUI::Session->open(WebGUI::Test->file);
$admin_session->user({'userId' => 3});
WebGUI::Test->sessionsToDelete($admin_session);
@ -301,7 +301,7 @@ $adminUserTag->rollback();
is($tag->getAssetCount, 1, qq{$test_prefix [singlePerUser] tag with 1 asset});
# create admin session
my $admin_session = WebGUI::Session->open($WebGUI::Test->file);
my $admin_session = WebGUI::Session->open(WebGUI::Test->file);
addToCleanup($session);
$admin_session->user({'userId' => 3});

12
t/i18n/help.t
View file

@ -16,7 +16,7 @@ use lib "$FindBin::Bin/../lib"; ##t/lib
use WebGUI::Test;
use WebGUI::Operation::Help;
use WebGUI::International;
use WebGUI::Session;
use WebGUI::Pluggable;
use Data::Dumper;
#The goal of this test is to verify all the i18n labels in
@ -28,14 +28,14 @@ my $numTests = 0;
my $session = WebGUI::Test->session;
my @helpFileSet = WebGUI::Operation::Help::_getHelpFilesList($session);
my @helpFileSet = WebGUI::Pluggable::findAndLoad('WebGUI::Help');
my %helpTable;
foreach my $helpSet (@helpFileSet) {
my $helpName = $helpSet->[1];
my $help = WebGUI::Operation::Help::_load($session, $helpName);
$helpTable{ $helpName } = $help;
foreach my $helpFile (@helpFileSet) {
my ($namespace) = $helpFile =~ m{WebGUI::Help::(.+$)};
my $help = WebGUI::Operation::Help::_load($session, $namespace);
$helpTable{ $namespace } = $help;
}
##Scan #1, find all labels in the help system. body, title, @fields

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

@ -74,7 +74,7 @@ Usage:
# Reset the session back
$session->{_request} = $old_session;
=cut
sub get_request

66
t/lib/WebGUI/Test.pm
View file

@ -57,8 +57,6 @@ our @EXPORT_OK = qw(session config collateral);
my $CLASS = __PACKAGE__;
my @guarded;
sub import {
our $CONFIG_FILE = $ENV{ WEBGUI_CONFIG };
@ -80,7 +78,7 @@ sub _initSession {
my $session = our $SESSION = $CLASS->newSession(1);
my $originalSetting = clone $session->setting->get;
push @guarded, Scope::Guard->new(sub {
$CLASS->addToCleanup(sub {
while (my ($param, $value) = each %{ $originalSetting }) {
$session->setting->set($param, $value);
}
@ -110,7 +108,7 @@ sub _initSession {
my ($label, $table) = @checkCount[$i, $i+1];
$initCounts{$table} = $session->db->quickScalar('SELECT COUNT(*) FROM ' . $table);
}
push @guarded, Scope::Guard->new(sub {
$CLASS->addToCleanup(sub {
for ( my $i = 0; $i < @checkCount; $i += 2) {
my ($label, $table) = @checkCount[$i, $i+1];
my $quant = $session->db->quickScalar('SELECT COUNT(*) FROM ' . $table);
@ -127,19 +125,6 @@ END {
$CLASS->cleanup;
}
sub cleanup {
# remove guards in reverse order they were added, triggering all of the
# requested cleanup operations
pop @guarded
while @guarded;
if ( our $SESSION ) {
$SESSION->var->end;
$SESSION->close;
undef $SESSION;
}
}
#----------------------------------------------------------------------------
=head2 newSession ( $noCleanup )
@ -159,7 +144,7 @@ sub newSession {
my $session = WebGUI::Session->open( $CLASS->config );
$session->{_request} = $pseudoRequest;
if ( ! $noCleanup ) {
$CLASS->sessionsToDelete($session);
$CLASS->addToCleanup($session);
}
return $session;
}
@ -444,7 +429,7 @@ Returns the full path to the WebGUI lib directory, usually /data/WebGUI/lib.
=cut
our $WEBGUI_LIB = File::Spec->catdir( $WEBGUI_TEST_ROOT, File::Spec->updir );
our $WEBGUI_LIB = File::Spec->catdir( $WEBGUI_TEST_ROOT, File::Spec->updir, 'lib' );
sub lib {
return our $WEBGUI_LIB;
@ -543,7 +528,7 @@ sub prepareMailServer {
# Let it start up yo
sleep 2;
push @guarded, Scope::Guard->new(sub {
$CLASS->addToCleanup(sub {
# Close SMTPD
if ($smtpdPid) {
kill INT => $smtpdPid;
@ -576,7 +561,7 @@ sub originalConfig {
}
# add cleanup handler if this is the first time we were run
if (! keys %originalConfig) {
push @guarded, Scope::Guard->new(sub {
$class->addToCleanup(sub {
while (my ($key, $value) = each %originalConfig) {
if (defined $value) {
$CLASS->session->config->set($key, $value);
@ -592,7 +577,7 @@ sub originalConfig {
#----------------------------------------------------------------------------
=head2 getMail ( )
=head2 getMail ( )
Read a sent mail from the prepared mail server (L<prepareMailServer>)
@ -600,7 +585,7 @@ Read a sent mail from the prepared mail server (L<prepareMailServer>)
sub getMail {
my $json;
if ( !$smtpdSelect ) {
return from_json ' { "error": "mail server not prepared" }';
}
@ -611,11 +596,11 @@ sub getMail {
else {
$json = ' { "error": "mail not sent" } ';
}
if (!$json) {
$json = ' { "error": "error in getting mail" } ';
}
return from_json( $json );
}
@ -635,7 +620,7 @@ sub getMailFromQueue {
if ( !$smtpdSelect ) {
$class->prepareMailServer;
}
my $messageId = $CLASS->session->db->quickScalar( "SELECT messageId FROM mailQueue" );
warn $messageId;
return unless $messageId;
@ -646,6 +631,7 @@ sub getMailFromQueue {
return $class->getMail;
}
#----------------------------------------------------------------------------
=head2 sessionsToDelete ( $session, [$session, ...] )
@ -660,7 +646,7 @@ This is a class method.
sub sessionsToDelete {
my $class = shift;
push @guarded, cleanupGuard(@_);
$class->addToCleanup(@_);
}
#----------------------------------------------------------------------------
@ -677,7 +663,7 @@ This is a class method.
sub assetsToPurge {
my $class = shift;
push @guarded, cleanupGuard(@_);
$class->addToCleanup(@_);
}
#----------------------------------------------------------------------------
@ -693,7 +679,7 @@ This is a class method.
sub groupsToDelete {
my $class = shift;
push @guarded, cleanupGuard(@_);
$class->addToCleanup(@_);
}
@ -710,7 +696,7 @@ This is a class method.
sub storagesToDelete {
my $class = shift;
push @guarded, cleanupGuard(map {
$class->addToCleanup(map {
ref $_ ? $_ : ('WebGUI::Storage' => $_)
} @_);
}
@ -727,7 +713,7 @@ This is a class method.
sub tagsToRollback {
my $class = shift;
push @guarded, cleanupGuard(@_);
$class->addToCleanup(@_);
}
#----------------------------------------------------------------------------
@ -743,7 +729,7 @@ This is a class method.
sub usersToDelete {
my $class = shift;
push @guarded, cleanupGuard(@_);
$class->addToCleanup(@_);
}
#----------------------------------------------------------------------------
@ -759,7 +745,7 @@ This is a class method.
sub workflowsToDelete {
my $class = shift;
push @guarded, cleanupGuard(@_);
$class->addToCleanup(@_);
}
@ -973,12 +959,26 @@ This is a class method.
=cut
my @guarded;
sub addToCleanup {
shift
if eval { $_[0]->isa($CLASS) };
push @guarded, cleanupGuard(@_);
}
sub cleanup {
# remove guards in reverse order they were added, triggering all of the
# requested cleanup operations
pop @guarded
while @guarded;
if ( our $SESSION ) {
$SESSION->var->end;
$SESSION->close;
undef $SESSION;
}
}
#----------------------------------------------------------------------------
=head1 BUGS

20
t/lib/WebGUI/Test/Activity.pm
View file

@ -3,16 +3,16 @@ package WebGUI::Test::Activity;
use WebGUI::Workflow;
use WebGUI::Test;
=head Name
=head1 Name
package WebGUI::Test::Activity;
=head Description
=head1 Description
This package encapsulates the code required to run
an activity.
=head Usage
=head1 Usage
use WebGUI::Test::Activity;
@ -27,17 +27,21 @@ is( $instance->run, 'complete', 'activity complete' );
is( $instance->run, 'done', 'activity done' );
$instance->delete;
=head methods
=head1 methods
=head2 create
=params
=head3 session
session -- the session variable
the session variable
class -- the class for the activity to run
=head3 class
params -- params to set in the workflow
the class for the activity to run
=head3 params
params to set in the workflow
=cut

1
t/lib/WebGUI/TestException.pm
View file

@ -26,6 +26,7 @@ functions _quiet_caller and _try_as_caller are directly copied from Test::Except
hocuspocus is being in that module however, since doing 'eval { uplevel 1, $codeRef }' seems to work too. On my
platform at least =). For the time being, I leave those subs in here so that they may be used. They are commented
out by default, though.
=cut
#----------------------------------------------------------------------------

2
t/mandatory_template_vars.t
View file

@ -165,7 +165,7 @@ plan tests => $numTests;
foreach my $tmpl ( @tmplVarTable ) {
my $tmplId = $tmpl->{id};
my $tmplAsset = WebGUI::Asset->newByDynamicClass($session, $tmplId);
my $tmplAsset = eval { WebGUI::Asset->newById($session, $tmplId); };
my $tmplExists = is(ref($tmplAsset), 'WebGUI::Asset::Template', "$tmplId exists");
SKIP: {
skip("$tmplId could not be found", $tmpl->{numTests} ) unless $tmplExists;

3
t/tests/My/Test/Class.pm
View file

@ -32,7 +32,8 @@ sub _00_init : Test(startup => 1) {
my $session = WebGUI::Test->session;
$test->session($session);
my $class = ref $test;
$class =~ s/Test:://;
$class =~ s/^Test:://;
return ('Not a WebGUI class') unless $class =~ /^WebGUI/;
$test->class($class);
lives_ok { WebGUI::Asset->loadModule($class); } "loaded module class $class";
}