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

Merge commit '17ce3572bf' into WebGUI8. All tests passing.

Browse source
This commit is contained in:
Colin Kuskie 2010-06-30 18:43:27 -07:00
commit 5e502fee53
117 changed files with 2012 additions and 1027 deletions
Download patch file Download diff file Expand all files Collapse all files

38
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;
@ -85,8 +85,15 @@ my $snippet2 = $folder2->addChild( {
});
$versionTag->commit;
my @snipIds;
my $lineageIds;
####################################################
#
# getLineageSql
#
####################################################
note "getLineageSql";
ok $root->getLineageSql(['ancestors']), 'valid SQL returned in an error condition';
####################################################
#
@ -94,12 +101,8 @@ my $lineageIds;
#
####################################################
my $ids = $folder->getLineage(['self']);
cmp_deeply(
[$folder->getId],
$ids,
'getLineage: get self'
);
my @snipIds;
my $lineageIds;
@snipIds = map { $_->getId } @snippets;
$lineageIds = $folder->getLineage(['descendants']);
@ -107,7 +110,7 @@ $lineageIds = $folder->getLineage(['descendants']);
cmp_deeply($lineageIds, \@snipIds, 'default order returned by getLineage is lineage order');
@snipIds = map { $_->getId } @snippets;
$ids = $folder->getLineage(['descendants']);
my $ids = $folder->getLineage(['descendants']);
cmp_bag(
\@snipIds,
$ids,
@ -143,6 +146,13 @@ cmp_bag(
'... descendants of topFolder',
);
my $empty = getListFromIterator($root->getLineageIterator(['ancestors']));
cmp_bag(
$empty,
[],
'... getting ancestors of root returns empty array'
);
####################################################
#
# getLineageIterator
@ -194,6 +204,14 @@ cmp_bag(
'getLineageIterator: descendants of topFolder',
);
my $empty = getListFromIterator($root->getLineageIterator(['ancestors']));
cmp_bag(
$empty,
[],
'... getting ancestors of root returns empty array'
);
####################################################
#
# getFirstChild

8
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);
####################################################
#
@ -229,11 +230,4 @@ 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;
}
}
}

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

1
t/Asset/Event.t
View file

@ -129,6 +129,7 @@ sleep 2;
my $event6a = $event6->addRevision({ title => 'Event with storage', }, undef, { skipAutoCommitWorkflows => 1, });
ok($session->id->valid($event6a->get('storageId')), 'addRevision gives the new revision a valid storageId');
isnt($event6a->get('storageId'), $event6->get('storageId'), '... and it is different from the previous revision');
my $versionTag2 = WebGUI::VersionTag->getWorking($session);
WebGUI::Test->addToCleanup($versionTag2);
$versionTag2->commit;

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

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

4
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,
@ -440,3 +440,5 @@ cmp_bag(
'...asset package data has the storage locations in it'
);
#vim:ft=perl

33
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 {
@ -68,8 +64,3 @@ sub setup_assets {
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

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});
################################################################
#

10
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
@ -729,6 +729,4 @@ END_CMP
#----------------------------------------------------------------------------
# Cleanup
END {
$s->purge() if $s;
$t1->delete() if $t1;
}

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