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

Merge commit '4969f31e1f' into WebGUI8

Browse source
This commit is contained in:
Colin Kuskie 2010-06-26 14:37:31 -07:00
commit e5b82bc861
61 changed files with 2199 additions and 521 deletions
Download patch file Download diff file Expand all files Collapse all files

3
t/Asset/Asset.t
View file

@ -35,7 +35,7 @@ my $session = WebGUI::Test->session;
my @getTitleTests = getTitleTests($session);
plan tests => 120
plan tests => 121
+ 2*scalar(@getTitleTests) #same tests used for getTitle and getMenuTitle
;
@ -300,6 +300,7 @@ $session->setting->set('urlExtension', undef);
is($importNode->fixUrl('1234'.'_'x235 . 'abcdefghij'), '1234'.'_'x235 . 'abcdefghij', 'fixUrl leaves long URLs under 250 characters alone');
is($importNode->fixUrl('1234'.'_'x250 . 'abcdefghij'), '1234'.'_'x216, 'fixUrl truncates long URLs over 250 characters to 220 characters');
is $importNode->fixUrl('---'), '-', '... 3 dashes are collapsed down to a single dash';
$session->config->set('extrasURL', '/extras');
$session->config->set('uploadsURL', '/uploads');

71
t/Asset/AssetClipboard.t
View file

@ -22,7 +22,7 @@ use WebGUI::Asset;
use WebGUI::VersionTag;
use Test::More; # increment this value for each test you create
plan tests => 12;
plan tests => 27;
my $session = WebGUI::Test->session;
$session->user({userId => 3});
@ -95,9 +95,66 @@ WebGUI::Test->addToCleanup($newVersionTag);
####################################################
note "cut";
is($topFolder->cut, 1, 'returns 1 if successful' );
is($topFolder->state, 'clipboard', '... state set to trash on the trashed asset object');
is($topFolder->cloneFromDb->state, 'clipboard', '... state set to trash in db on object');
is($folder1a->cloneFromDb->state, 'clipboard-limbo', '... state set to clipboard-limbo on child #1');
is($folder1b->cloneFromDb->state, 'clipboard-limbo', '... state set to clipboard-limbo on child #2');
is($folder1a2->cloneFromDb->state, 'clipboard-limbo', '... state set to clipboard-limbo on grandchild #1-1');
is( $topFolder->cut, 1, 'cut: returns 1 if successful' );
is($topFolder->get('state'), 'clipboard', '... state set to trash on the trashed asset object');
is($topFolder->cloneFromDb->get('state'), 'clipboard', '... state set to trash in db on object');
is($folder1a->cloneFromDb->get('state'), 'clipboard-limbo', '... state set to clipboard-limbo on child #1');
is($folder1b->cloneFromDb->get('state'), 'clipboard-limbo', '... state set to clipboard-limbo on child #2');
is($folder1a2->cloneFromDb->get('state'), 'clipboard-limbo', '... state set to clipboard-limbo on grandchild #1-1');
sub is_tree_of_folders {
my ($asset, $depth, $pfx) = @_;
my $recursive; $recursive = sub {
my ($asset, $depth) = @_;
my $pfx = " $pfx $depth";
return 0 unless isa_ok($asset, 'WebGUI::Asset::Wobject::Folder',
"$pfx: this object");
my $children = $asset->getLineage(
['children'], {
statesToInclude => ['clipboard', 'clipboard-limbo' ],
returnObjects => 1,
}
);
return $depth < 2
? is(@$children, 0, "$pfx: leaf childless")
: is(@$children, 1, "$pfx: has child")
&& $recursive->($children->[0], $depth - 1);
};
my $pass = $recursive->($asset, $depth);
undef $recursive;
my $message = "$pfx is tree of folders";
return $pass ? pass $message : fail $message;
}
# test www_copy
my $tag = WebGUI::VersionTag->create($session);
$tag->setWorking;
WebGUI::Test->addToCleanup($tag);
my $tempspace = WebGUI::Asset->getTempspace($session);
my $folder = {className => 'WebGUI::Asset::Wobject::Folder'};
my $root = $tempspace->addChild($folder);
my $child = $root->addChild($folder);
my $grandchild = $child->addChild($folder);
sub copied {
for my $a (@{$tempspace->getAssetsInClipboard}) {
if ($a->getParent->getId eq $tempspace->getId) {
return $a;
}
}
return undef;
}
my @methods = qw(Single Children Descendants);
for my $i (0..2) {
my $meth = "_wwwCopy$methods[$i]";
$root->$meth();
my $clip = copied();
is_tree_of_folders($clip, $i+1, $meth);
$clip->purge;
}

120
t/Asset/Wobject/GalleryAlbum/addArchive.t
View file

@ -25,7 +25,10 @@ use Test::Deep;
my $session = WebGUI::Test->session;
my $node = WebGUI::Asset->getImportNode($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"Album Test"});
$versionTag->set({name=>"Add Archive to Album Test"});
addToCleanup($versionTag);
my $gallery
= $node->addChild({
className => "WebGUI::Asset::Wobject::Gallery",
@ -35,6 +38,7 @@ my $gallery
groupIdEdit => 3, # Admins
ownerUserId => 3, # Admin
});
my $album
= $gallery->addChild({
className => "WebGUI::Asset::Wobject::GalleryAlbum",
@ -46,48 +50,128 @@ my $album
skipAutoCommitWorkflows => 1,
});
$album->addArchive( WebGUI::Test->getTestCollateralPath('elephant_images.zip') );
# Properties applied to every photo in the archive
my $properties = {
keywords => "something",
location => "somewhere",
friendsOnly => "1",
};
$versionTag->commit;
#----------------------------------------------------------------------------
# Tests
plan tests => 5;
plan tests => 11;
#----------------------------------------------------------------------------
# Test the addArchive sub
# elephant_images.zip contains three jpgs: Aana1.jpg, Aana2.jpg, Aana3.jpg
$versionTag = WebGUI::VersionTag->getWorking($session);
$album->addArchive( WebGUI::Test->getTestCollateralPath('elephant_images.zip'), $properties );
my $images = $album->getLineage(['descendants'], { returnObjects => 1 });
is( scalar @$images, 3, "addArchive() adds one asset per image" );
cmp_deeply(
cmp_bag(
[ map { $_->get("filename") } @$images ],
bag( "Aana1.jpg", "Aana2.jpg", "Aana3.jpg" ),
[ "Aana1.jpg", "Aana2.jpg", "Aana3.jpg" ],
"Names of files attached to Photo assets match filenames in archive"
);
cmp_deeply(
cmp_bag(
[ map { $_->get("title") } @$images ],
bag( "Aana1", "Aana2", "Aana3" ),
[ "Aana1", "Aana2", "Aana3" ],
"Titles of Photo assets match filenames in archive excluding extensions"
);
cmp_deeply(
cmp_bag(
[ map { $_->get("menuTitle") } @$images ],
bag( "Aana1", "Aana2", "Aana3" ),
[ "Aana1", "Aana2", "Aana3" ],
"Menu titles of Photo assets match filenames in archive excluding extensions"
);
cmp_deeply(
cmp_bag(
[ map { $_->get("url") } @$images ],
bag(
[
$session->url->urlize( $album->getUrl . "/Aana1" ),
$session->url->urlize( $album->getUrl . "/Aana2" ),
$session->url->urlize( $album->getUrl . "/Aana3" ),
),
],
"URLs of Photo assets match filenames in archive excluding extensions"
);
cmp_bag(
[ map { $_->get("keywords") } @$images ],
[ "something", "something", "something" ],
"Keywords of Photo assets match keywords in properties"
);
cmp_bag(
[ map { $_->get("location") } @$images ],
[ "somewhere", "somewhere", "somewhere" ],
"Location of Photo assets match keywords in properties"
);
cmp_bag(
[ map { $_->get("friendsOnly") } @$images ],
[ "1", "1", "1" ],
"Photo assets are viewable by friends only"
);
# Empty gallery album
$versionTag->rollback;
#----------------------------------------------------------------------------
# Test the sorting option of addArchive sub
# gallery_archive_sorting_test.zip contains four jpgs: photo1.jpg, photo2.jpg, photo3.jpg and photo4.jpg
# The following test covers sorting by date and name. Testing fileOrder is not possible, because
# it's machine dependent.
$versionTag = WebGUI::VersionTag->getWorking($session);
# Add photos sorted by file order (default)
$album->addArchive( WebGUI::Test->getTestCollateralPath('gallery_archive_sorting_test.zip'), $properties, 'fileOrder' );
# Get all children
my $images = $album->getLineage(['descendants'], { returnObjects => 1 });
# Check order
cmp_bag(
[ map { $_->get("filename") } @{ $images } ],
[ "photo1.jpg", "photo4.jpg", "photo3.jpg", "photo2.jpg", ],
"Photos sorted by file order (all files exist)"
);
# Empty gallery album
$versionTag->rollback;
$versionTag = WebGUI::VersionTag->getWorking($session);
# Add photos sorted by date
$album->addArchive( WebGUI::Test->getTestCollateralPath('gallery_archive_sorting_test.zip'), $properties, 'date' );
# Get all children
my $images = $album->getLineage(['descendants'], { returnObjects => 1 });
# Check order
cmp_deeply(
[ map { $_->get("filename") } @$images ],
[ "photo4.jpg", "photo1.jpg", "photo3.jpg", "photo2.jpg" ],
"Photos sorted by date"
);
# Empty gallery album
$versionTag->rollback;
$versionTag = WebGUI::VersionTag->getWorking($session);
# Add photos sorted by name
$album->addArchive( WebGUI::Test->getTestCollateralPath('gallery_archive_sorting_test.zip'), $properties, 'name' );
# Get all children
my $images = $album->getLineage(['descendants'], { returnObjects => 1 });
# Check order
cmp_deeply(
[ map { $_->get("filename") } @$images ],
[ "photo1.jpg", "photo2.jpg", "photo3.jpg", "photo4.jpg" ],
"Photos sorted by name"
);
# Empty gallery album
$versionTag->rollback;
#----------------------------------------------------------------------------
# Test the www_addArchive page
#----------------------------------------------------------------------------
# Cleanup
END {
$versionTag->rollback;
}

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

@ -247,7 +247,7 @@ $session->user({userId => 1});
cmp_deeply(
$templateVars,
{
canPostStories => 0,
canPostStories => bool(0),
mode => 'view',
addStoryUrl => '',
date_loop => [
@ -411,9 +411,6 @@ $archive->update({storiesPerPage => 25});
$templateVars = $archive->viewTemplateVariables('search');
is($templateVars->{mode}, 'search', 'viewTemplateVariables mode == search');
use Data::Dumper;
diag Dumper $templateVars->{date_loop};
cmp_bag(
$templateVars->{date_loop},
[

136
t/Asset/Wobject/SyndicatedContent.t
View file

@ -20,7 +20,7 @@ use Data::Dumper;
use WebGUI::Test;
use WebGUI::Session;
use Test::More tests => 22; # increment this value for each test you create
use Test::More tests => 27; # increment this value for each test you create
use Test::Deep;
use WebGUI::Asset::Wobject::SyndicatedContent;
use XML::FeedPP;
@ -113,7 +113,7 @@ ok($processed_template, "A response was received from processTemplate.");
#
####################################################################
##Construct a feed with no description, so the resulting template variables can
##Construct a feed with no description so the resulting template variables can
##be checked for an undef description
my $feed = XML::FeedPP->new(<<EOFEED);
<?xml version="1.0" encoding="UTF-8" ?>
@ -140,37 +140,82 @@ EOFEED
my $vars = $syndicated_content->getTemplateVariables($feed);
ok( defined $vars->{item_loop}->[0]->{description}, 'getTemplateVariables: description is not undefined');
##Construct a feed with a wrapped description, to check for paragraph handling.
$feed = XML::FeedPP->new(<<EOFEED);
<?xml version="1.0" encoding="UTF-8" ?>
<rss version="2.0">
<channel>
<title>The WebGUI buglist</title>
<link>/tbb</link>
<copyright /><pubDate>Mon, 12 Oct 2009 11:54:28 -0500</pubDate>
<description />
<item>
<title>Description with wrapped HTML paragraphs</title>
<link>http://www.webgui.org/use/bugs/tracker/11563</link>
<author>serif</author>
<epochDate>1254854387</epochDate>
<guid isPermaLink="true">http://www.webgui.org/use/bugs/tracker/11563</guid>
<pubDate>Mon, 14 May 2010 8:12:00 -0500</pubDate>
<description>
&lt;p&gt;In the attached feed, there is a hidden return line character from the
Rich Text editor in the first sentence of the description. When using a Syndicated Content
for the feed, the variable descriptionFirstParagraph variable cuts off at this return line
character, creating invalid markup.&lt;/p&gt;
&lt;p&gt;No more text is shown of the first paragraph beyond the bold characters of the first line.&lt;/p&gt;
&lt;p&gt;Third paragraph, for completeness.&lt;/p&gt;
</description>
</item>
</channel>
</rss>
EOFEED
$vars = $syndicated_content->getTemplateVariables($feed);
is $vars->{item_loop}->[0]->{descriptionFirstParagraph},
"<p>In the attached feed, there is a hidden return line character from the Rich Text editor in the first sentence of the description. When using a Syndicated Content for the feed, the variable descriptionFirstParagraph variable cuts off at this return line character, creating invalid markup.</p>",
'... first paragraph, when HTML is used';
is $vars->{item_loop}->[0]->{descriptionFirst2paragraphs},
"<p>In the attached feed, there is a hidden return line character from the Rich Text editor in the first sentence of the description. When using a Syndicated Content for the feed, the variable descriptionFirstParagraph variable cuts off at this return line character, creating invalid markup.</p><p>No more text is shown of the first paragraph beyond the bold characters of the first line.</p>",
'... first paragraph, when HTML is used';
####################################################################
#
# generateFeed, hasTerms
#
####################################################################
my $tbbUrl = 'http://www.plainblack.com/tbb.rss';
$syndicated_content->update({
rssUrl => $tbbUrl,
hasTerms => 'WebGUI',
});
sub withCachedFeed {
my ($url, $path, $block) = @_;
$syndicated_content->update({ rssUrl => $url });
open my $rssFile, '<', WebGUI::Test->getTestCollateralPath('tbb.rss')
or die "Unable to get RSS file";
my $rssContent = do { local $/; <$rssFile>; };
close $rssFile;
$session->cache->set($tbbUrl, $rssContent, 60);
open my $file, '<', WebGUI::Test->getTestCollateralPath($path)
or die "Unable to get RSS file: $path";
my $content = do { local $/; <$file> };
close $file;
my $filteredFeed = $syndicated_content->generateFeed();
$session->cache->set($url, $content, 60);
$block->();
$session->cache->remove($url);
}
cmp_deeply(
[ map { $_->title } $filteredFeed->get_item() ],
[
'Google Picasa Plugin for WebGUI Gallery',
'WebGUI Roadmap',
'WebGUI 8 Performance',
],
'generateFeed: filters items based on the terms being in title, or description'
);
sub titles_are {
my ($expected, $message) = @_;
my $feed = $syndicated_content->generateFeed;
my @got = map { $_->title } $feed->get_item;
cmp_deeply \@got, $expected, $message;
}
$session->cache->remove($tbbUrl);
$syndicated_content->update({ hasTerms => 'WebGUI' });
withCachedFeed 'http://www.plainblack.com/tbb.rss', 'tbb.rss', sub {
titles_are(
[
'Google Picasa Plugin for WebGUI Gallery',
'WebGUI Roadmap',
'WebGUI 8 Performance',
],
'generateFeed: filters items based on the terms being in title, or description'
);
};
####################################################################
#
@ -178,25 +223,46 @@ $session->cache->remove($tbbUrl);
#
####################################################################
##Feed with no links or pubDates.
my $oncpUrl = 'http://www.oncp.gob.ve/oncp.xml';
$syndicated_content->update({
rssUrl => $oncpUrl,
hasTerms => '',
maxHeadlines => 50,
});
open my $rssFile, '<', WebGUI::Test->getTestCollateralPath('oncp.xml')
or die "Unable to get RSS file: oncp.xml";
my $rssContent = do { local $/; <$rssFile>; };
close $rssFile;
$session->cache->set($oncpUrl, $rssContent, 60);
withCachedFeed 'http://www.oncp.gob.ve/oncp.xml', 'oncp.xml', sub {
my $oddFeed1 = $syndicated_content->generateFeed();
my $oddFeed1 = $syndicated_content->generateFeed();
my @oddItems = $oddFeed1->get_item();
is (@oddItems, 13, 'feed has items even without pubDates or links');
};
my @oddItems = $oddFeed1->get_item();
is (@oddItems, 13, 'feed has items even without pubDates or links');
####################################################################
#
# sorting
#
####################################################################
$session->cache->remove($oncpUrl);
withCachedFeed 'http://www.plainblack.com/tbb.rss', 'tbb_odd.rss', sub {
my @ascending = (
'I have arrived in Lisboa!',
'WebGUI 8 Performance',
'WebGUI Roadmap',
'Google Picasa Plugin for WebGUI Gallery',
);
my @descending = reverse @ascending;
my @feed = (
'WebGUI Roadmap',
'Google Picasa Plugin for WebGUI Gallery',
'I have arrived in Lisboa!',
'WebGUI 8 Performance',
);
$syndicated_content->update({ sortItems => 'pubDate_asc' });
titles_are \@ascending, 'ascending sort';
$syndicated_content->update({ sortItems => 'pubDate_des' });
titles_are \@descending, 'descending sort';
$syndicated_content->update({ sortItems => 'feed' });
titles_are \@feed, 'feed order';
};

174
t/Group.t
View file

@ -73,8 +73,26 @@ 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 => (151 + scalar(@scratchTests) + scalar(@ipTests)); # increment this value for each test you create
plan tests => (164 + (scalar(@scratchTests) * 2) + scalar(@ipTests)); # increment this value for each test you create
my $session = WebGUI::Test->session;
$session->cache->remove('myTestKey');
@ -165,16 +183,44 @@ $optionGroup->delete;
#
################################################################
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->usersToDelete(@shawshank);
my $lGroup = WebGUI::Group->new($session, 'new');
$lGroup->ldapGroup('LDAP group');
is($lGroup->ldapGroup(), 'LDAP group', 'ldapGroup set and fetched correctly');
$lGroup->ldapGroup('cn=Convicts,o=shawshank');
is($lGroup->ldapGroup(), 'cn=Convicts,o=shawshank', 'ldapGroup set and fetched correctly');
$lGroup->ldapGroupProperty('LDAP group property');
is($lGroup->ldapGroupProperty(), 'LDAP group property', 'ldapGroup set and fetched correctly');
$lGroup->ldapGroupProperty('member');
is($lGroup->ldapGroupProperty(), 'member', 'ldapGroup set and fetched correctly');
$lGroup->ldapLinkId('LDAP link id');
is($lGroup->ldapLinkId(), 'LDAP link id', 'ldapLinkId 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');
@ -240,6 +286,7 @@ cmp_bag($gB->getGroupsIn(), [$gA->getId, 3], 'Group A is in Group B');
cmp_bag($gA->getGroupsFor(), [$gB->getId], 'Group B contains Group A');
cmp_bag($gA->getGroupsIn(), [3], 'Admin added to group A automatically');
diag $gA->getId;
$gA->addGroups([$gB->getId]);
cmp_bag($gA->getGroupsIn(), [3], 'Not allowed to create recursive group loops');
@ -414,7 +461,7 @@ cmp_ok($expirationDate-time(), '>', 50, 'checking expire offset override on addU
################################################################
#
# getDatabaseUsers
# getDatabaseUsers & hasDatabaseUsers
#
################################################################
@ -435,7 +482,16 @@ cmp_bag($mobUsers, [map {$_->userId} @mob], 'verify SQL table built correctly');
is( $gY->databaseLinkId, 0, "Group Y's databaseLinkId is set to WebGUI");
$gY->dbQuery(q!select userId from myUserTable!);
is( $session->stow->get('isInGroup'), undef, 'setting dbQuery clears cached isInGroup');
$session->cache->remove($gZ->getId);
is( $mob[0]->isInGroup($gY->getId), 1, 'mob[0] is in group Y after setting dbQuery');
is( $mob[0]->isInGroup($gZ->getId), 1, 'mob[0] isInGroup Z');
ok( isIn($mob[0]->userId, @{ $gY->getAllUsers() }), 'mob[0] in list of group Y users');
ok( !isIn($mob[0]->userId, @{ $gZ->getUsers() }), 'mob[0] not in list of group Z users');
ok( isIn($mob[0]->userId, @{ $gZ->getAllUsers() }), 'mob[0] in list of group Z users, recursively');
$gY->clearCaches;
my @mobIds = map { $_->userId } @mob;
@ -445,13 +501,17 @@ cmp_bag(
'all mob users in list of group Y users from database'
);
is( $mob[0]->isInGroup($gY->getId), 1, 'mob[0] is in group Y after setting dbQuery');
is( $mob[0]->isInGroup($gZ->getId), 1, 'mob[0] isInGroup Z');
$session->db->write('delete from myUserTable where userId=?',[$mob[0]->getId]);
my $inDb = $session->db->quickScalar("select count(*) from myUserTable where userId=?",[$mob[0]->getId]);
ok ( !$inDb, 'mob[0] no longer in myUserTable');
WebGUI::Cache->new($session, ["groupMembers",$gY->getId])->delete; #Delete cache so we get a good test
$session->stow->delete("isInGroup"); #Delete stow so we get a good test
ok( isIn($mob[0]->userId, @{ $gY->getAllUsers() }), 'mob[0] in list of group Y users');
ok( !isIn($mob[0]->userId, @{ $gZ->getUsers() }), 'mob[0] not in list of group Z users');
ok( isIn($mob[0]->userId, @{ $gZ->getAllUsers() }), 'mob[0] in list of group Z users, recursively');
is_deeply(
[ (map { $gY->hasDatabaseUser($_->getId) } @mob) ],
[0, 1, 1],
'mob users 1,2 found in list of group Y users from database'
);
##Karma tests
@ -497,6 +557,12 @@ is_deeply(
'karma disabled in settings, no users in group'
);
is_deeply(
[ (map { $gK->hasKarmaUser($_->getId) } @chameleons) ],
[0, 0, 0, 0],
'karma disabled in settings, group K has no users via karma threshold'
);
$session->setting->set('useKarma', 1);
$gK->clearCaches; ##Clear cache since previous data is wrong
@ -506,6 +572,12 @@ is_deeply(
'chameleons 1, 2 and 3 are in group K via karma threshold'
);
is_deeply(
[ (map { $gK->hasKarmaUser($_->getId) } @chameleons) ],
[0, 1, 1, 1],
'group K has chameleons 1, 2 and 3 via karma threshold'
);
cmp_bag(
$gK->getKarmaUsers,
[ (map { $_->userId() } @chameleons[1..3]) ],
@ -560,10 +632,20 @@ foreach my $idx (0..$#scratchTests) {
WebGUI::Test->addToCleanup(@itchies);
WebGUI::Test->addToCleanup(@sessionBank);
#isInGroup test
foreach my $scratchTest (@scratchTests) {
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");
}
cmp_bag(
$gS->getScratchUsers,
[ (map { $_->{user}->userId() } grep { $_->{expect} } @scratchTests) ],
@ -576,6 +658,33 @@ cmp_bag(
'getAllUsers for group with scratch'
);
{ ##Add scope to force cleanup
note "Checking for user Visitor session leak";
my $remoteSession = WebGUI::Test->newSession;
$remoteSession->user({userId => 1});
$remoteSession->scratch->set('remote','nok');
my $localScratchGroup = WebGUI::Group->new($session, 'new');
$localScratchGroup->name("Local IP Group");
$localScratchGroup->scratchFilter('local=ok');
ok !$remoteSession->user->isInGroup($localScratchGroup->getId), 'Remote Visitor fails to be in the scratch group';
my $localSession = WebGUI::Test->newSession;
WebGUI::Test->addToCleanup($localScratchGroup, $remoteSession, $localSession);
$localSession->user({userId => 1});
$remoteSession->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';
}
@sessionBank = ();
my @tcps = ();
@ -617,10 +726,45 @@ cmp_bag(
'getUsers for group with IP filter'
);
is_deeply(
[ (map { $gI->hasIpUser($_->{user}->getId) } @ipTests) ],
[ (map { $_->{expect} } @ipTests) ],
'hasIpUsers for group with IP filter'
);
foreach my $ipTest (@ipTests) {
is($ipTest->{user}->isInGroup($gI->getId), $ipTest->{expect}, $ipTest->{comment});
}
{ ##Add scope to force cleanup
note "Checking for user Visitor session leak";
$ENV{REMOTE_ADDR} = '191.168.1.1';
my $remoteSession = WebGUI::Test->newSession;
$remoteSession->user({userId => 1});
my $localIpGroup = WebGUI::Group->new($session, 'new');
$localIpGroup->name("Local IP Group");
$localIpGroup->ipFilter('192.168.33.0/24');
ok !$remoteSession->user->isInGroup($localIpGroup->getId), 'Remote Visitor fails to be in the group';
$ENV{REMOTE_ADDR} = '192.168.33.1';
my $localSession = WebGUI::Test->newSession;
WebGUI::Test->addToCleanup($localIpGroup, $remoteSession, $localSession);
$localSession->user({userId => 1});
$localIpGroup->clearCaches;
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';
}
##Cache check.
my $cacheDude = WebGUI::User->new($session, "new");

145
t/ProgressBar.t Normal file
View file

@ -0,0 +1,145 @@
#-------------------------------------------------------------------
# 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
#------------------------------------------------------------------
{
package WebGUI::Test::ProgressBar;
use warnings;
use strict;
sub new { bless {}, shift }
sub foo { $_[0]->{foo} = $_[1] }
sub bar { $_[0]->{bar} = $_[1] }
}
use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/lib";
use Test::More;
use Test::MockObject::Extends;
use WebGUI::Test;
use WebGUI::Session;
my $session = WebGUI::Test->session;
# Test the run method of ProgessBar -- it does some symbol table
# manipulation...
my $TestTitle = 'test title';
my $TestIcon = '/test/icon';
my $TestUrl = 'http://test.com/url';
my ($started, $finished);
my @updates = qw(one two not used);
sub mockbar {
Test::MockObject::Extends->new(WebGUI::ProgressBar->new($session));
}
my $pb = mockbar
->mock(start => sub {
my ($self, $title, $icon) = @_;
is $title, $TestTitle, 'title';
is $icon, $TestIcon, 'icon';
ok !$started, q"hadn't started yet";
$started = 1;
})
->mock(update => sub {
my ($self, $message) = @_;
my $expected = shift(@updates);
is $message, $expected, 'message';
})
->mock(finish => sub {
my ($self, $url) = @_;
is $url, $TestUrl, 'url';
ok !$finished, q"hadn't finished yet";
$finished = 1;
return 'chunked';
});
my $object = WebGUI::Test::ProgressBar->new;
ok !$object->{foo}, 'no foo';
ok !$object->{bar}, 'no bar';
sub wrapper {
my ($bar, $original, $obj, $val) = @_;
$bar->update($val);
$obj->$original($val);
}
is $pb->run(
arg => 'argument',
title => $TestTitle,
icon => $TestIcon,
code => sub {
my ($bar, $arg) = @_;
isa_ok $bar, 'WebGUI::ProgressBar', 'code invocant';
is $arg, 'argument', 'code argument';
ok $started, 'started';
ok !$finished, 'not finished yet';
is $object->foo('one'), 'one', 'wrapped return';
is $object->bar('two'), 'two', 'wrapped return (again)';
return $TestUrl;
},
wrap => {
'WebGUI::Test::ProgressBar::foo' => \&wrapper,
'WebGUI::Test::ProgressBar::bar' => \&wrapper,
}
), 'chunked', 'run return value';
ok $finished, 'finished now';
is $object->{foo}, 'one', 'foo original called';
is $object->{bar}, 'two', 'bar original called';
$object->foo('foo');
is $object->{foo}, 'foo', 'foo still works';
$object->bar('bar');
is $object->{bar}, 'bar', 'bar still works';
is @updates, 2, 'no shifting from updates after run';
delete @{$object}{qw(foo bar)};
my $updated;
# make sure that the symbol table machinations work even when something dies
$pb = mockbar->mock(start => sub {})
->mock(finish => sub {})
->mock(update => sub { $updated = 1 });
eval {
$pb->run(
code => sub {
$object->foo('foo');
$object->bar('bar');
},
wrap => {
'WebGUI::Test::ProgressBar::foo' => \&wrapper,
'WebGUI::Test::ProgressBar::bar' => sub { die "blar!\n" }
}
);
};
my $e = $@;
is $e, "blar!\n", 'exception propogated';
is $object->{foo}, 'foo', 'foo after die';
ok !$object->{bar}, 'bar did not get set';
$object->bar('bar');
is $object->{bar}, 'bar', 'but it works now';
ok $updated, 'update called for foo';
$updated = 0;
$object->foo('ignored');
ok !$updated, 'update not called for foo';
done_testing;
#vim:ft=perl

50
t/Session/Url.t
View file

@ -50,7 +50,7 @@ my @getRefererUrlTests = (
);
use Test::More;
plan tests => 79 + scalar(@getRefererUrlTests);
plan tests => 83 + scalar(@getRefererUrlTests);
my $session = WebGUI::Test->session;
my $request = $session->request;
@ -81,7 +81,7 @@ is( $url2, $url.'?a=b;c=d', 'append second pair');
#
#######################################
my $gateway = $session->config->get('gateway');
WebGUI::Test->originalConfig('gateway');
$session->config->set('gateway', '/');
is( $session->config->get('gateway'), '/', 'Set gateway for downstream tests');
@ -127,10 +127,7 @@ my $setting_hostToUse = $session->setting->get('hostToUse');
$session->setting->set('hostToUse', 'HTTP_HOST');
my $sitename = $session->config->get('sitename')->[0];
is( $session->url->getSiteURL, 'http://'.$sitename, 'getSiteURL from config as http_host');
my $config_port;
if ($session->config->get('webServerPort')) {
$config_port = $session->config->get('webServerPort');
}
WebGUI::Test->originalConfig('webServerPort');
$session->url->setSiteURL('http://webgui.org');
is( $session->url->getSiteURL, 'http://webgui.org', 'override config setting with setSiteURL');
@ -147,7 +144,7 @@ $env->{HTTP_HOST} = "devsite.com";
$session->url->setSiteURL(undef);
is( $session->url->getSiteURL, 'http://'.$sitename, 'getSiteURL where requested host is not a configured site');
my @config_sitename = @{ $session->config->get('sitename') };
WebGUI::Test->originalConfig('sitename');
$session->config->addToArray('sitename', 'devsite.com');
$session->url->setSiteURL(undef);
is( $session->url->getSiteURL, 'http://devsite.com', 'getSiteURL where requested host is not the first configured site');
@ -166,14 +163,7 @@ is( $session->url->getSiteURL, 'http://'.$sitename.':8880', 'getSiteURL with a n
$session->url->setSiteURL('http://'.$sitename);
is( $session->url->getSiteURL, 'http://'.$sitename, 'restore config setting');
$session->config->set('sitename', \@config_sitename);
$session->setting->set('hostToUse', $setting_hostToUse);
if ($config_port) {
$session->config->set('webServerPort', $config_port);
}
else {
$session->config->delete('webServerPort');
}
$url = 'level1 /level2/level3 ';
$url2 = 'level1-/level2/level3';
@ -277,14 +267,10 @@ is($session->url->makeAbsolute('page1'), '/page1', 'makeAbsolute: default baseUr
#
#######################################
my $origExtras = $session->config->get('extrasURL');
my $extras = $origExtras;
my $extras = WebGUI::Test->originalConfig('extrasURL');
my $savecdn = $session->config->get('cdn');
if ($savecdn) {
$session->config->delete('cdn');
}
# Note: the CDN configuration will be reverted in the END
WebGUI::Test->originalConfig('cdn');
$session->config->delete('cdn');
is($session->url->extras, $extras.'/', 'extras method returns URL to extras with a trailing slash');
is($session->url->extras('foo.html'), join('/', $extras,'foo.html'), 'extras method appends to the extras url');
@ -322,11 +308,6 @@ is($session->url->extras('/dir1/foo.html'), join('', $cdnCfg->{extrasSsl}, 'dir1
'extras using extrasSsl with HTTPS');
$env->{'psgi.url_scheme'} = "http";
$session->config->set('extrasURL', $origExtras);
# partial cleanup here; complete cleanup in END block
$session->config->delete('cdn');
#######################################
#
# escape and unescape
@ -354,10 +335,14 @@ is($session->url->urlize('HOME/PATH1'), 'home/path1', 'urlize: urls are lower ca
is($session->url->urlize('home/'), 'home', '... trailing slashes removed');
is($session->url->urlize('home is where the heart is'), 'home-is-where-the-heart-is', '... makeCompliant translates spaces to dashes');
is($session->url->urlize('/home'), 'home', '... removes initial slash');
is($session->url->urlize('home/../out-of-bounds'), 'home/out-of-bounds', '... removes multiple ../');
is($session->url->urlize('home/./here'), 'home/here', '... removes multiple ./');
is($session->url->urlize('home/../out-of-bounds'), 'home/out-of-bounds', '... removes ../');
is($session->url->urlize('home/./here'), 'home/here', '... removes ./');
is($session->url->urlize('home/../../out-of-bounds'), 'home/out-of-bounds', '... removes multiple ../');
is($session->url->urlize('home/././here'), 'home/here', '... removes multiple ./');
is($session->url->urlize('home -- here'), 'home-here', 'multiple dashes collapsed');
is($session->url->urlize('home!@#$%^&*here'), 'home-here', 'non-word characters collapsed to single dash');
is($session->url->urlize("home\x{2267}here"), 'home-here', 'non-word international characters removed');
is($session->url->urlize("home\x{1EE9}here"), "home\x{1EE9}here", 'word international characters not removed');
#######################################
#
@ -405,6 +390,7 @@ TODO: {
}
my $versionTag = WebGUI::VersionTag->getWorking($session);
WebGUI::Test->addToCleanup($versionTag);
my $statefulAsset = WebGUI::Asset->getRoot($session)->addChild({ className => 'WebGUI::Asset::Snippet' });
$versionTag->commit;
$session->asset( $statefulAsset );
@ -436,7 +422,7 @@ is(
#
#######################################
my $origSSLEnabled = $session->config->get('sslEnabled');
WebGUI::Test->originalConfig('sslEnabled');
##Test all the false cases, first
@ -472,9 +458,3 @@ ok($session->url->forceSecureConnection(), 'forced secure connection with no url
ok($session->http->isRedirect, '... and redirect status code was set');
is($session->http->getRedirectLocation, $secureUrl, '... and redirect status code was set');
$session->config->set('sslEnabled', $origSSLEnabled);
END { ##Always clean-up
$session->asset($sessionAsset);
$versionTag->rollback if defined $versionTag;
}

BIN
t/supporting_collateral/gallery_archive_sorting_test.zip Normal file
View file

Binary file not shown.

66
t/supporting_collateral/tbb_odd.rss Normal file
View file

@ -0,0 +1,66 @@
<?xml version="1.0" encoding="UTF-8"?>
<rss version="2.0">
<channel>
<title>The Black Blog</title>
<link>/tbb</link>
<copyright/>
<pubDate>Mon, 12 Oct 2009 11:54:28 -0500</pubDate>
<description/>
<item>
<title>WebGUI Roadmap</title>
<link>http://www.plainblack.com/tbb/webgui-roadmap</link>
<author>JT</author>
<epochDate>1254325377</epochDate>
<guid isPermaLink="true">http://www.plainblack.com/tbb/webgui-roadmap</guid>
<pubDate>Wed, 30 Sep 2009 10:42:57 -0500</pubDate>
<userDefined1/>
<userDefined2/>
<userDefined3/>
<userDefined4/>
<userDefined5/>
<description>The new roadmap is online.</description>
</item>
<item>
<title>Google Picasa Plugin for WebGUI Gallery</title>
<link>http://www.plainblack.com/tbb/google-picasa-plugin-for-webgui-gallery</link>
<author>JT</author>
<epochDate>1254854387</epochDate>
<guid isPermaLink="true">http://www.plainblack.com/tbb/google-picasa-plugin-for-webgui-gallery</guid>
<pubDate>Tue, 06 Oct 2009 13:39:47 -0500</pubDate>
<userDefined1/>
<userDefined2/>
<userDefined3/>
<userDefined4/>
<userDefined5/>
<description>Today we unveil the Google Picasa plugin for WebGUI Gallery.</description>
</item>
<item>
<title>I have arrived in Lisboa!</title>
<link>http://www.plainblack.com/tbb/i-have-arrived-in-lisboa</link>
<author>JT</author>
<epochDate>1249140064</epochDate>
<guid isPermaLink="true">http://www.plainblack.com/tbb/i-have-arrived-in-lisboa</guid>
<pubDate>Sat, 01 Aug 2009 10:21:04 -0500</pubDate>
<userDefined1/>
<userDefined2/>
<userDefined3/>
<userDefined4/>
<userDefined5/>
<description>I&apos;m in Lisbon, Portugal for YAPC::EU.</description>
</item>
<item>
<title>WebGUI 8 Performance</title>
<link>http://www.plainblack.com/tbb/webgui-8-performance</link>
<author>JT</author>
<epochDate>1254236976</epochDate>
<guid isPermaLink="true">http://www.plainblack.com/tbb/webgui-8-performance</guid>
<pubDate>Tue, 29 Sep 2009 10:09:36 -0500</pubDate>
<userDefined1/>
<userDefined2/>
<userDefined3/>
<userDefined4/>
<userDefined5/>
<description>WebGUI 8 is going to be the fastest version of WebGUI ever released.</description>
</item>
</channel>
</rss>