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

Merge branch 'master' into 8-merge

Browse source 
Conflicts:
	docs/gotcha.txt
	lib/WebGUI.pm
	lib/WebGUI/Asset.pm
	lib/WebGUI/Asset/File/GalleryFile/Photo.pm
	lib/WebGUI/Asset/Post.pm
	lib/WebGUI/Asset/Story.pm
	lib/WebGUI/Asset/Template.pm
	lib/WebGUI/Asset/Wobject/Calendar.pm
	lib/WebGUI/Asset/Wobject/GalleryAlbum.pm
	lib/WebGUI/Asset/Wobject/Navigation.pm
	lib/WebGUI/AssetLineage.pm
	lib/WebGUI/AssetTrash.pm
	lib/WebGUI/Config.pm
	lib/WebGUI/Form/Template.pm
	lib/WebGUI/Group.pm
	lib/WebGUI/Inbox.pm
	lib/WebGUI/Workflow/Activity/DeleteExpiredSessions.pm
	lib/WebGUI/Workflow/Activity/TrashExpiredEvents.pm
	sbin/testEnvironment.pl
	t/AdSpace.t
	t/AdSpace/Ad.t
	t/Asset/Asset.t
	t/Asset/AssetExportHtml.t
	t/Asset/AssetLineage.t
	t/Asset/EMSSubmissionForm.t
	t/Asset/Event.t
	t/Asset/File/GalleryFile/Photo/00base.t
	t/Asset/File/GalleryFile/Photo/comment.t
	t/Asset/File/GalleryFile/Photo/download.t
	t/Asset/File/GalleryFile/Photo/edit.t
	t/Asset/File/GalleryFile/Photo/exif.t
	t/Asset/File/GalleryFile/Photo/makeResolutions.t
	t/Asset/File/GalleryFile/Photo/makeShortcut.t
	t/Asset/File/Image/setfile.t
	t/Asset/File/setfile.t
	t/Asset/Post.t
	t/Asset/Post/Thread/getAdjacentThread.t
	t/Asset/Sku.t
	t/Asset/Sku/ProductCollateral.t
	t/Asset/Story.t
	t/Asset/Template.t
	t/Asset/Template/HTMLTemplateExpr.t
	t/Asset/Wobject/Gallery/00base.t
	t/Asset/Wobject/GalleryAlbum/00base.t
	t/Asset/Wobject/GalleryAlbum/ajax.t
	t/Asset/Wobject/GalleryAlbum/delete.t
	t/Asset/Wobject/Matrix.t
	t/Asset/Wobject/StoryArchive.t
	t/Asset/Wobject/Survey/ExpressionEngine.t
	t/Asset/Wobject/Survey/Reports.t
	t/AssetAspect/RssFeed.t
	t/Auth/mech.t
	t/Config.t
	t/Group.t
	t/Help/isa.t
	t/International.t
	t/Mail/Send.t
	t/Operation/AdSpace.t
	t/Operation/Auth.t
	t/Pluggable.t
	t/Session.t
	t/Session/DateTime.t
	t/Session/ErrorHandler.t
	t/Session/Scratch.t
	t/Session/Stow.t
	t/Shop/Cart.t
	t/Shop/Pay.t
	t/Shop/PayDriver/ITransact.t
	t/Shop/PayDriver/PayPalStd.t
	t/Shop/Ship.t
	t/Shop/ShipDriver.t
	t/Shop/TaxDriver/EU.t
	t/Shop/TaxDriver/Generic.t
	t/Shop/Transaction.t
	t/Shop/Vendor.t
	t/VersionTag.t
	t/Workflow/Activity/ArchiveOldStories.t
	t/Workflow/Activity/ExpireIncompleteSurveyResponses.t
	t/lib/WebGUI/Test.pm
This commit is contained in:
Doug Bell 2010-07-09 11:48:30 -05:00
commit babfa74209
238 changed files with 4557 additions and 1287 deletions
Download patch file Download diff file Expand all files Collapse all files

175
t/Asset/Asset.t
View file

@ -35,7 +35,144 @@ my $session = WebGUI::Test->session;
my @getTitleTests = getTitleTests($session);
plan tests => 121
my $rootAsset = WebGUI::Asset->getRoot($session);
##Test users.
##All users in here will be deleted at the end of the test. DO NOT PUT
##Visitor or Admin in here!
my %testUsers = ();
##Just a regular user
$testUsers{'regular user'} = WebGUI::User->new($session, 'new');
$testUsers{'regular user'}->username('regular user');
##Users in group 12 can add Assets
$testUsers{'canAdd turnOnAdmin'} = WebGUI::User->new($session, 'new');
$testUsers{'canAdd turnOnAdmin'}->addToGroups(['12']);
$testUsers{'canAdd turnOnAdmin'}->username('Turn On Admin user');
##Just a user for owning assets
$testUsers{'owner'} = WebGUI::User->new($session, 'new');
$testUsers{'owner'}->username('Asset Owner');
##Test Groups
##All groups in here will be deleted at the end of the test
my %testGroups = ();
##A group and user for groupIdEdit
$testGroups{'canEdit asset'} = WebGUI::Group->new($session, 'new');
$testUsers{'canEdit group user'} = WebGUI::User->new($session, 'new');
$testUsers{'canEdit group user'}->addToGroups([$testGroups{'canEdit asset'}->getId]);
$testUsers{'canEdit group user'}->username('Edit Group User');
addToCleanup($testGroups{'canEdit asset'});
##A group and user for groupIdEdit
$testGroups{'canAdd asset'} = WebGUI::Group->new($session, 'new');
$testUsers{'canAdd group user'} = WebGUI::User->new($session, 'new');
$testUsers{'canAdd group user'}->addToGroups([$testGroups{'canAdd asset'}->getId]);
$testUsers{'canEdit group user'}->username('Can Add Group User');
addToCleanup($testGroups{'canAdd asset'}, values %testUsers);
my $canAddMaker = WebGUI::Test::Maker::Permission->new();
$canAddMaker->prepare({
'className' => 'WebGUI::Asset',
'session' => $session,
'method' => 'canAdd',
#'pass' => [3, $testUsers{'canAdd turnOnAdmin'}, $testUsers{'canAdd group user'} ],
'pass' => [3, $testUsers{'canAdd group user'} ],
'fail' => [1, $testUsers{'regular user'}, ],
});
my $canAddMaker2 = WebGUI::Test::Maker::Permission->new();
$canAddMaker2->prepare({
'className' => 'WebGUI::Asset',
'session' => $session,
'method' => 'canAdd',
'fail' => [$testUsers{'canAdd turnOnAdmin'},],
});
my $properties;
$properties = {
# '1234567890123456789012'
id => 'canEditAsset0000000010',
title => 'canEdit Asset Test',
url => 'canEditAsset1',
className => 'WebGUI::Asset',
ownerUserId => $testUsers{'owner'}->userId,
groupIdEdit => $testGroups{'canEdit asset'}->getId,
groupIdView => 7,
};
my $versionTag2 = WebGUI::VersionTag->getWorking($session);
addToCleanup($versionTag2);
my $canEditAsset = $rootAsset->addChild($properties, $properties->{id});
$versionTag2->commit;
$properties = {}; ##Clear out the hash so that it doesn't leak later by accident.
my $canEditMaker = WebGUI::Test::Maker::Permission->new();
$canEditMaker->prepare({
'object' => $canEditAsset,
'method' => 'canEdit',
'pass' => [3, $testUsers{'owner'}, $testUsers{'canEdit group user'}, ],
'fail' => [1, $testUsers{'regular user'}, ],
});
my $versionTag3 = WebGUI::VersionTag->getWorking($session);
addToCleanup($versionTag3);
$properties = {
# '1234567890123456789012'
id => 'canViewAsset0000000010',
title => 'canView Asset Test',
url => 'canViewAsset1',
className => 'WebGUI::Asset',
ownerUserId => $testUsers{'owner'}->userId,
groupIdEdit => $testGroups{'canEdit asset'}->getId,
groupIdView => $testGroups{'canEdit asset'}->getId,
};
my $canViewAsset = $rootAsset->addChild($properties, $properties->{id});
$versionTag3->commit;
$properties = {}; ##Clear out the hash so that it doesn't leak later by accident.
my $canViewMaker = WebGUI::Test::Maker::Permission->new();
$canViewMaker->prepare(
{
'object' => $canEditAsset,
'method' => 'canView',
'pass' => [1, 3, $testUsers{'owner'}, $testUsers{'canEdit group user'}, $testUsers{'regular user'},],
},
{
'object' => $canViewAsset,
'method' => 'canView',
'pass' => [3, $testUsers{'owner'}, $testUsers{'canEdit group user'}, ],
'fail' => [1, $testUsers{'regular user'}, ],
},
);
#### TestAsset class to test definition / update relationship
BEGIN { $INC{ 'WebGUI/Asset/TestAsset.pm' } = __FILE__ }
package WebGUI::Asset::TestAsset;
our @ISA = ( 'WebGUI::Asset' );
sub definition {
my ( $class, $session, $definition ) = @_;
# Alter assetData fields for testing purposes. Do not do
# this in normal circumstances. Ever.
$definition = $class->SUPER::definition( $session, $definition );
# Make synopsis serialized
$definition->[0]->{properties}->{synopsis}->{serialize} = 1;
return $definition;
}
package main;
plan tests => 132
+ scalar(@fixIdTests)
+ scalar(@fixTitleTests)
+ 2*scalar(@getTitleTests) #same tests used for getTitle and getMenuTitle
;
@ -186,6 +323,40 @@ isa_ok($tempNode, 'WebGUI::Asset::Wobject::Folder');
is($tempNode->getId, 'tempspace0000000000000', 'Tempspace Asset ID check');
is($tempNode->getParent->getId, $rootAsset->getId, 'Tempspace parent is Root Asset');
################################################################
#
# update
#
################################################################
# Create a new TestAsset instance
my $ta = $importNode->addChild( {
className => 'WebGUI::Asset::TestAsset',
} );
isa_ok( $ta, 'WebGUI::Asset::TestAsset', 'addChild returns correct object' );
ok(
eval { $ta->update({ synopsis => [ "one", "two" ] }); 1; },
'update() succeeds with ref on serialized property',
);
cmp_deeply(
$ta->get('synopsis'),
[ "one", "two" ],
"serialized property returns deserialized ref",
);
ok(
eval { $ta->update({ synopsis => '[ "two", "three" ]', }); 1; },
'update() succeeds with serialized string on serialized property',
);
cmp_deeply(
$ta->get('synopsis'),
[ "two", "three" ],
"serialized property returns deserialized ref",
);
$ta->purge;
################################################################
#
# urlExists
@ -801,3 +972,5 @@ sub getTitleTests {
},
);
}

2
t/Asset/AssetExportHtml.t
View file

@ -290,7 +290,7 @@ is($gcAsPath->absolute($exportPath)->stringify, $litmus->absolute($exportPath)->
# now let's get tricky and test different file extensions
my $storage = WebGUI::Storage->create($session);
WebGUI::Test->addToCleanup('WebGUI::Storage' => $storage->getId);
WebGUI::Test->addToCleanup($storage);
my $filename = 'somePerlFile_pl.txt';
$storage->addFileFromScalar($filename, $filename);
$session->user({userId=>3});

120
t/Asset/AssetLineage.t
View file

@ -17,7 +17,7 @@ use WebGUI::Session;
use WebGUI::User;
use WebGUI::Asset;
use Test::More tests => 94; # increment this value for each test you create
use Test::More tests => 96; # increment this value for each test you create
use Test::Deep;
use Test::Exception;
use Data::Dumper;
@ -509,6 +509,124 @@ is ($snippet4->getId, $snippets[4]->getId, '... failing class cache forces looku
dies_ok { WebGUI::Asset->newByLineage($session, 'notALineage') } '... throws an exception';
ok(!exists $session->stow->get('assetLineage')->{assetLineage}, '... no entry for the bad lineage in stow');
####################################################
#
# getLineage
#
####################################################
@snipIds = map { $_->getId } @snippets;
my $ids = $folder->getLineage(['descendants']);
cmp_bag(
\@snipIds,
$ids,
'getLineage: get descendants of folder'
);
$ids = $folder->getLineage(['self','descendants']);
unshift @snipIds, $folder->getId;
cmp_bag(
\@snipIds,
$ids,
'getLineage: get descendants of folder and self'
);
$ids = $folder->getLineage(['self','children']);
cmp_bag(
\@snipIds,
$ids,
'getLineage: descendants == children if there are no grandchildren'
);
$ids = $topFolder->getLineage(['self','children']);
cmp_bag(
[$topFolder->getId, $folder->getId, $folder2->getId, ],
$ids,
'getLineage: children (no descendants) of topFolder',
);
$ids = $topFolder->getLineage(['self','descendants']);
cmp_bag(
[$topFolder->getId, @snipIds, $folder2->getId, $snippet2->getId],
$ids,
'getLineage: descendants of topFolder',
);
$ids = $root->getLineage(['ancestors']);
cmp_deeply(
$ids,
[],
'... getting ancestors of root returns empty array'
);
####################################################
#
# getLineageSql
#
####################################################
note "getLineageSql";
ok $root->getLineageSql(['ancestors']), 'valid SQL returned in an error condition';
####################################################
#
# getLineageIterator
#
####################################################
sub getListFromIterator {
my $iterator = shift;
my @items;
while (my $item = $iterator->()) {
push @items, $item->getId;
}
return \@items;
}
@snipIds = map { $_->getId } @snippets;
my $ids = getListFromIterator($folder->getLineageIterator(['descendants']));
cmp_bag(
\@snipIds,
$ids,
'getLineageIterator: get descendants of folder'
);
$ids = getListFromIterator($folder->getLineageIterator(['self','descendants']));
unshift @snipIds, $folder->getId;
cmp_bag(
\@snipIds,
$ids,
'getLineageIterator: get descendants of folder and self'
);
$ids = getListFromIterator($folder->getLineageIterator(['self','children']));
cmp_bag(
\@snipIds,
$ids,
'getLineageIterator: descendants == children if there are no grandchildren'
);
$ids = getListFromIterator($topFolder->getLineageIterator(['self','children']));
cmp_bag(
[$topFolder->getId, $folder->getId, $folder2->getId, ],
$ids,
'getLineageIterator: children (no descendants) of topFolder',
);
$ids = getListFromIterator($topFolder->getLineageIterator(['self','descendants']));
cmp_bag(
[$topFolder->getId, @snipIds, $folder2->getId, $snippet2->getId],
$ids,
'getLineageIterator: descendants of topFolder',
);
my $empty = getListFromIterator($root->getLineageIterator(['ancestors']));
cmp_bag(
$empty,
[],
'... getting ancestors of root returns empty array'
);
####################################################
#
# addChild

20
t/Asset/AssetMetaData.t
View file

@ -30,6 +30,7 @@ $session->user({userId => 3});
my $root = WebGUI::Asset->getRoot($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"Asset Package test"});
WebGUI::Test->addToCleanup($versionTag);
####################################################
#
@ -55,6 +56,12 @@ my $snippet = $folder->addChild({
$versionTag->commit;
WebGUI::Test->addToCleanup(sub {
foreach my $metaDataFieldId (keys %{ $snippet->getMetaDataFields }) {
$snippet->deleteMetaDataField($metaDataFieldId);
}
});
##Note that there is no MetaData field master class. New fields can be added
##from _ANY_ asset, and be available to all assets.
@ -225,15 +232,4 @@ sub buildNameIndex {
return $nameStruct;
}
END {
foreach my $metaDataFieldId (keys %{ $snippet->getMetaDataFields }) {
$snippet->deleteMetaDataField($metaDataFieldId);
}
foreach my $tag($versionTag) {
if (defined $tag and ref $tag eq 'WebGUI::VersionTag') {
$tag->rollback;
}
}
}
#vim:ft=perl

2
t/Asset/EMSSubmissionForm.t
View file

@ -505,6 +505,4 @@ $sub1->getFormattedComments;
} [], 'no warnings from calling a bunch of functions';
#done_testing();
#print 'press return to complete test' ; <>;
#vim:ft=perl

12
t/Asset/Event/edit.t
View file

@ -62,6 +62,7 @@ my $calendar = $node->addChild( {
my $eventUrl;
$versionTags[-1]->commit;
WebGUI::Test->addToCleanup($versionTags[-1]);
#----------------------------------------------------------------------------
# Tests
@ -167,15 +168,6 @@ $properties = {
cmp_deeply( $event->get, superhashof( $properties ), 'Events properties saved correctly' );
#----------------------------------------------------------------------------
# Cleanup
END {
for my $tag ( @versionTags ) {
$tag->rollback;
}
}
#----------------------------------------------------------------------------
# getMechLogin( baseUrl, WebGUI::User, "identifier" )
# Returns a Test::WWW::Mechanize session after logging in the given user using
@ -197,3 +189,5 @@ sub getMechLogin {
return $mech;
}
#vim:ft=perl

10
t/Asset/Event/permissions.t
View file

@ -31,6 +31,7 @@ $session->user({ userId => 3 });
my @versionTags = ();
push @versionTags, WebGUI::VersionTag->getWorking($session);
$versionTags[-1]->set({name=>"Photo Test, add Gallery, Album and 1 Photo"});
WebGUI::Test->addToCleanup($versionTags[-1]);
my $registeredUser = WebGUI::User->new( $session, "new" );
WebGUI::Test->addToCleanup($registeredUser);
@ -59,6 +60,7 @@ plan tests => 12; # Increment this number for each test you create
# Test permissions of an event added by the Admin
push @versionTags, WebGUI::VersionTag->getWorking($session);
$versionTags[-1]->set({name=>"Photo Test, add Gallery, Album and 1 Photo"});
WebGUI::Test->addToCleanup($versionTags[-1]);
$event = $calendar->addChild({
className => 'WebGUI::Asset::Event',
ownerUserId => 3,
@ -77,10 +79,4 @@ $maker->prepare( {
fail => [ '1', $registeredUser, ],
} )->run;
#----------------------------------------------------------------------------
# Cleanup
END {
for my $tag ( @versionTags ) {
$tag->rollback;
}
}
#vim:ft=perl

2
t/Asset/File/GalleryFile/Photo/00base.t
View file

@ -93,3 +93,5 @@ my $properties = $photo->get;
$photo->purge;
dies_ok { WebGUI::Asset->newById($session, $properties->{assetId}) } "Photo no longer able to be instanciated";
#vim:ft=perl

3
t/Asset/File/GalleryFile/Photo/comment.t
View file

@ -30,6 +30,7 @@ my $node = WebGUI::Asset->getImportNode($session);
my @versionTags = ();
push @versionTags, WebGUI::VersionTag->getWorking($session);
WebGUI::Test->addToCleanup($versionTags[-1]);
$versionTags[-1]->set({name=>"Photo Test, add Gallery, Album and 1 Photo"});
WebGUI::Test->addToCleanup($versionTags[-1]);
@ -327,3 +328,5 @@ TODO: {
# TODO
ok( 0, "Visitor has their IP logged in visitorIp field" );
}
#vim:ft=perl

1
t/Asset/File/GalleryFile/Photo/download.t
View file

@ -84,3 +84,4 @@ ok(
"getDownloadFileUrl croaks if resolution doesn't exist",
);
#vim:ft=perl

133
t/Asset/File/GalleryFile/Photo/edit.t
View file

@ -14,18 +14,29 @@
use FindBin;
use strict;
use lib "$FindBin::Bin/../../../../lib";
use Test::More;
use Test::Deep;
use WebGUI::Test; # Must use this before any other WebGUI modules
use WebGUI::Asset;
use WebGUI::Asset::Wobject::Gallery;
use WebGUI::Asset::Wobject::GalleryAlbum;
use WebGUI::Asset::File::GalleryFile::Photo;
use WebGUI::VersionTag;
use WebGUI::Session;
plan skip_all => 'set WEBGUI_LIVE to enable this test' unless $ENV{WEBGUI_LIVE};
#----------------------------------------------------------------------------
# Init
my $session = WebGUI::Test->session;
my $node = WebGUI::Asset->getImportNode( $session );
my @versionTags = ( WebGUI::VersionTag->getWorking( $session ) );
# Create version tag and make sure it gets cleaned up
my $versionTag = WebGUI::VersionTag->getWorking($session);
addToCleanup($versionTag);
# Override some settings to make things easier to test
# userFunctionStyleId
@ -34,36 +45,43 @@ $session->setting->set( 'userFunctionStyleId', 'PBtmpl0000000000000132' );
$session->setting->set( 'specialState', '' );
# Create a user for testing purposes
my $user = WebGUI::User->new( $session, "new" );
my $user = WebGUI::User->new( $session, "new" );
WebGUI::Test->addToCleanup($user);
$user->username( 'dufresne' . time );
my $identifier = 'ritahayworth';
my $auth = WebGUI::Operation::Auth::getInstance( $session, $user->authMethod, $user->userId );
my $identifier = 'ritahayworth';
my $auth = WebGUI::Operation::Auth::getInstance( $session, $user->authMethod, $user->userId );
$auth->saveParams( $user->userId, $user->authMethod, {
'identifier' => Digest::MD5::md5_base64( $identifier ),
});
my ( $mech );
# Get the site's base URL
my $baseUrl = 'http://' . $session->config->get('sitename')->[0];
my @addArgs = ( undef, undef, { skipAutoCommitWorkflows => 1 } );
# Create gallery and a single album
my $gallery
= $node->addChild({
className => "WebGUI::Asset::Wobject::Gallery",
title => "gallery",
groupIdAddFile => 2, # Registered Users
styleTemplateId => "PBtmpl0000000000000132", # Blank Style
styleTemplateId => "PBtmpl0000000000000132", # Blank Style
});
my $album
= $gallery->addChild({
className => "WebGUI::Asset::Wobject::GalleryAlbum",
}, @addArgs );
ownerUserId => $user->getId,
title => "album",
},
undef,
undef,
{
skipAutoCommitWorkflows => 1,
});
$versionTags[-1]->commit;
# Commit assets for testing
$versionTag->commit;
my $photo;
# Get the site's base URL
my $baseUrl = 'http://' . $session->config->get('sitename')->[0];
# Common variables
my ( $mech, $photo );
#----------------------------------------------------------------------------
@ -78,18 +96,93 @@ if ( !$mech->success ) {
plan skip_all => "Cannot load URL '$baseUrl'. Will not test.";
}
plan tests => 5; # Increment this number for each test you create
plan tests => 10; # Increment this number for each test you create
#----------------------------------------------------------------------------
# Test permissions for new photos
$mech = Test::WWW::Mechanize->new;
# Save a new photo
$mech->get( $baseUrl . $album->getUrl("func=add;class=WebGUI::Asset::File::GalleryFile::Photo") );
$mech->content_lacks( 'value="editSave"' );
#----------------------------------------------------------------------------
# Test editing existing photo
# Create single photo inside the album
$photo
= $album->addChild({
className => "WebGUI::Asset::File::GalleryFile::Photo",
ownerUserId => $user->getId,
title => "photo",
synopsis => "synopsis",
keywords => "keywords",
location => "location",
friendsOnly => 0,
},
undef,
time() - 5 # Create photo asset in the past to avoid duplicate revision dates
);
# Attach image file to photo asset
$photo->setFile( WebGUI::Test->getTestCollateralPath("rotation_test.png") );
# New values for photo properties
my %properties = (
title => 'new photo',
synopsis => 'new synopsis',
keywords => 'new keywords',
location => 'new location',
friendsOnly => '1',
);
# Log in
$mech = getMechLogin( $baseUrl, $user, $identifier );
# Request photo edit view
$mech->get_ok( $baseUrl . $photo->getUrl('func=edit'), 'Request Photo edit view' );
# Try to submit edit form
$mech->submit_form_ok({
form_name => 'photoEdit',
fields => \%properties,
},
'Submit Photo edit form' );
# Re-create instance of Photo asset
$photo = WebGUI::Asset->newByDynamicClass($session, $photo->getId);
# Check whether properties were changed correctly
cmp_deeply($photo->get, superhashof(\%properties), 'All changes applied');
#----------------------------------------------------------------------------
# Test redirect to parent's edit view using the "proceed=editParent" parameter
# Create single photo inside the album
$photo
= $album->addChild({
className => "WebGUI::Asset::File::GalleryFile::Photo",
ownerUserId => $user->getId,
},
undef,
time() - 5 # Create photo asset in the past to avoid duplicate revision dates
);
# Attach image file to photo asset
$photo->setFile( WebGUI::Test->getTestCollateralPath("rotation_test.png") );
# Request photo edit view
$mech->get_ok( $baseUrl . $photo->getUrl('func=edit;proceed=editParent'), 'Request Photo edit view with "proceed=editParent"' );
# Submit changes
$mech->submit_form( form_name => 'photoEdit' );
# Currently, a redirect using the proceed parameter will not change the URL
# nor add the proper "func" argument. We have to look at the page content instead.
$mech->content_contains( 'name="galleryAlbumEdit"', "Redirected to parent's edit view" );
#----------------------------------------------------------------------------
# Test creating a new Photo
SKIP: {
skip "File control needs to be fixed to be more 508-compliant before this can be used", 4;
$mech = getMechLogin( $baseUrl, $user, $identifier );
@ -131,14 +224,6 @@ SKIP: {
);
}
#----------------------------------------------------------------------------
# Cleanup
END {
for my $tag ( @versionTags ) {
$tag->rollback;
}
}
#----------------------------------------------------------------------------
# getMechLogin( baseUrl, WebGUI::User, "identifier" )

3
t/Asset/File/GalleryFile/Photo/exif.t
View file

@ -26,6 +26,7 @@ use Image::ExifTool qw(:Public);
my $session = WebGUI::Test->session;
my $node = WebGUI::Asset->getImportNode($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
WebGUI::Test->addToCleanup($versionTag);
$versionTag->set({name=>"Photo Test"});
WebGUI::Test->addToCleanup($versionTag);
my $gallery
@ -80,3 +81,5 @@ is_deeply(
[ sort map { $_->{tag} } @{ $var->{exifLoop} } ],
"getTemplateVars gets a loop over the tags",
);
#vim:ft=perl

3
t/Asset/File/GalleryFile/Photo/makeResolutions.t
View file

@ -29,6 +29,7 @@ my $node = WebGUI::Asset->getImportNode($session);
my @versionTags = ();
push @versionTags, WebGUI::VersionTag->getWorking($session);
$versionTags[-1]->set({name=>"Photo Test"});
WebGUI::Test->addToCleanup($versionTags[-1]);
my ($gallery, $album, $photo);
$gallery
@ -224,3 +225,5 @@ $photo->update({ filename => 'page_title.jpg' });
"makeResolutions still makes valid resolutions when invalid resolutions given",
);
}
#vim:ft=perl

2
t/Asset/File/GalleryFile/Photo/makeShortcut.t
View file

@ -132,3 +132,5 @@ cmp_deeply(
#----------------------------------------------------------------------------
# www_makeShortcut
#vim:ft=perl

9
t/Asset/File/GalleryFile/Photo/setFile.t
View file

@ -25,6 +25,7 @@ use WebGUI::Asset::File::GalleryFile::Photo;
my $session = WebGUI::Test->session;
my $node = WebGUI::Asset->getImportNode($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
WebGUI::Test->addToCleanup($versionTag);
$versionTag->set({name=>"Photo Test"});
my $gallery
= $node->addChild({
@ -70,10 +71,4 @@ ok(
"Generated resolution file exists on the filesystem",
);
#----------------------------------------------------------------------------
# Cleanup
END {
$versionTag->rollback();
}
#vim:ft=perl

2
t/Asset/File/Image/setfile.t
View file

@ -25,6 +25,7 @@ use WebGUI::Asset::File::Image;
my $session = WebGUI::Test->session;
my $node = WebGUI::Asset->getImportNode($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
WebGUI::Test->addToCleanup($versionTag);
$versionTag->set({name=>"Image Test"});
WebGUI::Test->addToCleanup($versionTag);
my $image
@ -55,3 +56,4 @@ ok(
"Thumbnail file exists on the filesystem",
);
#vim:ft=perl

3
t/Asset/File/setfile.t
View file

@ -31,6 +31,7 @@ my $file
className => "WebGUI::Asset::File",
});
$versionTag->commit;
WebGUI::Test->addToCleanup($versionTag);
#----------------------------------------------------------------------------
# Tests
@ -54,3 +55,5 @@ is_deeply(
$storage->getFiles, ['WebGUI.pm'],
"Storage location contains only the file we added",
);
#vim:ft=perl

11
t/Asset/MatrixListing.t
View file

@ -26,6 +26,7 @@ my $node = WebGUI::Asset->getImportNode($session);
my ($matrix, $matrixListing);
my $versionTag = WebGUI::VersionTag->getWorking($session);
WebGUI::Test->addToCleanup($versionTag);
$versionTag->set({name=>"Matrix Listing Test"});
$matrix = $node->addChild({className=>'WebGUI::Asset::Wobject::Matrix'});
@ -34,6 +35,7 @@ $matrixListing = $matrix->addChild({className=>'WebGUI::Asset::MatrixListing'});
# Wikis create and autocommit a version tag when a child is added. Lets get the name so we can roll it back.
my $secondVersionTag = WebGUI::VersionTag->new($session,$matrixListing->get("tagId"));
WebGUI::Test->addToCleanup($secondVersionTag);
# Test for sane object types
isa_ok($matrix, 'WebGUI::Asset::Wobject::Matrix');
@ -53,11 +55,4 @@ isa_ok($matrixListing, 'WebGUI::Asset::MatrixListing');
# local $TODO = "Tests to make later";
# ok(0, 'Lots and lots to do');
#}
END {
# Clean up after thy self
$versionTag->rollback();
$secondVersionTag->rollback();
#$thirdVersionTag->rollback();
}
#vim:ft=perl

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

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

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

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

14
t/Asset/Redirect/mech.t
View file

@ -63,6 +63,7 @@ my $redirectToAsset
snippet => $testContent,
});
$versionTags[-1]->commit;
WebGUI::Test->addToCleanup($versionTags[-1]);
#----------------------------------------------------------------------------
# Tests
@ -81,6 +82,7 @@ plan tests => 12; # Increment this number for each test you create
#----------------------------------------------------------------------------
# Test operation with a public Redirect
push @versionTags, WebGUI::VersionTag->getWorking( $session );
WebGUI::Test->addToCleanup($versionTags[-1]);
$redirect
= $node->addChild({
className => 'WebGUI::Asset::Redirect',
@ -104,6 +106,7 @@ is(
#----------------------------------------------------------------------------
# Test operation with a private Redirect through a login
push @versionTags, WebGUI::VersionTag->getWorking( $session );
WebGUI::Test->addToCleanup($versionTags[-1]);
$redirect
= $node->addChild({
className => 'WebGUI::Asset::Redirect',
@ -137,6 +140,7 @@ is(
# Test operation with a private Redirect through a login with translate
# query params
push @versionTags, WebGUI::VersionTag->getWorking( $session );
WebGUI::Test->addToCleanup($versionTags[-1]);
$redirect
= $node->addChild({
className => 'WebGUI::Asset::Redirect',
@ -170,12 +174,4 @@ TODO: {
);
};
#----------------------------------------------------------------------------
# Cleanup
END {
for my $tag ( @versionTags ) {
$tag->rollback;
}
}
#vim:ft=perl

7
t/Asset/Shortcut/000-create-delete.t
View file

@ -25,6 +25,7 @@ my $session = WebGUI::Test->session;
my $node = WebGUI::Asset->getImportNode($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"Shortcut Test"});
WebGUI::Test->addToCleanup($versionTag);
# Make a snippet to shortcut
my $snippet
@ -32,12 +33,6 @@ my $snippet
className => "WebGUI::Asset::Snippet",
});
#----------------------------------------------------------------------------
# Cleanup
END {
$versionTag->rollback();
}
#----------------------------------------------------------------------------
# Tests
plan tests => 3;

10
t/Asset/Sku/Ad.t
View file

@ -92,6 +92,7 @@ EOCD
15@500000
EOID
});
WebGUI::Test->addToCleanup($sku);
$sku->applyOptions({
adtitle => 'Sold!',
@ -106,11 +107,4 @@ is($sku->getPrice, '19.00', 'get Price');
# $sku->onCompletePurchase($item); --> not really sure how to test the rest...
# $sku->onRefund
#----------------------------------------------------------------------------
# Cleanup
END {
$sku->purge;
}
1;
#vim:ft=perl

1
t/Asset/Sku/Donation.t
View file

@ -40,6 +40,7 @@ my $sku = $root->addChild({
title=>"Test Donation",
defaultPrice => 50.00,
});
WebGUI::Test->addToCleanup($sku);
isa_ok($sku, "WebGUI::Asset::Sku::Donation");
is($sku->getPrice, 50.00, "Price should be 50.00");

12
t/Asset/Sku/ProductCollateral.t
View file

@ -41,6 +41,8 @@ plan tests => 34; # Increment this number for each test you create
#----------------------------------------------------------------------------
# put your tests here
my $root = WebGUI::Asset->getRoot($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
WebGUI::Test->addToCleanup($versionTag);
my $product = $root->addChild({
className => "WebGUI::Asset::Sku::Product",
title => "Rock Hammer",
@ -307,12 +309,4 @@ lives_ok { $product6a->getAllCollateral('variantsJSON', 'vid', $newVid); }, 'Pro
$product6->purge;
#----------------------------------------------------------------------------
# Cleanup
END {
WebGUI::VersionTag->getWorking($session)->rollback;
}
1;
#vim:ft=perl

8
t/Asset/Story.t
View file

@ -274,7 +274,7 @@ cmp_deeply(
{
title => 'Story 1',
description => 'WebGUI was originally called Web Done Right.',
'link' => re('story-1$'),
'link' => all(re('^'.$session->url->getSiteURL),re('story-1$')),
guid => re('story-1$'),
author => 'JT Smith',
date => $story->lastModified,
@ -417,10 +417,7 @@ cmp_deeply(
isnt($newPhotoData->[0]->{storageId}, $photoData->[0]->{storageId}, '... and storage 0 is duplicated');
isnt($newPhotoData->[1]->{storageId}, $photoData->[1]->{storageId}, '... and storage 1 is duplicated');
{
my %hash = map { ('WebGUI::Storage' => $_->{storageId}) } @{ $newPhotoData };
WebGUI::Test->addToCleanup(%hash);
}
WebGUI::Test->addToCleanup( map { ( 'WebGUI::Storage' => $_->{storageId} ) } @{ $newPhotoData } );
############################################################
#
@ -440,3 +437,4 @@ cmp_bag(
'...asset package data has the storage locations in it'
);
#vim:ft=perl

25
t/Asset/Template.t
View file

@ -18,6 +18,7 @@ use WebGUI::Asset::Template;
use Exception::Class;
use Test::More tests => 42; # increment this value for each test you create
use Test::Deep;
use Data::Dumper;
use JSON qw{ from_json };
my $session = WebGUI::Test->session;
@ -78,13 +79,13 @@ my $template3 = $importNode->addChild({
}, undef, time()-5);
my @atts = (
{type => 'headScript', sequence => 1, url => 'bar'},
{type => 'headScript', sequence => 0, url => 'foo'},
{type => 'stylesheet', sequence => 0, url => 'style'},
{type => 'bodyScript', sequence => 0, url => 'body'},
{type => 'headScript', url => 'foo'},
{type => 'headScript', url => 'bar'},
{type => 'stylesheet', url => 'style'},
{type => 'bodyScript', url => 'body'},
);
$template3->addAttachments(\@atts);
$template3->update({ attachmentsJson => JSON->new->encode( \@atts ) });
my $att3 = $template3->getAttachments('headScript');
is($att3->[0]->{url}, 'foo', 'has foo');
is($att3->[1]->{url}, 'bar', 'has bar');
@ -100,12 +101,12 @@ ok(exists $session->style->{_javascript}->{$_}, "$_ in style") for qw(foo bar bo
#sleep 1;
my $template3dup = $template3->duplicate;
my @atts3dup = map { delete @{ $_ }{qw/attachId templateId revisionDate/}; $_; } @{ $template3dup->getAttachments };
my @atts3dup = @{ $template3dup->getAttachments };
cmp_bag(
[@atts3dup],
[@atts],
'attachments are duplicated'
);
) or diag( Dumper \@atts3dup );
my $template3rev = $template3->addRevision();
my $att4 = $template3rev->getAttachments('headScript');
@ -113,7 +114,9 @@ is($att4->[0]->{url}, 'foo', 'rev has foo');
is($att4->[1]->{url}, 'bar', 'rev has bar');
is(@$att4, 2, 'rev is proper size');
$template3rev->addAttachments([{type => 'headScript', sequence => 2, url => 'baz'}]);
$template3rev->update({
attachmentsJson => JSON->new->encode([ @atts, {type => 'headScript', url => 'baz'} ]),
});
$att4 = $template3rev->getAttachments('headScript');
$att3 = $template3->getAttachments('headScript');
is($att3->[0]->{url}, 'foo', 'original still has foo');
@ -122,13 +125,9 @@ is(@$att3, 2, 'original does not have new thing');
is($att4->[0]->{url}, 'foo', 'rev still has foo');
is($att4->[1]->{url}, 'bar', 'rev still has bar');
is($att4->[2]->{url}, 'baz', 'rev does have new thing');
is($att4->[2]->{url}, 'baz', 'rev does have new thing') or diag( $template3rev->get('attachmentsJson') );
is(@$att4, 3, 'rev is proper size');
##This is a non-test. Duplicate URLs will not cause the test to blow-up with
##an untrappable error.
$template3rev->addAttachments([{ type => 'headScript', sequence => 3, url => 'baz'}]);
$template3rev->purgeRevision();
## Check how templates in the trash and clipboard are handled.

34
t/Asset/Template/HTMLTemplateExpr.t
View file

@ -27,26 +27,22 @@ plan tests => 2 + $num_tests;
my $session = WebGUI::Test->session;
# put your tests here
my ($versionTag, $template);
my $originalParsers = $session->config->get('templateParsers');
WebGUI::Test->originalConfig('templateParsers');
my $module = use_ok('HTML::Template::Expr');
my $plugin = use_ok('WebGUI::Asset::Template::HTMLTemplateExpr');
SKIP: {
skip "HTML::Template::Expr or plugin not loaded", $num_tests+1 unless $module;
my $plugin = use_ok('WebGUI::Asset::Template::HTMLTemplateExpr');
SKIP: {
skip "HTML::Template::Expr or plugin not loaded", $num_tests unless $plugin;
$session->config->set('templateParsers', ['WebGUI::Asset::Template::HTMLTemplate', 'WebGUI::Asset::Template::HTMLTemplateExpr',] );
($versionTag, $template) = setup_assets($session);
my $templateOutput = $template->process({ "foo.bar" => "baz", "number.value" => 2 });
my $companyName = $session->config->get('companyName');
like($templateOutput, qr/NAME=$companyName/, "session variable with underscores");
like($templateOutput, qr/FOOBAR=baz/, "explicit variable with dots");
like($templateOutput, qr/EQN=4/, "explicit variable with dots in expr");
}
skip "HTML::Template::Expr or plugin not loaded", $num_tests unless $plugin;
$session->config->set('templateParsers', ['WebGUI::Asset::Template::HTMLTemplate', 'WebGUI::Asset::Template::HTMLTemplateExpr',] );
my ($versionTag, $template) = setup_assets($session);
WebGUI::Test->addToCleanup($versionTag);
my $templateOutput = $template->process({ "foo.bar" => "baz", "number.value" => 2 });
my $companyName = $session->config->get('companyName');
like($templateOutput, qr/NAME=$companyName/, "session variable with underscores");
like($templateOutput, qr/FOOBAR=baz/, "explicit variable with dots");
like($templateOutput, qr/EQN=4/, "explicit variable with dots in expr");
}
sub setup_assets {
@ -67,9 +63,3 @@ sub setup_assets {
$versionTag->commit;
return ($versionTag, $template);
}
END {
if (defined $versionTag and ref $versionTag eq 'WebGUI::VersionTag') {
$versionTag->rollback;
}
}

57
t/Asset/Wobject/Calendar.t
View file

@ -120,10 +120,12 @@ cmp_deeply(
my $tz = $session->datetime->getTimeZone();
my $bday = WebGUI::DateTime->new($session, WebGUI::Test->webguiBirthday);
$dt = $bday->clone->truncate(to => 'day');
my $startDt = $dt->cloneToUserTimeZone->subtract(days => 1);
my $endDt = $dt->cloneToUserTimeZone->add(days => 1);
##Simulate how windows are built in each view method
my $startDt = $bday->cloneToUserTimeZone->truncate(to => 'day')->subtract(days => 1);
my $windowStart = $startDt->clone;
my $endDt = $startDt->clone->add(days => 2);
my $windowEnd = $endDt->clone->subtract(seconds => 1);
my $inside = $windowCal->addChild({
className => 'WebGUI::Asset::Event',
@ -217,6 +219,38 @@ my $justAfterwt = $windowCal->addChild({
timeZone => $tz,
}, undef, undef, {skipAutoCommitWorkflows => 1});
my $justBefore = $windowCal->addChild({
className => 'WebGUI::Asset::Event',
title => 'Just before the window. Ending date coincident with window start',
startDate => $startDt->clone->add(days => -1)->toDatabaseDate,
endDate => $startDt->clone->add(days => -1)->toDatabaseDate,
timeZone => $tz,
}, undef, undef, {skipAutoCommitWorkflows => 1});
my $justAfter = $windowCal->addChild({
className => 'WebGUI::Asset::Event',
title => 'Just after the window. Start date coincident with window end',
startDate => $endDt->clone->add(days => 1)->toDatabaseDate,
endDate => $endDt->clone->add(days => 1)->toDatabaseDate,
timeZone => $tz,
}, undef, undef, {skipAutoCommitWorkflows => 1});
my $starting = $windowCal->addChild({
className => 'WebGUI::Asset::Event',
title => 'Inside the window, same start date',
startDate => $startDt->toDatabaseDate,
endDate => $startDt->toDatabaseDate,
timeZone => $tz,
}, undef, undef, {skipAutoCommitWorkflows => 1});
my $ending = $windowCal->addChild({
className => 'WebGUI::Asset::Event',
title => 'Inside the window, same end date',
startDate => $endDt->clone->add(days => -1)->toDatabaseDate,
endDate => $endDt->clone->add(days => -1)->toDatabaseDate,
timeZone => $tz,
}, undef, undef, {skipAutoCommitWorkflows => 1});
my $coincident = $windowCal->addChild({
className => 'WebGUI::Asset::Event',
title => 'Coincident with the window start and window end',
@ -241,6 +275,7 @@ my $coincidentHigh = $windowCal->addChild({
timeZone => $tz,
}, undef, undef, {skipAutoCommitWorkflows => 1});
# no suffix = all day event
# wt suffix = with times
# inside
# insidewt
@ -252,7 +287,10 @@ my $coincidentHigh = $windowCal->addChild({
# |----------coincidentLow------------------|
# |--------------------coincidentHigh-------|
# window: |-------------------------------|
# starting--->|
# |<---ending
# justBeforewt justAfterwt
# justBefore justAfter
# outside high
# outside low
#
@ -262,16 +300,19 @@ my $tag2 = WebGUI::VersionTag->getWorking($session);
$tag2->commit;
addToCleanup($tag2);
is(scalar @{ $windowCal->getLineage(['children'])}, 13, 'added events to the window calendar');
is(scalar @{ $windowCal->getLineage(['children'])}, 17, 'added events to the window calendar');
my @window = $windowCal->getEventsIn($startDt->toDatabase, $endDt->toDatabase);
diag "startDate: ". $windowStart->toDatabase;
diag "endDate: ". $windowEnd->toDatabase;
my @window = $windowCal->getEventsIn($windowStart->toDatabase, $windowEnd->toDatabase);
cmp_bag(
[ map { $_->get('title') } @window ],
[ map { $_->get('title') }
($inside, $insidewt,
$straddle, $straddleHighwt, $straddleLowwt, $straddlewt,
$coincident, $coincidentLow, $coincidentHigh, )
$straddle, $straddleHighwt, $straddleLowwt, $straddlewt,
$coincident, $coincidentLow, $coincidentHigh, $starting,
$ending, )
],
'..returns correct set of events'
);
@ -368,7 +409,7 @@ my $monthCal = $node->addChild({
title => 'Calendar for doing event span testing, month',
});
$allDayDt = $bday->cloneToUserTimeZone;
$allDayDt = $bday->cloneToUserTimeZone;
my $nextMonthDt = $bday->cloneToUserTimeZone->add(months => 1)->truncate( to => 'month')->add(days => 29, hours => 19);
$allDay = $monthCal->addChild({

8
t/Asset/Wobject/Carousel.t
View file

@ -26,6 +26,7 @@ my $node = WebGUI::Asset->getImportNode($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"Search Test"});
WebGUI::Test->addToCleanup($versionTag);
my $carousel = $node->addChild({className=>'WebGUI::Asset::Wobject::Carousel'});
# Test for a sane object type
@ -41,9 +42,4 @@ foreach my $newSetting (keys %{$newSettings}) {
is ($carousel->get($newSetting), $newSettings->{$newSetting}, "updated $newSetting is ".$newSettings->{$newSetting});
}
END {
# Clean up after thy self
$versionTag->rollback();
}
#vim:ft=perl

7
t/Asset/Wobject/Collaboration/getThreads.t
View file

@ -25,6 +25,7 @@ use WebGUI::Session;
# Init
my $session = WebGUI::Test->session;
my @versionTags = ( WebGUI::VersionTag->getWorking( $session ) );
WebGUI::Test->addToCleanup($versionTags[-1]);
my @addChildArgs = ( {skipAutoCommitWorkflows=>1} );
my $collab = WebGUI::Asset->getImportNode( $session )->addChild({
className => 'WebGUI::Asset::Wobject::Collaboration',
@ -206,12 +207,6 @@ $session->request->setup_param({});
$session->scratch->delete($collab->getId.'_sortBy');
$session->scratch->delete($collab->getId.'_sortDir');
#----------------------------------------------------------------------------
# Cleanup
END {
$_->rollback for @versionTags;
}
#----------------------------------------------------------------------------
# sortThreads( \&sortSub, @threads )
# Sort threads according to the given subref. Return an arrayref of hashrefs

7
t/Asset/Wobject/Collaboration/permission.t
View file

@ -35,6 +35,7 @@ WebGUI::Test->addToCleanup($user{'2'});
my $versionTag = WebGUI::VersionTag->getWorking( $session );
$versionTag->set( { name => "Collaboration Test" } );
WebGUI::Test->addToCleanup($versionTag);
my @addArgs = ( undef, undef, { skipAutoCommitWorkflows => 1 } );
@ -106,8 +107,4 @@ $maker->prepare( {
fail => [ '1', $user{"2"}, ],
} )->run;
#----------------------------------------------------------------------------
# Cleanup
END {
$versionTag->rollback;
}
#vim:ft=perl

7
t/Asset/Wobject/DataForm/moveField.t
View file

@ -35,6 +35,7 @@ my $df = WebGUI::Asset->getImportNode( $session )
mailData => 0,
fieldConfiguration => '[]',
} );
WebGUI::Test->addToCleanup($df);
# Add three fields to the DataForm
$df->createField( "one", { label => "One" } );
@ -98,10 +99,4 @@ cmp_deeply(
);
#----------------------------------------------------------------------------
# Cleanup
END {
$df->purge;
WebGUI::VersionTag->getWorking( $session )->rollback;
}
#vim:ft=perl

8
t/Asset/Wobject/DataTable.t
View file

@ -27,8 +27,6 @@ use WebGUI::Session;
my $session = WebGUI::Test->session;
my $node = WebGUI::Asset->getImportNode( $session );
my $dt;
#----------------------------------------------------------------------------
# Tests
@ -41,6 +39,7 @@ my $dt = $node->addChild( {
className => 'WebGUI::Asset::Wobject::DataTable',
} );
isa_ok( $dt, 'WebGUI::Asset::Wobject::DataTable' );
WebGUI::Test->addToCleanup($dt);
#----------------------------------------------------------------------------
# Value and variables
@ -138,9 +137,4 @@ cmp_deeply(
"getTemplateVars returns complete and correct data structure",
);
#----------------------------------------------------------------------------
# Cleanup
END {
$dt->purge;
}
#vim:ft=perl

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

@ -25,6 +25,7 @@ my $session = WebGUI::Test->session;
my $node = WebGUI::Asset->getImportNode($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"Gallery Test"});
WebGUI::Test->addToCleanup($versionTag);
#----------------------------------------------------------------------------
# Tests

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

@ -25,6 +25,7 @@ my $session = WebGUI::Test->session;
my $node = WebGUI::Asset->getImportNode($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"Album Test"});
WebGUI::Test->addToCleanup($versionTag);
my $gallery
= $node->addChild({
className => "WebGUI::Asset::Wobject::Gallery",

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

@ -25,6 +25,7 @@ use WebGUI::Asset::Wobject::GalleryAlbum;
my $session = WebGUI::Test->session;
my $node = WebGUI::Asset->getImportNode($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
WebGUI::Test->addToCleanup($versionTag);
my %user;
$user{'1'} = WebGUI::User->new( $session, "new" );

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

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

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

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

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

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

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

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

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

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

2
t/Asset/Wobject/InOutBoard.t
View file

@ -148,7 +148,7 @@ cmp_bag(
ignore(), ignore(), ignore(), ignore(),
],
'view: returns one entry for each user, entry is correct for user with status'
);
) or diag(Dumper $templateVars->{rows_loop});
################################################################
#

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

@ -63,6 +63,12 @@ $canPostMaker->prepare({
fail => [1, $reader ],
});
my $tests = 51
+ $canPostMaker->plan
;
plan tests => 1
+ $tests;
#----------------------------------------------------------------------------
# put your tests here
@ -85,7 +91,6 @@ $archive = $home->addChild({
$versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->commit;
WebGUI::Test->addToCleanup($versionTag);
$archive = $archive->cloneFromDb;
isa_ok($archive, 'WebGUI::Asset::Wobject::StoryArchive', 'created StoryArchive');
@ -144,6 +149,17 @@ undef $sameFolder;
$todayFolder->purge;
is($archive->getChildCount, 0, 'leaving with an empty archive');
{
my $archive2 = $home->addChild({
className => 'WebGUI::Asset::Wobject::StoryArchive',
title => 'Uncommitted',
url => 'uncommitted_archive',
});
my $guard = WebGUI::Test->cleanupGuard($archive2);
my $new_folder = $archive2->getFolder;
is $archive2->get('tagId'), $new_folder->get('tagId'), 'folder added to uncommitted archive uses the same version tag';
}
################################################################
#
# addChild

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

@ -28,9 +28,11 @@ plan tests => $tests + 1;
#----------------------------------------------------------------------------
# put your tests here
my $e = "WebGUI::Asset::Wobject::Survey::ExpressionEngine";
use_ok($e);
my $usedOk = use_ok('WebGUI::Asset::Wobject::Survey::ExpressionEngine');
my $e = "WebGUI::Asset::Wobject::Survey::ExpressionEngine";
WebGUI::Test->originalConfig('enableSurveyExpressionEngine');
$session->config->set( 'enableSurveyExpressionEngine', 0 );
is( $e->run( $session, 'jump { 1 } target' ),
undef, "Nothing happens unless we turn on enableSurveyExpressionEngine in config" );
@ -240,6 +242,7 @@ cmp_deeply( $e->run( $session, qq{jump {taggedX('$url', ext_tag) == 199} target}
{
# Create a second test user
my $survey2 = WebGUI::Asset::Wobject::Survey->new($session, $survey->getId);
WebGUI::Test->addToCleanup($survey2);
my $user2 = WebGUI::User->new( $session, 'new' );
WebGUI::Test->addToCleanup($user2);
$session->user({userId => $user2->userId});
@ -261,3 +264,5 @@ cmp_deeply( $e->run( $session, qq{jump {taggedX('$url', ext_tag) == 199} target}
cmp_deeply( $e->run( $session, qq{jump {taggedX('$url', ext_tag) == 199} target}, {userId => $user->userId} ),
{ jump => 'target', tags => {} }, 'first external tag lookups still works' );
}
#vim:ft=perl

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

@ -36,6 +36,7 @@ my $import_node = WebGUI::Asset->getImportNode($session);
# Create a Survey
$survey = $import_node->addChild( { className => 'WebGUI::Asset::Wobject::Survey', } );
WebGUI::Test->addToCleanup($survey);
isa_ok($survey, 'WebGUI::Asset::Wobject::Survey');
my $sJSON = $survey->getSurveyJSON;
@ -125,11 +126,4 @@ superhashof({
})]);
#----------------------------------------------------------------------------
# Cleanup
END {
$survey->purge() if $survey;
my $versionTag = WebGUI::VersionTag->getWorking( $session, 1 );
$versionTag->rollback() if $versionTag;
}
#vim:ft=perl

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

@ -23,8 +23,6 @@ my $session = WebGUI::Test->session;
# Tests
plan tests => 94;
my ( $s, $t1 );
my $tp = use_ok('TAP::Parser');
my $tpa = use_ok('TAP::Parser::Aggregator');
@ -39,8 +37,9 @@ my $import_node = WebGUI::Asset->getImportNode($session);
$session->config->set('enableSurveyExpressionEngine', 1);
# Create a Survey
$s = $import_node->addChild( { className => 'WebGUI::Asset::Wobject::Survey', } );
my $s = $import_node->addChild( { className => 'WebGUI::Asset::Wobject::Survey', } );
isa_ok( $s, 'WebGUI::Asset::Wobject::Survey' );
WebGUI::Test->addToCleanup($s);
my $tag = WebGUI::VersionTag->getWorking($session);
$tag->commit;
@ -155,7 +154,8 @@ cmp_deeply(
'surveyOrderIndex correct'
);
$t1 = WebGUI::Asset::Wobject::Survey::Test->create( $session, { assetId => $s->getId } );
my $t1 = WebGUI::Asset::Wobject::Survey::Test->create( $session, { assetId => $s->getId } );
WebGUI::Test->addToCleanup(sub {$t1->delete();});
my $spec;
# No tests
@ -726,9 +726,4 @@ Hashes differ on element: a
expect : '2'
END_CMP
#----------------------------------------------------------------------------
# Cleanup
END {
$s->purge() if $s;
$t1->delete() if $t1;
}
#vim:ft=perl

7
t/Asset/Wobject/UserList.t
View file

@ -27,6 +27,7 @@ my $node = WebGUI::Asset->getImportNode($session);
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"UserList Test"});
WebGUI::Test->addToCleanup($versionTag);
my $userList = $node->addChild({className=>'WebGUI::Asset::Wobject::UserList'});
# Test for a sane object type
@ -45,8 +46,4 @@ foreach my $newSetting (keys %{$newUserListSettings}) {
is ($userList->get($newSetting), $newUserListSettings->{$newSetting}, "updated $newSetting is ".$newUserListSettings->{$newSetting});
}
END {
# Clean up after thy self
$versionTag->rollback();
}
#vim:ft=perl