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

341
t/AdSpace.t
View file

@ -35,200 +35,191 @@ $numTests += 2 * scalar keys %{ $newAdSpaceSettings };
plan tests => $numTests;
my $session = WebGUI::Test->session;
my ($adSpace, $alfred, $alfred2, $bruce, $catWoman, $villianClone, $defaultAdSpace );
my ($adSpace, $alfred, $alfred2, $bruce, $catWoman, );
my ($jokerAd, $penguinAd, $twoFaceAd);
$session->request->env->{REMOTE_ADDR} = '10.0.0.1';
$session->request->env->{HTTP_USER_AGENT} = 'Mozilla/5.0';
$session->request->env->{REMOTE_ADDR} = '10.0.0.1';
$session->request->env->{HTTP_USER_AGENT} = 'Mozilla/5.0';
$adSpace = WebGUI::AdSpace->create($session, {name=>"Alfred"});
$adSpace = WebGUI::AdSpace->create($session, {name=>"Alfred"});
isa_ok($adSpace, 'WebGUI::AdSpace');
isa_ok($adSpace, 'WebGUI::AdSpace');
WebGUI::Test->addToCleanup($adSpace);
my $data = $session->db->quickHashRef("select adSpaceId, name from adSpace where adSpaceId=?",[$adSpace->getId]);
my $data = $session->db->quickHashRef("select adSpaceId, name from adSpace where adSpaceId=?",[$adSpace->getId]);
ok(exists $data->{adSpaceId}, "create()");
is($data->{name}, $adSpace->get("name"), "get()");
is($data->{adSpaceId}, $adSpace->getId, "getId()");
ok(exists $data->{adSpaceId}, "create()");
is($data->{name}, $adSpace->get("name"), "get()");
is($data->{adSpaceId}, $adSpace->getId, "getId()");
$alfred = WebGUI::AdSpace->newByName($session, 'Alfred');
$alfred = WebGUI::AdSpace->newByName($session, 'Alfred');
WebGUI::Test->addToCleanup($alfred);
cmp_deeply($adSpace, $alfred, 'newByName returns identical object if name exists');
cmp_deeply($adSpace, $alfred, 'newByName returns identical object if name exists');
$bruce = WebGUI::AdSpace->newByName($session, 'Bruce');
is($bruce, undef, 'newByName returns undef if the name does not exist');
$bruce = WebGUI::AdSpace->newByName($session, 'Bruce');
is($bruce, undef, 'newByName returns undef if the name does not exist');
$bruce = WebGUI::AdSpace->new($session, $session->getId);
is($bruce, undef, 'new returns undef if the id does not exist');
$bruce = WebGUI::AdSpace->new($session, $session->getId);
is($bruce, undef, 'new returns undef if the id does not exist');
$alfred2 = WebGUI::AdSpace->create($session);
is($alfred2, undef, 'create returns undef unless you pass it a name');
$alfred2 = WebGUI::AdSpace->create($session);
is($alfred2, undef, 'create returns undef unless you pass it a name');
$alfred2 = WebGUI::AdSpace->create($session, {name => 'Alfred'});
is($alfred2, undef, 'create returns undef if the name already exists');
$alfred2 = WebGUI::AdSpace->create($session, {name => 'Alfred'});
is($alfred2, undef, 'create returns undef if the name already exists');
isa_ok($alfred->session, 'WebGUI::Session');
isa_ok($alfred->session, 'WebGUI::Session');
undef $alfred2;
undef $alfred2;
$alfred->set({title => "Alfred's Ad"});
is($alfred->get('title'), "Alfred's Ad", "get, set work on title");
$alfred->set({title => "Alfred's Ad"});
is($alfred->get('title'), "Alfred's Ad", "get, set work on title");
$bruce = WebGUI::AdSpace->create($session, {name => 'Bruce'});
$bruce->set({title => "Bruce's Ad"});
$bruce = WebGUI::AdSpace->create($session, {name => 'Bruce'});
$bruce->set({title => "Bruce's Ad"});
WebGUI::Test->addToCleanup($bruce);
$catWoman = WebGUI::AdSpace->create($session, {name => 'CatWoman'});
$catWoman->set({title => "CatWoman's Ad"});
$catWoman = WebGUI::AdSpace->create($session, {name => 'CatWoman'});
$catWoman->set({title => "CatWoman's Ad"});
WebGUI::Test->addToCleanup($catWoman);
my $adSpaces = WebGUI::AdSpace->getAdSpaces($session);
my $adSpaces = WebGUI::AdSpace->getAdSpaces($session);
cmp_deeply($adSpaces, [$alfred, $bruce, $catWoman], 'getAdSpaces returns all AdSpaces in alphabetical order by title');
cmp_deeply($adSpaces, [$alfred, $bruce, $catWoman], 'getAdSpaces returns all AdSpaces in alphabetical order by title');
$catWoman->set($newAdSpaceSettings);
foreach my $setting (keys %{ $newAdSpaceSettings } ) {
is($newAdSpaceSettings->{$setting}, $catWoman->get($setting),
sprintf "set and get for %s", $setting);
}
##Bare call to set doesn't change anything
$catWoman->set();
foreach my $setting (keys %{ $newAdSpaceSettings } ) {
is($newAdSpaceSettings->{$setting}, $catWoman->get($setting),
sprintf "empty call to set does not change %s", $setting);
}
$catWoman->set({title => '', name => '', description => '', });
is ($catWoman->get('title'), '', 'set can clear the title');
is ($catWoman->get('description'), '', 'set can clear the title');
is ($catWoman->get('name' ), $newAdSpaceSettings->{'name'}, 'set can not clear the name');
##Create a set of ads for general purpose testing
##The Joker and Penguin Ads go in the bruce adSpace
##The Two Face ad goes in the catWoman adSpace
$jokerAd = WebGUI::AdSpace::Ad->create($session, $bruce->getId,
{
title => 'Joker',
url => '/ha_ha',
type => 'rich',
richMedia => 'Joker',
priority => 2,
isActive => 1,
clicksBought => 0,
impressionsBought => 2,
}
);
$penguinAd = WebGUI::AdSpace::Ad->create($session, $bruce->getId,
{
title => 'Penguin',
url => '/fishy',
type => 'rich',
richMedia => 'Penguin',
priority => 1,
isActive => 1,
clicksBought => 4,
impressionsBought => 0,
}
);
$twoFaceAd = WebGUI::AdSpace::Ad->create($session, $catWoman->getId,
{
title => 'Two Face',
url => '/dent',
type => 'rich',
richMedia => 'Two Face',
priority => 500,
isActive => 1,
clicksBought => 0,
impressionsBought => 0,
}
);
##getAds
my @bruceAdTitles = map { $_->get('title') } @{ $bruce->getAds };
my @catWomanAdTitles = map { $_->get('title') } @{ $catWoman->getAds };
cmp_bag(\@bruceAdTitles, ['Joker', 'Penguin'], 'Got the set of Ads for bruce');
cmp_bag(\@catWomanAdTitles, ['Two Face'], 'Got the set of Ads for catWoman');
##countClicks
my $penguinUrl = WebGUI::AdSpace->countClick($session, $penguinAd->getId);
is($penguinUrl, $penguinAd->get('url'), 'clicking on the penguin ad returns the penguin url');
WebGUI::AdSpace->countClick($session, $penguinAd->getId);
WebGUI::AdSpace->countClick($session, $penguinAd->getId);
my $jokerUrl = WebGUI::AdSpace->countClick($session, $jokerAd->getId);
is($jokerUrl, $jokerAd->get('url'), 'clicking on the joker ad returns the joker url');
my $twoFaceUrl = WebGUI::AdSpace->countClick($session, $twoFaceAd->getId);
is($twoFaceUrl, $twoFaceAd->get('url'), 'clicking on the twoFace ad returns the twoFace url');
my ($penguinClicks) = $session->db->quickArray('select clicks from advertisement where adId=?',[$penguinAd->getId]);
is($penguinClicks, 3, 'counted penguin clicks correctly');
my ($jokerClicks) = $session->db->quickArray('select clicks from advertisement where adId=?',[$jokerAd->getId]);
is($jokerClicks, 1, 'counted joker clicks correctly');
my ($twoFaceClicks) = $session->db->quickArray('select clicks from advertisement where adId=?',[$twoFaceAd->getId]);
is($twoFaceClicks, 1, 'counted twoFace clicks correctly');
##displayImpression
my ($twoFaceImpressions, $twoFacePriority) =
$session->db->quickArray('select impressions,nextInPriority from advertisement where adId=?',[$twoFaceAd->getId]);
is($catWoman->displayImpression(1), $twoFaceAd->get('renderedAd'), 'displayImpression returns the ad');
cmp_bag(
[$twoFaceImpressions, $twoFacePriority],
[$session->db->quickArray('select impressions,nextInPriority from advertisement where adId=?',[$twoFaceAd->getId])],
'displayImpressions: impresssions and nextInPriority are not updated when dontCount=1',
);
$catWoman->displayImpression();
my $twoFaceTime = time();
is(
$session->db->quickArray('select impressions from advertisement where adId=?',[$twoFaceAd->getId]),
1, 'displayImpression added 1 impression'
);
my ($newTwoFacePriority) = $session->db->quickArray('select nextInPriority from advertisement where adId=?',[$twoFaceAd->getId]);
isnt($newTwoFacePriority, $twoFacePriority, 'displayImpression changed the nextInPriority');
cmp_ok(
abs($twoFaceTime + $twoFaceAd->get('priority') - $newTwoFacePriority),
'<=',
'2',
'displayImpression set the nextInPriority correctly'
);
my ($twoFaceIsActive) = $session->db->quickArray('select isActive from advertisement where adId=?',[$twoFaceAd->getId]);
is($twoFaceIsActive, 0, 'displayImpression deactivates an ad if enough impressions and clicks are bought');
$session->db->write('update advertisement set nextInPriority=UNIX_TIMESTAMP()+100000 where adId=?',[$jokerAd->getId]);
is($bruce->displayImpression(), $penguinAd->get('renderedAd'), 'displayImpression returns earliest by nextInPriority, penguin has 3 clicks');
WebGUI::AdSpace->countClick($session, $penguinAd->getId); ##4 clicks
is($bruce->displayImpression(), $penguinAd->get('renderedAd'), 'displayImpression returns still returns penguinAd, but deactivates it after 4 clicks');
my ($penguinActive) = $session->db->quickArray('select isActive from advertisement where adId=?',[$penguinAd->getId]);
is($penguinActive, 0, 'displayImpression deactiveated penguinAd');
is($bruce->displayImpression(), $jokerAd->get('renderedAd'), 'displayImpression now returns jokerAd');
my ($jokerActive) = $session->db->quickArray('select isActive from advertisement where adId=?',[$jokerAd->getId]);
is($jokerActive, 1, 'displayImpression did not deactiveate jokerAd after one impression');
$bruce->displayImpression();
($jokerActive) = $session->db->quickArray('select isActive from advertisement where adId=?',[$jokerAd->getId]);
is($jokerActive, 0, 'displayImpression deactivated jokerAd after two impressions');
END {
foreach my $ad_space ($adSpace, $bruce, $alfred, $alfred2, $catWoman, $defaultAdSpace ) {
if (defined $ad_space and ref $ad_space eq 'WebGUI::AdSpace') {
$ad_space->delete;
}
}
foreach my $advert ($jokerAd, $penguinAd, $villianClone, $twoFaceAd) {
if (defined $advert and ref $advert eq 'WebGUI::AdSpace::Ad') {
$advert->delete;
}
}
$catWoman->set($newAdSpaceSettings);
foreach my $setting (keys %{ $newAdSpaceSettings } ) {
is($newAdSpaceSettings->{$setting}, $catWoman->get($setting),
sprintf "set and get for %s", $setting);
}
##Bare call to set doesn't change anything
$catWoman->set();
foreach my $setting (keys %{ $newAdSpaceSettings } ) {
is($newAdSpaceSettings->{$setting}, $catWoman->get($setting),
sprintf "empty call to set does not change %s", $setting);
}
$catWoman->set({title => '', name => '', description => '', });
is ($catWoman->get('title'), '', 'set can clear the title');
is ($catWoman->get('description'), '', 'set can clear the title');
is ($catWoman->get('name' ), $newAdSpaceSettings->{'name'}, 'set can not clear the name');
##Create a set of ads for general purpose testing
##The Joker and Penguin Ads go in the bruce adSpace
##The Two Face ad goes in the catWoman adSpace
$jokerAd = WebGUI::AdSpace::Ad->create($session, $bruce->getId,
{
title => 'Joker',
url => '/ha_ha',
type => 'rich',
richMedia => 'Joker',
priority => 2,
isActive => 1,
clicksBought => 0,
impressionsBought => 2,
}
);
$penguinAd = WebGUI::AdSpace::Ad->create($session, $bruce->getId,
{
title => 'Penguin',
url => '/fishy',
type => 'rich',
richMedia => 'Penguin',
priority => 1,
isActive => 1,
clicksBought => 4,
impressionsBought => 0,
}
);
$twoFaceAd = WebGUI::AdSpace::Ad->create($session, $catWoman->getId,
{
title => 'Two Face',
url => '/dent',
type => 'rich',
richMedia => 'Two Face',
priority => 500,
isActive => 1,
clicksBought => 0,
impressionsBought => 0,
}
);
##getAds
my @bruceAdTitles = map { $_->get('title') } @{ $bruce->getAds };
my @catWomanAdTitles = map { $_->get('title') } @{ $catWoman->getAds };
cmp_bag(\@bruceAdTitles, ['Joker', 'Penguin'], 'Got the set of Ads for bruce');
cmp_bag(\@catWomanAdTitles, ['Two Face'], 'Got the set of Ads for catWoman');
##countClicks
my $penguinUrl = WebGUI::AdSpace->countClick($session, $penguinAd->getId);
is($penguinUrl, $penguinAd->get('url'), 'clicking on the penguin ad returns the penguin url');
WebGUI::AdSpace->countClick($session, $penguinAd->getId);
WebGUI::AdSpace->countClick($session, $penguinAd->getId);
my $jokerUrl = WebGUI::AdSpace->countClick($session, $jokerAd->getId);
is($jokerUrl, $jokerAd->get('url'), 'clicking on the joker ad returns the joker url');
my $twoFaceUrl = WebGUI::AdSpace->countClick($session, $twoFaceAd->getId);
is($twoFaceUrl, $twoFaceAd->get('url'), 'clicking on the twoFace ad returns the twoFace url');
my ($penguinClicks) = $session->db->quickArray('select clicks from advertisement where adId=?',[$penguinAd->getId]);
is($penguinClicks, 3, 'counted penguin clicks correctly');
my ($jokerClicks) = $session->db->quickArray('select clicks from advertisement where adId=?',[$jokerAd->getId]);
is($jokerClicks, 1, 'counted joker clicks correctly');
my ($twoFaceClicks) = $session->db->quickArray('select clicks from advertisement where adId=?',[$twoFaceAd->getId]);
is($twoFaceClicks, 1, 'counted twoFace clicks correctly');
##displayImpression
my ($twoFaceImpressions, $twoFacePriority) =
$session->db->quickArray('select impressions,nextInPriority from advertisement where adId=?',[$twoFaceAd->getId]);
is($catWoman->displayImpression(1), $twoFaceAd->get('renderedAd'), 'displayImpression returns the ad');
cmp_bag(
[$twoFaceImpressions, $twoFacePriority],
[$session->db->quickArray('select impressions,nextInPriority from advertisement where adId=?',[$twoFaceAd->getId])],
'displayImpressions: impresssions and nextInPriority are not updated when dontCount=1',
);
$catWoman->displayImpression();
my $twoFaceTime = time();
is(
$session->db->quickArray('select impressions from advertisement where adId=?',[$twoFaceAd->getId]),
1, 'displayImpression added 1 impression'
);
my ($newTwoFacePriority) = $session->db->quickArray('select nextInPriority from advertisement where adId=?',[$twoFaceAd->getId]);
isnt($newTwoFacePriority, $twoFacePriority, 'displayImpression changed the nextInPriority');
cmp_ok(
abs($twoFaceTime + $twoFaceAd->get('priority') - $newTwoFacePriority),
'<=',
'2',
'displayImpression set the nextInPriority correctly'
);
my ($twoFaceIsActive) = $session->db->quickArray('select isActive from advertisement where adId=?',[$twoFaceAd->getId]);
is($twoFaceIsActive, 0, 'displayImpression deactivates an ad if enough impressions and clicks are bought');
$session->db->write('update advertisement set nextInPriority=UNIX_TIMESTAMP()+100000 where adId=?',[$jokerAd->getId]);
is($bruce->displayImpression(), $penguinAd->get('renderedAd'), 'displayImpression returns earliest by nextInPriority, penguin has 3 clicks');
WebGUI::AdSpace->countClick($session, $penguinAd->getId); ##4 clicks
is($bruce->displayImpression(), $penguinAd->get('renderedAd'), 'displayImpression returns still returns penguinAd, but deactivates it after 4 clicks');
my ($penguinActive) = $session->db->quickArray('select isActive from advertisement where adId=?',[$penguinAd->getId]);
is($penguinActive, 0, 'displayImpression deactiveated penguinAd');
is($bruce->displayImpression(), $jokerAd->get('renderedAd'), 'displayImpression now returns jokerAd');
my ($jokerActive) = $session->db->quickArray('select isActive from advertisement where adId=?',[$jokerAd->getId]);
is($jokerActive, 1, 'displayImpression did not deactiveate jokerAd after one impression');
$bruce->displayImpression();
($jokerActive) = $session->db->quickArray('select isActive from advertisement where adId=?',[$jokerAd->getId]);
is($jokerActive, 0, 'displayImpression deactivated jokerAd after two impressions');
#vim:ft=perl

303
t/AdSpace/Ad.t
View file

@ -45,171 +45,162 @@ plan tests => $numTests;
my $session = WebGUI::Test->session;
my $ad;
my ($richAd, $textAd, $imageAd, $nonAd, $setAd);
my $adSpace;
my $imageStorage = WebGUI::Storage->create($session);
WebGUI::Test->addToCleanup($imageStorage);
$imageStorage->addFileFromScalar('foo.bmp', 'This is not really an image');
$session->request->env->{REMOTE_ADDR} = '10.0.0.1';
$session->request->env->{HTTP_USER_AGENT} = 'Mozilla/5.0';
$session->request->env->{REMOTE_ADDR} = '10.0.0.1';
$session->request->env->{HTTP_USER_AGENT} = 'Mozilla/5.0';
$adSpace = WebGUI::AdSpace->create($session, {name=>"Tim Robbins"});
$ad=WebGUI::AdSpace::Ad->create($session, $adSpace->getId, {"type" => "text"});
isa_ok($ad,"WebGUI::AdSpace::Ad");
my $adSpace = WebGUI::AdSpace->create($session, {name=>"Tim Robbins"});
WebGUI::Test->addToCleanup($adSpace);
$ad=WebGUI::AdSpace::Ad->create($session, $adSpace->getId, {"type" => "text"});
isa_ok($ad,"WebGUI::AdSpace::Ad");
isa_ok($ad->session, 'WebGUI::Session');
is($ad->get('type'), 'text', 'property set during object creation');
isa_ok($ad->session, 'WebGUI::Session');
is($ad->get('type'), 'text', 'property set during object creation');
my $ad2 = WebGUI::AdSpace::Ad->new($session, $ad->getId);
cmp_deeply($ad2, $ad, "new returns an identical object to the original what was created");
my $ad2 = WebGUI::AdSpace::Ad->new($session, $ad->getId);
cmp_deeply($ad2, $ad, "new returns an identical object to the original what was created");
undef $ad2;
undef $ad2;
my $data = $session->db->quickHashRef("select adId, adSpaceId from advertisement where adId=?",[$ad->getId]);
my $data = $session->db->quickHashRef("select adId, adSpaceId from advertisement where adId=?",[$ad->getId]);
ok(exists $data->{adId}, "create()");
is($data->{adId}, $ad->getId, "getId()");
is($data->{adSpaceId}, $ad->get('adSpaceId'), "get() adSpaceId");
ok(exists $data->{adId}, "create()");
is($data->{adId}, $ad->getId, "getId()");
is($data->{adSpaceId}, $ad->get('adSpaceId'), "get() adSpaceId");
foreach my $setting (keys %{ $newAdSettings } ) {
is($newAdSettings->{$setting}, $ad->get($setting),
sprintf "default setting for %s", $setting);
}
$richAd = WebGUI::AdSpace::Ad->create($session, $adSpace->getId);
$richAd->set({
type => 'rich',
richMedia => 'This is rich, ^@;'
});
my $renderedAd = $richAd->get('renderedAd');
my $userName = $session->user->username;
like($renderedAd, qr/This is rich, $userName/, 'Rich media ads render macros');
##In this series of tests, we'll render a text ad and then pick it apart and make
##sure that all the requisite components are in there.
$adSpace->set({
width => 102,
height => 202
});
$textAd = WebGUI::AdSpace::Ad->create($session, $adSpace->getId);
$textAd->set({
type => 'text',
borderColor => 'black',
backgroundColor => 'white',
textColor => 'blue',
title => 'This is a text ad',
adText => 'Will hack for Gooey dolls.',
});
my $renderedTextAd = $textAd->get('renderedAd');
my $textP = HTML::TokeParser->new(\$renderedTextAd);
##Outer div checks
my $token = $textP->get_tag("div");
my $style = $token->[1]{style};
like($style, qr/height:200/, 'adSpace height rendered correctly');
like($style, qr/width:100/, 'adSpace width rendered correctly');
like($style, qr/border:solid black/, 'ad borderColor rendered correctly');
##Link checks
$token = $textP->get_tag("a");
my $href = $token->[1]{onclick};
like($href, qr/op=clickAd/, 'ad link has correct operation');
my $adId = $textAd->getId;
like($href, qr/id=\Q$adId\E/, 'ad link has correct ad id');
$style = $token->[1]{style};
like($style, qr/background-color:white/, 'ad link background is white');
$token = $textP->get_tag("span");
$style = $token->[1]{style};
like($style, qr/color:blue/, 'ad title text foreground is blue');
$token = $textP->get_tag("span");
$style = $token->[1]{style};
like($style, qr/color:blue/, 'ad title text foreground is blue');
my $adText = $textP->get_trimmed_text('/span');
is($adText, $textAd->get('adText'), 'ad text is correct');
##Ditto for the image ad
$adSpace->set({
width => 250,
height => 250
});
$imageAd = WebGUI::AdSpace::Ad->create($session, $adSpace->getId);
$imageAd->set({
type => 'image',
title => 'This is an image ad',
storageId => $imageStorage->getId,
});
my $renderedImageAd = $imageAd->get('renderedAd');
my $textP = HTML::TokeParser->new(\$renderedImageAd);
##Outer div checks
my $token = $textP->get_tag("div");
my $style = $token->[1]{style};
like($style, qr/height:250/, 'adSpace height rendered correctly, image');
like($style, qr/width:250/, 'adSpace width rendered correctly, image');
##Link checks
$token = $textP->get_tag("a");
my $href = $token->[1]{onclick};
like($href, qr/op=clickAd/, 'ad link has correct operation, image');
$adId = $imageAd->getId;
like($href, qr/id=\Q$adId\E/, 'ad link has correct ad id, image');
$token = $textP->get_tag("img");
$style = $token->[1]{src};
is($style, $imageStorage->getUrl($imageStorage->getFiles->[0]), 'ad image points at correct file');
$style = $token->[1]{alt};
is($style, $imageAd->get('title'), 'ad title matches, image');
my $nonAdProperties = {
type => 'nothing',
title => 'This ad will never render',
};
$nonAd = WebGUI::AdSpace::Ad->create($session, $adSpace->getId, $nonAdProperties);
my $renderedNonAd = $nonAd->get('renderedAd');
is($renderedNonAd, undef, 'undefined ad types are not rendered');
$nonAd->delete;
$nonAd = WebGUI::AdSpace::Ad->new($session, 'nonExistantId');
is($nonAd, undef, 'requesting a non-existant id via new returns undef');
my $setAd = WebGUI::AdSpace::Ad->create($session, $adSpace->getId, {isActive => 1});
is($setAd->get('isActive'), 1, 'set isActive true during instantiation');
$setAd->set({isActive=>0});
is($setAd->get('isActive'), 0, 'set isActive false during instantiation');
$setAd->delete;
my $setAd = WebGUI::AdSpace::Ad->create($session, $adSpace->getId, {priority => 1});
is($setAd->get('priority'), 1, 'set priority=1 during instantiation');
$setAd->set({priority=>0});
is($setAd->get('priority'), 0, 'set priority=0');
$setAd->set({ title => 'myTitle', url => 'http://www.nowhere.com', adText => 'Performing a valuable service for the community'});
is($setAd->get('url'), 'http://www.nowhere.com', 'set: url');
is($setAd->get('adText'), 'Performing a valuable service for the community', 'set: adText');
$setAd->set({ url => '', adText => ''});
is($setAd->get('url'), '', 'set: clearing url');
is($setAd->get('adText'), '', 'set: clearing adText');
END {
foreach my $advertisement ($ad, $richAd, $textAd, $imageAd, $nonAd, $setAd) {
if (defined $advertisement and ref $advertisement eq 'WebGUI::AdSpace::Ad') {
$advertisement->delete;
}
}
if (defined $adSpace and ref $adSpace eq 'WebGUI::AdSpace') {
$adSpace->delete;
}
foreach my $setting (keys %{ $newAdSettings } ) {
is($newAdSettings->{$setting}, $ad->get($setting),
sprintf "default setting for %s", $setting);
}
$richAd = WebGUI::AdSpace::Ad->create($session, $adSpace->getId);
$richAd->set({
type => 'rich',
richMedia => 'This is rich, ^@;'
});
my $renderedAd = $richAd->get('renderedAd');
my $userName = $session->user->username;
like($renderedAd, qr/This is rich, $userName/, 'Rich media ads render macros');
##In this series of tests, we'll render a text ad and then pick it apart and make
##sure that all the requisite components are in there.
$adSpace->set({
width => 102,
height => 202
});
$textAd = WebGUI::AdSpace::Ad->create($session, $adSpace->getId);
$textAd->set({
type => 'text',
borderColor => 'black',
backgroundColor => 'white',
textColor => 'blue',
title => 'This is a text ad',
adText => 'Will hack for Gooey dolls.',
});
my $renderedTextAd = $textAd->get('renderedAd');
my $textP = HTML::TokeParser->new(\$renderedTextAd);
##Outer div checks
my $token = $textP->get_tag("div");
my $style = $token->[1]{style};
like($style, qr/height:200/, 'adSpace height rendered correctly');
like($style, qr/width:100/, 'adSpace width rendered correctly');
like($style, qr/border:solid black/, 'ad borderColor rendered correctly');
##Link checks
$token = $textP->get_tag("a");
my $href = $token->[1]{onclick};
like($href, qr/op=clickAd/, 'ad link has correct operation');
my $adId = $textAd->getId;
like($href, qr/id=\Q$adId\E/, 'ad link has correct ad id');
$style = $token->[1]{style};
like($style, qr/background-color:white/, 'ad link background is white');
$token = $textP->get_tag("span");
$style = $token->[1]{style};
like($style, qr/color:blue/, 'ad title text foreground is blue');
$token = $textP->get_tag("span");
$style = $token->[1]{style};
like($style, qr/color:blue/, 'ad title text foreground is blue');
my $adText = $textP->get_trimmed_text('/span');
is($adText, $textAd->get('adText'), 'ad text is correct');
##Ditto for the image ad
$adSpace->set({
width => 250,
height => 250
});
$imageAd = WebGUI::AdSpace::Ad->create($session, $adSpace->getId);
$imageAd->set({
type => 'image',
title => 'This is an image ad',
storageId => $imageStorage->getId,
});
my $renderedImageAd = $imageAd->get('renderedAd');
my $textP = HTML::TokeParser->new(\$renderedImageAd);
##Outer div checks
my $token = $textP->get_tag("div");
my $style = $token->[1]{style};
like($style, qr/height:250/, 'adSpace height rendered correctly, image');
like($style, qr/width:250/, 'adSpace width rendered correctly, image');
##Link checks
$token = $textP->get_tag("a");
my $href = $token->[1]{onclick};
like($href, qr/op=clickAd/, 'ad link has correct operation, image');
$adId = $imageAd->getId;
like($href, qr/id=\Q$adId\E/, 'ad link has correct ad id, image');
$token = $textP->get_tag("img");
$style = $token->[1]{src};
is($style, $imageStorage->getUrl($imageStorage->getFiles->[0]), 'ad image points at correct file');
$style = $token->[1]{alt};
is($style, $imageAd->get('title'), 'ad title matches, image');
my $nonAdProperties = {
type => 'nothing',
title => 'This ad will never render',
};
$nonAd = WebGUI::AdSpace::Ad->create($session, $adSpace->getId, $nonAdProperties);
my $renderedNonAd = $nonAd->get('renderedAd');
is($renderedNonAd, undef, 'undefined ad types are not rendered');
$nonAd->delete;
$nonAd = WebGUI::AdSpace::Ad->new($session, 'nonExistantId');
is($nonAd, undef, 'requesting a non-existant id via new returns undef');
my $setAd = WebGUI::AdSpace::Ad->create($session, $adSpace->getId, {isActive => 1});
is($setAd->get('isActive'), 1, 'set isActive true during instantiation');
$setAd->set({isActive=>0});
is($setAd->get('isActive'), 0, 'set isActive false during instantiation');
$setAd->delete;
my $setAd = WebGUI::AdSpace::Ad->create($session, $adSpace->getId, {priority => 1});
is($setAd->get('priority'), 1, 'set priority=1 during instantiation');
$setAd->set({priority=>0});
is($setAd->get('priority'), 0, 'set priority=0');
$setAd->set({ title => 'myTitle', url => 'http://www.nowhere.com', adText => 'Performing a valuable service for the community'});
is($setAd->get('url'), 'http://www.nowhere.com', 'set: url');
is($setAd->get('adText'), 'Performing a valuable service for the community', 'set: adText');
$setAd->set({ url => '', adText => ''});
is($setAd->get('url'), '', 'set: clearing url');
is($setAd->get('adText'), '', 'set: clearing adText');
#vim:ft=perl

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

1
t/Auth/mech.t
View file

@ -70,6 +70,7 @@ my $asset
});
$versionTag->commit;
my $assetUrl = $baseUrl . $asset->get('url');
WebGUI::Test->addToCleanup($versionTag);
#----------------------------------------------------------------------------
# Tests

3
t/Config.t
View file

@ -16,6 +16,7 @@ use WebGUI::Test;
use Test::More tests => 14; # increment this value for each test you create
use Test::Deep;
use File::Basename qw(basename);
use Cwd;
my $config = WebGUI::Test->config;
my $configFile = WebGUI::Test->file;
@ -83,5 +84,7 @@ if ($cookieName eq "") {
}
$config->set('privateArray', ['a', 'b', 'c']);
WebGUI::Test->addToCleanup(sub { $config->delete('privateArray')});
cmp_bag($config->get('privateArray'), ['a', 'b', 'c'], 'set: array, not scalar');
#vim:ft=perl

8
t/Crud.t
View file

@ -34,6 +34,7 @@ plan tests => 55; # Increment this number for each test you create
# check table structure
WebGUI::Crud->crud_createTable($session);
WebGUI::Test->addToCleanup(sub { WebGUI::Crud->crud_dropTable($session); });
my $sth = $session->db->read("describe unnamed_crud_table");
my ($col, $type) = $sth->array();
is($col, 'id', "structure: id name");
@ -139,11 +140,4 @@ is(WebGUI::Crud->crud_getTableKey($session), 'id', 'default key is id');
is(WebGUI::Crud->crud_getTableName($session), 'unnamed_crud_table', 'default table is unnamed_crud_table');
is(WebGUI::Crud->crud_getSequenceKey($session), '', 'default sequence key is blank');
#----------------------------------------------------------------------------
# Cleanup
END {
WebGUI::Crud->crud_dropTable($session);
}
#vim:ft=perl

8
t/Crud/Subclass.t
View file

@ -30,6 +30,7 @@ plan tests => 4; # Increment this number for each test you create
# Create
WebGUI::Crud::Subclass->crud_createTable($session);
WebGUI::Test->addToCleanup(sub { WebGUI::Crud::Subclass->crud_dropTable($session); });
my $record1 = WebGUI::Crud::Subclass->create($session, { field1 => 10 });
isa_ok($record1, "WebGUI::Crud", "isa WebGUI::Crud");
is($record1->get('field1'), 10, "got back correct field1 value");
@ -38,11 +39,4 @@ is($record1->get('field1'), 10, "got back correct field1 value");
is(WebGUI::Crud::Subclass->create($session, { field1 => 0 })->get('field1'), 0, 'zero does not trigger default');
is(WebGUI::Crud::Subclass->create($session, { field1 => '' })->get('field1'), 5, '..but empty string intentionally triggers default');
#----------------------------------------------------------------------------
# Cleanup
END {
WebGUI::Crud::Subclass->crud_dropTable($session);
}
#vim:ft=perl

10
t/Crud/serialize.t
View file

@ -34,6 +34,9 @@ plan tests => 10; # Increment this number for each test you create
use_ok('WebGUI::Serialize');
WebGUI::Serialize->crud_createTable($session);
WebGUI::Test->addToCleanup(sub {
WebGUI::Serialize->crud_dropTable($session);
});
my $cereal = WebGUI::Serialize->create($session);
isa_ok($cereal, 'WebGUI::Serialize');
@ -112,11 +115,4 @@ cmp_deeply(
'get: returns safe references'
);
#----------------------------------------------------------------------------
# Cleanup
END {
WebGUI::Serialize->crud_dropTable($session);
}
#vim:ft=perl

72
t/Form/Template.t Normal file
View file

@ -0,0 +1,72 @@
#-------------------------------------------------------------------
# WebGUI is Copyright 2001-2009 Plain Black Corporation.
#-------------------------------------------------------------------
# Please read the legal notices (docs/legal.txt) and the license
# (docs/license.txt) that came with this distribution before using
# this software.
#-------------------------------------------------------------------
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
use FindBin;
use strict;
use lib "$FindBin::Bin/../lib";
use WebGUI::Test;
use WebGUI::Form::Template;
use WebGUI::Session;
use Test::Deep;
use Test::More; # increment this value for each test you create
my $session = WebGUI::Test->session;
plan tests => 4;
my $versionTag = WebGUI::VersionTag->create( $session );
$versionTag->setWorking;
{
my $templateList = WebGUI::Asset::Template->getList( $session, 'style' );
my $elem = WebGUI::Form::Template->new( $session, {
namespace => 'style',
onlyCommitted => 0,
} );
$elem->setOptions;
cmp_deeply(
$templateList,
$elem->get('options'),
'setOption sets correct templates'
);
my $newTemplate = WebGUI::Asset->getRoot( $session )->addChild( {
title => 'Klazam',
menuTitle => 'Klazam',
template => '',
namespace => 'style',
className => 'WebGUI::Asset::Template',
} );
$elem->setOptions;
cmp_deeply(
{ %{$templateList}, $newTemplate->getId => 'Klazam' },
$elem->get('options'),
'setOption includes uncommitted templates when onlyCommitted is false'
);
$elem->set( onlyCommitted => 1 );
$elem->setOptions;
cmp_deeply(
$templateList,
$elem->get('options'),
'setOption excludes uncommitted templates when onlyCommitted is true'
);
my ( $id, $name ) = %{ $templateList };
$elem->set( 'value', $id );
is( $elem->getValueAsHtml, $name, 'getValueAsHtml return template name' );
}
$versionTag->rollback;

18
t/Group.t
View file

@ -92,7 +92,7 @@ my @ldapTests = (
);
plan tests => (164 + (scalar(@scratchTests) * 2) + scalar(@ipTests)); # increment this value for each test you create
plan tests => (168 + (scalar(@scratchTests) * 2) + scalar(@ipTests)); # increment this value for each test you create
my $session = WebGUI::Test->session;
$session->cache->remove('myTestKey');
@ -187,7 +187,7 @@ 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);
WebGUI::Test->addToCleanup($ldap);
my @shawshank;
@ -738,8 +738,8 @@ foreach my $ipTest (@ipTests) {
note "Checking for user Visitor session leak";
$ENV{REMOTE_ADDR} = '191.168.1.1';
my $remoteSession = WebGUI::Test->newSession;
$remoteSession->request->env->{REMOTE_ADDR} = '191.168.1.1';
$remoteSession->user({userId => 1});
my $localIpGroup = WebGUI::Group->new($session, 'new');
@ -748,8 +748,8 @@ foreach my $ipTest (@ipTests) {
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;
$localSession->request->env->{REMOTE_ADDR} = '192.168.33.1';
WebGUI::Test->addToCleanup($localIpGroup, $remoteSession, $localSession);
$localSession->user({userId => 1});
$localIpGroup->clearCaches;
@ -773,11 +773,15 @@ $gY->addUsers([$cacheDude->userId]);
ok( $cacheDude->isInGroup($gY->getId), "Cache dude added to group Y");
ok( $cacheDude->isInGroup($gZ->getId), "Cache dude is a member of group Z by group membership");
ok((grep $_ eq $gY->getId, @{ $cacheDude->getGroupIdsRecursive } ), 'Cache dude in Y by getGroupIdsRecursive');
$gY->deleteUsers([$cacheDude->userId]);
ok(eval { $gY->deleteUsers([$cacheDude->userId]); 1; }, "Y deleteUsers on Cache dude");
ok( !$cacheDude->isInGroup($gY->getId), "Cache dude removed from group Y");
ok( !$cacheDude->isInGroup($gZ->getId), "Cache dude removed from group Z too");
ok((! grep $_ eq $gY->getId, @{ $cacheDude->getGroupIdsRecursive } ), 'Cache dude not in Y getGroupIdsRecursive');
ok((! grep $_ eq $cacheDude->userId, @{ $gY->getAllUsers() } ), 'Cache dude not in Y getAllUsers');
ok( !$cacheDude->isInGroup($gY->getId), "Cache dude removed from group Y by isInGroup");
ok( !$cacheDude->isInGroup($gZ->getId), "Cache dude removed from group Z too by isInGroup");
my $gCache = WebGUI::Group->new($session, "new");
WebGUI::Test->addToCleanup($gCache);

1
t/Help/isa.t
View file

@ -167,3 +167,4 @@ cmp_deeply(
'isa imports variables with nested loops'
);
#vim:ft=perl

14
t/Inbox.t
View file

@ -23,6 +23,7 @@ my $session = WebGUI::Test->session;
# get a user so we can test retrieving messages for a specific user
my $admin = WebGUI::User->new($session, 3);
WebGUI::Test->addToCleanup(sub { WebGUI::Test->cleanupAdminInbox; });
# Begin tests by getting an inbox object
my $inbox = WebGUI::Inbox->new($session);
@ -40,6 +41,7 @@ my $new_message = {
};
my $message = $inbox->addMessage($new_message,{ no_email => 1, });
WebGUI::Test->addToCleanup($message);
isa_ok($message, 'WebGUI::Inbox::Message');
ok(defined($message), 'addMessage returned a response');
@ -51,8 +53,8 @@ ok($messageId, 'messageId retrieved');
####################################
# get a message based on messageId #
####################################
$message = $inbox->getMessage($messageId);
ok($message->getId == $messageId, 'getMessage returns message object');
my $messageCopy = $inbox->getMessage($messageId);
ok($messageCopy->getId == $messageId, 'getMessage returns message object');
#########################################################
# get a list (arrayref) of messages for a specific user #
@ -132,10 +134,4 @@ note $messages->[0]->getStatus;
note $messages->[0]->isRead;
is($inbox->getUnreadMessageCount($admin->userId), 3, '... really tracks unread messages');
END {
$session->db->write('delete from inbox where messageId = ?', [$message->getId]);
foreach my $message (@{ $inbox->getMessagesForUser($admin, 1000) } ) {
$message->setDeleted(3);
$message->delete(3);
}
}
#vim:ft=perl

114
t/Inbox/Groups.t Normal file
View file

@ -0,0 +1,114 @@
#-------------------------------------------------------------------
# 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
#------------------------------------------------------------------
# This script tests the creation, sending, and queuing of mail messages
use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/../lib";
use WebGUI::Test;
use WebGUI::Session;
use WebGUI::Inbox;
use WebGUI::User;
use Test::More;
plan tests => 14;
use Data::Dumper;
#----------------------------------------------------------------------------
# Create two users; add both to a group; send mail from one to the group;
# make sure the other gets it; remove the second user from the group;
# make sure the second user still has the mail message.
# Send a message from Bill to Fred.
# Concerns bug #11594
my $session = WebGUI::Test->session;
my $userFred = WebGUI::User->create($session);
WebGUI::Test->addToCleanup($userFred);
$userFred->username('fred');
$userFred->profileField('receiveInboxEmailNotifications', 0);
my $userBill = WebGUI::User->create($session);
WebGUI::Test->addToCleanup($userBill);
$userBill->username('bill');
$userBill->profileField('receiveInboxEmailNotifications', 0);
my $group = WebGUI::Group->new($session, 'new');
WebGUI::Test->addToCleanup($group);
$group->addUsers([$userFred->userId, $userBill->userId]);
my $inbox = WebGUI::Inbox->new($session);
isa_ok($inbox, 'WebGUI::Inbox');
is($inbox->getUnreadMessageCount($userFred->userId), 0, '0 messages according to getUnreadMessageCount');
my $message = $inbox->addMessage({
message => 'The quick brown dog jumped over the lazy fox',
groupId => $group->getId, # to group
sentBy => $userBill->userId,
}, {
no_email => 1,
});
ok(defined($message), 'Message sent to user in group');
WebGUI::Test->addToCleanup($message);
isa_ok($message, 'WebGUI::Inbox::Message');
my $messageId = $message->getId;
ok($messageId, 'messageId retrieved');
my $messageList;
my $message_cnt;
$messageList = $inbox->getMessagesForUser($userFred);
$message_cnt = scalar(@{$messageList});
is($message_cnt, 1, '... 1 messages according to getMessagesForUser');
is($inbox->getUnreadMessageCount($userFred->userId), 1, '... 1 messages according to getUnreadMessageCount');
ok(eval { $group->deleteUsers([ $userFred->userId ]); 1; }, "Delete user from group");
ok((! grep $_ eq $userFred->userId, @{ $group->getAllUsers() } ), '... removed from group according to getAllUsers');
ok((! grep $_ eq $group->getId, @{ $userFred->getGroupIdsRecursive } ), '... removed from group according to getGroupIdsRecursive');
# note "group->getAllUsers: " . Dumper $group->getAllUsers();
# note "getGroupIdsRecursive: " . Dumper $userFred->getGroupIdsRecursive;
# note "user->getGroups: " . Dumper $userFred->getGroups;
# eval { $userFred->session->stow->delete("gotGroupsForUser"); }; # blow the cache
# note "group->getAllUsers: " . Dumper $group->getAllUsers();
# note "getGroupIdsRecursive: " . Dumper $userFred->getGroupIdsRecursive;
# note "user->getGroups: " . Dumper $userFred->getGroups;
$messageList = $inbox->getMessagesForUser($userFred);
$message_cnt = scalar(@{$messageList});
is($message_cnt, 1, '... still 1 messages according to getMessagesForUser');
# warn $messageList->[0]->getStatus; # 'Pending'
is(eval { $messageList->[0]->getId } || '', $messageId, '... getMessagesForUser able to get message with messageId matching the message sent');
is($inbox->getUnreadMessageCount($userFred->userId), 1, '... still 1 messages according to getUnreadMessageCount');
$message->delete($userFred->userId);
is(scalar(@{ $inbox->getMessagesForUser($userFred) }), 0, 'Message deleted: User has no undeleted messages');
#----------------------------------------------------------------------------

7
t/International.t
View file

@ -28,10 +28,6 @@ plan tests => $numTests;
my $loaded = use_ok('WebGUI::International');
SKIP: {
skip 'Module was not loaded, skipping all tests', $numTests-1 unless $loaded;
my $i18n = WebGUI::International->new($session, undef, 'English');
isa_ok($i18n, 'WebGUI::International', 'object of correct type created');
@ -119,5 +115,4 @@ is(
'Language check after SetLanguage contentHandler : key from missing file return English key'
);
}
#vim:ft=perl

37
t/Macro/CartItemCount.t
View file

@ -31,36 +31,29 @@ my $macro = 'WebGUI::Macro::CartItemCount';
my $loaded = use_ok($macro);
my $cart = WebGUI::Shop::Cart->newBySession($session);
WebGUI::Test->addToCleanup($cart);
my $donation = WebGUI::Asset->getRoot($session)->addChild({
className => 'WebGUI::Asset::Sku::Donation',
title => 'Charitable donation',
defaultPrice => 10.00,
});
WebGUI::Test->addToCleanup($donation);
SKIP: {
my $output;
skip "Unable to load $macro", $numTests-1 unless $loaded;
$output = WebGUI::Macro::CartItemCount::process($session);
is ($output, '0', 'Empty cart returns 0 items');
my $output;
my $item1 = $cart->addItem($donation);
$output = WebGUI::Macro::CartItemCount::process($session);
is ($output, '1', 'Cart contains 1 item');
$output = WebGUI::Macro::CartItemCount::process($session);
is ($output, '0', 'Empty cart returns 0 items');
my $item2 = $cart->addItem($donation);
$output = WebGUI::Macro::CartItemCount::process($session);
is ($output, '2', 'Cart contains 2 items, 1 each');
my $item1 = $cart->addItem($donation);
$output = WebGUI::Macro::CartItemCount::process($session);
is ($output, '1', 'Cart contains 1 item');
$item2->setQuantity(10);
$output = WebGUI::Macro::CartItemCount::process($session);
is ($output, '11', 'Cart contains 11 items, 1 and 10');
my $item2 = $cart->addItem($donation);
$output = WebGUI::Macro::CartItemCount::process($session);
is ($output, '2', 'Cart contains 2 items, 1 each');
$item2->setQuantity(10);
$output = WebGUI::Macro::CartItemCount::process($session);
is ($output, '11', 'Cart contains 11 items, 1 and 10');
}
END {
$cart->delete;
$donation->purge;
}
#vim:ft=perl

6
t/Macro/FilePump.t
View file

@ -113,11 +113,5 @@ is(
'... check illegal file type access returns empty string'
);
#----------------------------------------------------------------------------
# Cleanup
END {
$bundle->delete;
}
#vim:ft=perl

6
t/Macro/GroupText.t
View file

@ -50,6 +50,7 @@ is($output, 'Group Not a Group was not found', 'Non-existant group returns an er
##Create a small database
$session->db->dbh->do('DROP TABLE IF EXISTS myUserTable');
$session->db->dbh->do(q!CREATE TABLE myUserTable (userId CHAR(22) binary NOT NULL default '', PRIMARY KEY(userId)) TYPE=InnoDB!);
WebGUI::Test->addToCleanup(SQL => 'DROP TABLE IF EXISTS myUserTable');
##Create a bunch of users and put them in the table.
@ -116,7 +117,4 @@ $output = join ',',
;
is($output, 'user,disti,int_disti', 'user is in all three groups');
##clean up everything
END {
$session->db->dbh->do('DROP TABLE IF EXISTS myUserTable');
}
#vim:ft=perl

8
t/Macro/H_homeLink.t
View file

@ -22,6 +22,7 @@ use Test::More; # increment this value for each test you create
my $session = WebGUI::Test->session;
my ($versionTag, $template) = addTemplate();
WebGUI::Test->addToCleanup($versionTag);
my $homeAsset = WebGUI::Asset->getDefault($session);
@ -126,9 +127,4 @@ sub simpleTextParser {
return ($url, $label);
}
END {
if (defined $versionTag and ref $versionTag eq 'WebGUI::VersionTag') {
$versionTag->rollback;
}
}
#vim:ft=perl

5
t/Macro/SQL.t
View file

@ -32,6 +32,7 @@ my $WebGUIdbLink = WebGUI::DatabaseLink->new($session, '0');
my $originalMacroAccessValue = $WebGUIdbLink->macroAccessIsAllowed();
$session->db->dbh->do('DROP TABLE IF EXISTS testTable');
WebGUI::Test->addToCleanup(SQL => 'DROP TABLE testTable');
$session->db->dbh->do('CREATE TABLE testTable (zero int(8), one int(8), two int(8), three int(8), four int(8), five int(8), six int(8), seven int(8), eight int(8), nine int(8), ten int(8), eleven int(8) ) TYPE=InnoDB');
$session->db->dbh->do('INSERT INTO testTable (zero, one, two, three, four, five, six, seven, eight, nine, ten, eleven ) VALUES(0,1,2,3,4,5,6,7,8,9,10,11)');
$session->db->dbh->do('INSERT INTO testTable (zero, one, two, three, four, five, six, seven, eight, nine, ten, eleven ) VALUES(100,101,102,103,104,105,106,107,108,109,110,111)');
@ -154,6 +155,4 @@ my $output = WebGUI::Macro::SQL::process(
);
is($output, 'zero', 'alternate linkId works');
END {
$session->db->dbh->do('DROP TABLE testTable');
}
#vim:ft=perl

118
t/Mail/Send.t
View file

@ -36,7 +36,9 @@ my $mime; # for getMimeEntity
#----------------------------------------------------------------------------
# Tests
plan tests => 17; # Increment this number for each test you create
plan tests => 33; # Increment this number for each test you create
WebGUI::Test->addToCleanup(SQL => 'delete from mailQueue');
#----------------------------------------------------------------------------
# Test create
@ -70,6 +72,8 @@ is( $mime->parts(0)->as_string =~ m/\n/, $newlines,
"addText should add newlines after 78 characters",
);
is ( $mime->parts(0)->effective_type, 'text/plain', '... sets the correct MIME type' );
#----------------------------------------------------------------------------
# Test addHtml
$mail = WebGUI::Mail::Send->create( $session );
@ -81,13 +85,13 @@ $mail->addHtml($text);
$mime = $mail->getMimeEntity;
# TODO: Test that addHtml creates an HTML wrapper if no html or body tag exists
# TODO: Test that addHtml creates a body with the right content type
# addHtml should add newlines after 78 characters
$newlines = length $text / 78;
is( $mime->parts(0)->as_string =~ m/\n/, $newlines,
"addHtml should add newlines after 78 characters",
);
is ( $mime->parts(0)->effective_type, 'text/html', '... sets the correct MIME type' );
# TODO: Test that addHtml does not create an HTML wrapper if html or body tag exist
@ -121,7 +125,54 @@ is($dbMail->getMimeEntity->head->get('List-ID'), "=?UTF-8?Q?H=C3=84ufige=20Frage
# TODO: Test that addHtml creates a body with the right content type
my $smtpServerOk;
{
my $mail = WebGUI::Mail::Send->create( $session );
ok ! $mail->{_footerAdded}, 'footerAdded flag set to false by default';
$mail->addFooter;
ok $mail->{_footerAdded}, '... flag set after calling addFooter';
my $number_of_parts;
$number_of_parts = $mail->getMimeEntity->parts;
is $number_of_parts, 1, '... added 1 part for a footer';
$mail->addFooter;
ok $mail->{_footerAdded}, '... flag still set after calling addFooter again';
$number_of_parts = $mail->getMimeEntity->parts;
is $number_of_parts, 1, '... 2nd footer not added';
}
{
my $mail = WebGUI::Mail::Send->create( $session );
$mail->addText('some text');
$mail->addFooter;
my $number_of_parts;
$number_of_parts = $mail->getMimeEntity->parts;
is $number_of_parts, 1, 'addFooter did not add any other parts';
my $body = $mail->getMimeEntity->parts(0)->as_string;
$body =~ s/\A.+?(?=some text)//s;
is $body, "some text\n\nMy Company\ninfo\@mycompany.com\nhttp://www.mycompany.com\n", '... footer appended to the first part as text';
}
{
my $mail = WebGUI::Mail::Send->create( $session );
$mail->addHtml('some <b>markup</b>');
$mail->addFooter;
my $number_of_parts;
$number_of_parts = $mail->getMimeEntity->parts;
is $number_of_parts, 1, 'addFooter did not add any other parts';
my $body = $mail->getMimeEntity->parts(0)->as_string;
$body =~ s/\A.+?<body>\n//sm;
$body =~ s!</body>.+\Z!!sm;
is $body, "some <b>markup</b>\n<br />\n<br />\nMy Company<br />\ninfo\@mycompany.com<br />\nhttp://www.mycompany.com<br />\n", '... footer appended to the first part as text';
}
{
my $mail = WebGUI::Mail::Send->create( $session );
$mail->addText('This is a textual email');
my $result = $mail->getMimeEntity->is_multipart;
ok(defined $result && $result, 'by default, we make multipart messages');
}
my $smtpServerOk = 0;
#----------------------------------------------------------------------------
# Test emailOverride
@ -326,10 +377,61 @@ cmp_bag(
'send: when the original is sent, new messages are created for each user in the group, following their user profile settings'
);
# TODO: Test the emailToLog config setting
#----------------------------------------------------------------------------
# Cleanup
END {
$session->db->write('delete from mailQueue');
SKIP: {
my $numtests = 2; # Number of tests in this block
skip "Cannot test making emails single part", $numtests unless $smtpServerOk;
WebGUI::Test::MailServer::test_smtp($session, sub {
my $cb = shift;
# Send the mail
my $mail
= WebGUI::Mail::Send->create( $session, {
to => 'norton@localhost',
} );
$mail->addText("They say it has no memory. That's where I want to live the rest of my life. A warm place with no memory.");
ok ($mail->getMimeEntity->is_multipart, 'starting with a multipart message');
$mail->send;
my $received = $cb->();
if (!$received) {
skip "Cannot making single part: No response received from smtpd", 1;
}
# Test the mail
my $parser = MIME::Parser->new();
$parser->output_to_core(1);
my $parsed_message = $parser->parse_data($received->{contents});
ok (!$parsed_message->is_multipart, 'converted to singlepart since it only has 1 part.');
});
}
SKIP: {
my $numtests = 2; # Number of tests in this block
skip "Cannot test making emails single part", $numtests unless $smtpServerOk;
WebGUI::Test::MailServer::test_smtp($session, sub {
my $cb = shift;
# Send the mail
my $mail = WebGUI::Mail::Send->create( $session, { to => 'norton@localhost', } );
$mail->addText("You know what the Mexicans say about the Pacific?");
$mail->addText("They say it has no memory. That's where I want to live the rest of my life. A warm place with no memory.");
ok ($mail->getMimeEntity->is_multipart, 'starting with a multipart message');
$mail->send;
my $received = $cb->();
if (!$received) {
skip "Cannot making single part: No response received from smtpd", $numtests;
}
# Test the mail
my $parser = MIME::Parser->new();
$parser->output_to_core(1);
my $parsed_message = $parser->parse_data($received->{contents});
ok ( $parsed_message->is_multipart, 'left as multipart since it has more than 1 part');
});
}
# TODO: Test the emailToLog config setting

1
t/Operation/Auth.t
View file

@ -54,4 +54,3 @@ unlike(
qr/<input type="hidden" name="method" value="login" /,
"Hidden form elements for login NOT displayed to valid user",
);

1
t/Pluggable.t
View file

@ -135,3 +135,4 @@ is($dumper->Dump, q|$VAR1 = {
);
};
#vim:ft=perl

5
t/ProfileCategory.t
View file

@ -33,6 +33,7 @@ my @labels = map { $_->getLabel } @{ $categories };
my %originalProperties = %{ $categories->[0]->get };
my %properties = %originalProperties;
WebGUI::Test->addToCleanup(sub { $categories->[0]->set(\%originalProperties); });
$properties{visible} = 0;
$categories->[0]->set(\%properties);
@ -41,6 +42,4 @@ my @newLabels = map { $_->getLabel } @{ $newCategories };
cmp_bag(\@newLabels, \@labels, 'Setting a category to not be visible does not change its availability through getCategories, with no options');
END {
$categories->[0]->set(\%originalProperties);
}
#vim:ft=perl

2
t/Session.t
View file

@ -56,7 +56,9 @@ my $slaveHash2 = {
};
$session->config->set('dbslave2', $slaveHash2);
WebGUI::Test->addToCleanup(sub {$session->config->delete('dbslave2');});
my $slave2 = $session->dbSlave;
isa_ok($slave2, 'WebGUI::SQL::db');
#vim:ft=perl

1
t/Session/DateTime.t
View file

@ -301,3 +301,4 @@ $session->user({user => $dude});
is($dt->epochToHuman($wgbday), '8/16/2001 9:00 pm', 'epochToHuman: constructs a default locale if the language does not provide one.');
$session->user({userId => 1});
#vim:ft=perl

7
t/Session/Icon.t
View file

@ -39,6 +39,7 @@ my $session = WebGUI::Test->session;
####################################################
my $origToolbar = $session->user->profileField('toolbar');
WebGUI::Test->addToCleanup(sub { $session->user->profileField('toolbar', $origToolbar); },);
my $toolbars = $session->url->extras('toolbar/');
my $request = $session->request;
@ -167,12 +168,6 @@ sub linkAndText {
return @parsedParams;
}
my $icon = $session->icon->drag();
END {
$session->user->profileField('toolbar', $origToolbar);
}
sub fetchTestSet {
return (
{

8
t/Session/Privilege.t
View file

@ -67,6 +67,7 @@ my $session = WebGUI::Test->session;
my $privilege = $session->privilege;
my ($versionTag, $userTemplate) = setup_assets($session);
WebGUI::Test->addToCleanup($versionTag);
isa_ok($privilege, 'WebGUI::Session::Privilege', 'session has correct object type');
@ -135,9 +136,4 @@ sub setup_assets {
return ($versionTag, $userTemplate);
}
END {
if (defined $versionTag and ref $versionTag eq 'WebGUI::VersionTag') {
$versionTag->rollback;
}
}
#vim:ft=perl

273
t/Session/Scratch.t
View file

@ -1,140 +1,133 @@
#-------------------------------------------------------------------
# WebGUI is Copyright 2001-2009 Plain Black Corporation.
#-------------------------------------------------------------------
# Please read the legal notices (docs/legal.txt) and the license
# (docs/license.txt) that came with this distribution before using
# this software.
#-------------------------------------------------------------------
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
use FindBin;
use strict;
use lib "$FindBin::Bin/../lib";
use WebGUI::Test;
use WebGUI::Session;
use Test::More tests => 62; # increment this value for each test you create
use Test::Deep;
my $session = WebGUI::Test->session;
my $scratch = $session->scratch;
my $maxCount = 10;
$scratch->deleteAll();
for (my $count = 1; $count <= $maxCount; $count++){
$scratch->set("Test$count",$count);
}
for (my $count = 1; $count <= $maxCount; $count++){
is($scratch->get("Test$count"), $count, "Passed set/get $count");
}
is($scratch->delete("nonExistantVariable"), undef, 'delete returns value if deleted, otherwise undef');
is($scratch->delete("Test1"), 1, 'delete returns number deleted');
is($scratch->delete(), undef, 'delete without name of variable to delete returns undef');
is($scratch->get("Test1"), undef, "delete()");
$scratch->deleteAll;
is($scratch->get("Test2"), undef, "deleteAll()");
my $testScratchSession = $scratch->session();
is($testScratchSession, $session, "session()");
##Build some variables to test database persistency
for (my $count = 1; $count <= $maxCount; $count++){
$scratch->set("dBase$count",$count);
my ($setValue) = $session->db->quickArray("select value from userSessionScratch where sessionId=? and name=?",[$session->getId, "dBase$count"]);
is($setValue, $count, "database store for set on $count");
}
##Creating a new session with the previous session's Id should clone the scratch data
my $newSession = WebGUI::Session->open(WebGUI::Test->file, undef, $session->getId);
is($newSession->getId, $session->getId, "Successful session duplication");
for (my $count = 1; $count <= $maxCount; $count++){
is($newSession->scratch->get("dBase$count"), $count, "Passed set/get $count");
}
$scratch->set("dBase5", 15);
my ($changedValue) = $session->db->quickArray("select value from userSessionScratch where sessionId=? and name=?",[$session->getId, "dBase5"]);
is($changedValue, 15, "changing stored scratch value");
is($scratch->get("dBase5"), 15, "checking cached scratch value");
$newSession->scratch->deleteAll;
$newSession->close;
is($scratch->set('retVal',2), 1, 'set returns number of rows affected');
is($scratch->set(), undef, 'set returns undef unless it gets a name');
is($scratch->set('','value'), undef, 'set returns undef unless it gets a name even if there is a value');
############################################
#
# Multi-session deleting
#
############################################
my @sessionBank = map { WebGUI::Session->open(WebGUI::Test->file) } 0..3;
##Set variables to be deleted by name
foreach my $i (0..3) {
$sessionBank[$i]->scratch->set('deletableName', $i);
}
##Set variables to be deleted by name and value
$sessionBank[0]->scratch->set('deletableValue', 'a');
$sessionBank[1]->scratch->set('deletableValue', 'a');
$sessionBank[2]->scratch->set('deletableValue', 'b');
$sessionBank[2]->scratch->set('falseValue', '');
$sessionBank[3]->scratch->set('deletableValue', 'c');
$sessionBank[3]->scratch->set('falseValue', '0');
is($scratch->deleteName(), undef, 'deleteName without name of variable to delete returns undef');
is($sessionBank[2]->scratch->deleteName("deletableName"), 4, 'deleteName returns number of elements deleted');
is($sessionBank[2]->scratch->get("deletableName"), undef, 'deleteName clears session cached in the object that calls it');
is($sessionBank[1]->scratch->get('deletableName'), 1, "deleteName does not change session cached vriables");
my ($entries) = $session->db->quickArray("select count(name) from userSessionScratch where name=?",['deletableName']);
is($entries, 0, "deleteName deletes entries in the database");
is($sessionBank[1]->scratch->deleteNameByValue('deletableValue', 'a'), 2, 'deleteNameByValue deleted two rows');
($entries) = $session->db->quickArray("select count(name) from userSessionScratch where name=?",['deletableValue']);
is($entries, 2, "deleteNameByValue deleted entries in the database");
is($sessionBank[1]->scratch->get('deletableValue'), undef, 'deleteNameByValue removes session cache in object that called it...');
is($sessionBank[0]->scratch->get('deletableValue'), 'a', 'but not in any other object whose database entry was cleared');
cmp_bag($session->db->buildArrayRef('select value from userSessionScratch where name=?',['deletableValue']), ['b', 'c'], 'deleteNameByValue values that were not deleted');
is($sessionBank[2]->scratch->deleteNameByValue('deletableValue', 'c'), 1, 'deleteNameByValue deleted one row');
is($sessionBank[0]->scratch->deleteNameByValue('',35), undef, 'deleteNameByValue requires a NAME');
is($sessionBank[0]->scratch->deleteNameByValue('scratch'), undef, 'deleteNameByValue requires a value');
is($sessionBank[0]->scratch->deleteNameByValue('',''), undef, 'deleteNameByValue require a NAME and a VALUE');
is($sessionBank[3]->scratch->deleteNameByValue('falseValue','0'), 1, 'deleteNameByValue will delete values that are false (0)');
is($sessionBank[2]->scratch->deleteNameByValue('falseValue',''), 1, "deleteNameByValue will delete values that are false ('')");
$scratch->setLanguageOverride('English');
is($scratch->getLanguageOverride, 'English', 'session scratch language is not correctly set');
$scratch->removeLanguageOverride;
is($scratch->getLanguageOverride, undef, 'The session scratch variable language is not removed');
$scratch->setLanguageOverride('myimmaginarylanguagethatisnotinstalled');
is($scratch->getLanguageOverride, undef, 'A non-existing language is set');
$scratch->setLanguageOverride('English');
$scratch->setLanguageOverride();
is($scratch->getLanguageOverride, 'English', 'A empty string is falsely recognised as a language');
END {
$session->scratch->deleteAll;
foreach my $wgSess ($newSession, @sessionBank) {
if (defined $wgSess and ref $wgSess eq 'WebGUI::Session') {
note "Closing session";
$wgSess->scratch->deleteAll;
$wgSess->var->end;
$wgSess->close;
}
}
}
#-------------------------------------------------------------------
# WebGUI is Copyright 2001-2009 Plain Black Corporation.
#-------------------------------------------------------------------
# Please read the legal notices (docs/legal.txt) and the license
# (docs/license.txt) that came with this distribution before using
# this software.
#-------------------------------------------------------------------
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
use FindBin;
use strict;
use lib "$FindBin::Bin/../lib";
use WebGUI::Test;
use WebGUI::Session;
use Test::More tests => 62; # increment this value for each test you create
use Test::Deep;
my $session = WebGUI::Test->session;
my $scratch = $session->scratch;
my $maxCount = 10;
$scratch->deleteAll();
for (my $count = 1; $count <= $maxCount; $count++){
$scratch->set("Test$count",$count);
}
for (my $count = 1; $count <= $maxCount; $count++){
is($scratch->get("Test$count"), $count, "Passed set/get $count");
}
is($scratch->delete("nonExistantVariable"), undef, 'delete returns value if deleted, otherwise undef');
is($scratch->delete("Test1"), 1, 'delete returns number deleted');
is($scratch->delete(), undef, 'delete without name of variable to delete returns undef');
is($scratch->get("Test1"), undef, "delete()");
$scratch->deleteAll;
is($scratch->get("Test2"), undef, "deleteAll()");
my $testScratchSession = $scratch->session();
is($testScratchSession, $session, "session()");
##Build some variables to test database persistency
for (my $count = 1; $count <= $maxCount; $count++){
$scratch->set("dBase$count",$count);
my ($setValue) = $session->db->quickArray("select value from userSessionScratch where sessionId=? and name=?",[$session->getId, "dBase$count"]);
is($setValue, $count, "database store for set on $count");
}
##Creating a new session with the previous session's Id should clone the scratch data
my $newSession = WebGUI::Session->open(WebGUI::Test->file, undef, $session->getId);
WebGUI::Test->addToCleanup($newSession);
is($newSession->getId, $session->getId, "Successful session duplication");
for (my $count = 1; $count <= $maxCount; $count++){
is($newSession->scratch->get("dBase$count"), $count, "Passed set/get $count");
}
$scratch->set("dBase5", 15);
my ($changedValue) = $session->db->quickArray("select value from userSessionScratch where sessionId=? and name=?",[$session->getId, "dBase5"]);
is($changedValue, 15, "changing stored scratch value");
is($scratch->get("dBase5"), 15, "checking cached scratch value");
$newSession->scratch->deleteAll;
$newSession->close;
is($scratch->set('retVal',2), 1, 'set returns number of rows affected');
is($scratch->set(), undef, 'set returns undef unless it gets a name');
is($scratch->set('','value'), undef, 'set returns undef unless it gets a name even if there is a value');
############################################
#
# Multi-session deleting
#
############################################
my @sessionBank = map { WebGUI::Session->open(WebGUI::Test->file) } 0..3;
WebGUI::Test->addToCleanup(@sessionBank);
##Set variables to be deleted by name
foreach my $i (0..3) {
$sessionBank[$i]->scratch->set('deletableName', $i);
}
##Set variables to be deleted by name and value
$sessionBank[0]->scratch->set('deletableValue', 'a');
$sessionBank[1]->scratch->set('deletableValue', 'a');
$sessionBank[2]->scratch->set('deletableValue', 'b');
$sessionBank[2]->scratch->set('falseValue', '');
$sessionBank[3]->scratch->set('deletableValue', 'c');
$sessionBank[3]->scratch->set('falseValue', '0');
is($scratch->deleteName(), undef, 'deleteName without name of variable to delete returns undef');
is($sessionBank[2]->scratch->deleteName("deletableName"), 4, 'deleteName returns number of elements deleted');
is($sessionBank[2]->scratch->get("deletableName"), undef, 'deleteName clears session cached in the object that calls it');
is($sessionBank[1]->scratch->get('deletableName'), 1, "deleteName does not change session cached vriables");
my ($entries) = $session->db->quickArray("select count(name) from userSessionScratch where name=?",['deletableName']);
is($entries, 0, "deleteName deletes entries in the database");
is($sessionBank[1]->scratch->deleteNameByValue('deletableValue', 'a'), 2, 'deleteNameByValue deleted two rows');
($entries) = $session->db->quickArray("select count(name) from userSessionScratch where name=?",['deletableValue']);
is($entries, 2, "deleteNameByValue deleted entries in the database");
is($sessionBank[1]->scratch->get('deletableValue'), undef, 'deleteNameByValue removes session cache in object that called it...');
is($sessionBank[0]->scratch->get('deletableValue'), 'a', 'but not in any other object whose database entry was cleared');
cmp_bag($session->db->buildArrayRef('select value from userSessionScratch where name=?',['deletableValue']), ['b', 'c'], 'deleteNameByValue values that were not deleted');
is($sessionBank[2]->scratch->deleteNameByValue('deletableValue', 'c'), 1, 'deleteNameByValue deleted one row');
is($sessionBank[0]->scratch->deleteNameByValue('',35), undef, 'deleteNameByValue requires a NAME');
is($sessionBank[0]->scratch->deleteNameByValue('scratch'), undef, 'deleteNameByValue requires a value');
is($sessionBank[0]->scratch->deleteNameByValue('',''), undef, 'deleteNameByValue require a NAME and a VALUE');
is($sessionBank[3]->scratch->deleteNameByValue('falseValue','0'), 1, 'deleteNameByValue will delete values that are false (0)');
is($sessionBank[2]->scratch->deleteNameByValue('falseValue',''), 1, "deleteNameByValue will delete values that are false ('')");
$scratch->setLanguageOverride('English');
is($scratch->getLanguageOverride, 'English', 'session scratch language is not correctly set');
$scratch->removeLanguageOverride;
is($scratch->getLanguageOverride, undef, 'The session scratch variable language is not removed');
$scratch->setLanguageOverride('myimmaginarylanguagethatisnotinstalled');
is($scratch->getLanguageOverride, undef, 'A non-existing language is set');
$scratch->setLanguageOverride('English');
$scratch->setLanguageOverride();
is($scratch->getLanguageOverride, 'English', 'A empty string is falsely recognised as a language');
#vim:ft=perl

1
t/Session/Stow.t
View file

@ -80,3 +80,4 @@ is( $session->stow->get( 'possibilities', { noclone => 1 } ), $arr,
"With noclone returns same reference"
);
#vim:ft=perl

1
t/Session/Style.t
View file

@ -178,6 +178,7 @@ is($macroOutput, 1, 'generateAdditionalHeadTags: process a macro');
####################################################
my ($versionTag, $templates, $article, $snippet) = setup_assets($session);
WebGUI::Test->addToCleanup($versionTag);
$style->sent(0);
is($style->sent, 0, 'process: setup sent to 0');

4
t/Shop/Cart.t
View file

@ -154,8 +154,8 @@ is( $cart->readyForCheckout, 0, 'Cannot checkout an empty cart' );
is($session->db->quickScalar("select count(*) from cartItem where cartId=?",[ $cart->getId ]), 0, "Items are removed from cart.");
my $session2 = WebGUI::Session->open(WebGUI::Test->file);
addToCleanup($session2);
my $session2 = WebGUI::Test->newSession;
WebGUI::Test->addToCleanup($session2);
$session2->user({userId => 3});
my $cart2 = WebGUI::Shop::Cart->newBySession($session2);
WebGUI::Test->addToCleanup($cart2);

9
t/Shop/Pay.t
View file

@ -109,6 +109,7 @@ my $options = {
label => 'Cold, stone hard cash',
};
$newDriver = $pay->addPaymentGateway('WebGUI::Shop::PayDriver::Cash', $options);
WebGUI::Test->addToCleanup($newDriver);
isa_ok($newDriver, 'WebGUI::Shop::PayDriver::Cash', 'added a new, configured Cash driver');
is($newDriver->get('label'), 'Cold, stone hard cash', 'label passed correctly to paydriver');
@ -189,6 +190,7 @@ my $otherOptions = {
label => 'Even harder cash',
};
$anotherDriver = $pay->addPaymentGateway('WebGUI::Shop::PayDriver::Cash', $otherOptions);
WebGUI::Test->addToCleanup($anotherDriver);
my $gateways = $pay->getPaymentGateways;
my @returnedIds = map {$_->get('label')} @{ $gateways };
@ -215,10 +217,3 @@ cmp_bag(
#######################################################################
done_testing();
#----------------------------------------------------------------------------
# Cleanup
END {
defined $newDriver and $newDriver->delete;
defined $newDriver and $anotherDriver->delete;
}

9
t/Shop/PayDriver/PayPalStd.t
View file

@ -41,12 +41,6 @@ my $e;
my $loaded = use_ok('WebGUI::Shop::PayDriver::PayPal::PayPalStd');
my $storage;
SKIP: {
skip 'Unable to load module WebGUI::Shop::PayDriver::PayPal::PayPalStd', $tests unless $loaded;
#######################################################################
#
# getName
@ -77,5 +71,4 @@ $driver->delete;
undef $driver;
}
#vim:ft=perl

14
t/Shop/Ship.t
View file

@ -40,7 +40,6 @@ my $session = WebGUI::Test->session;
my $loaded = use_ok('WebGUI::Shop::Ship');
my $storage;
my $driver;
my $driver2;
my $ship;
@ -136,7 +135,8 @@ cmp_deeply(
'addShipper croaks without options to build a object with',
);
$driver = $ship->addShipper('WebGUI::Shop::ShipDriver::FlatRate', { enabled=>1, label=>q{Jake's Jailbird Airmail}, groupToUse=>7});
my $driver = $ship->addShipper('WebGUI::Shop::ShipDriver::FlatRate', { enabled=>1, label=>q{Jake's Jailbird Airmail}, groupToUse=>7});
WebGUI::Test->addToCleanup($driver);
isa_ok($driver, 'WebGUI::Shop::ShipDriver::FlatRate', 'added a new, configured FlatRate driver');
#######################################################################
@ -146,7 +146,8 @@ isa_ok($driver, 'WebGUI::Shop::ShipDriver::FlatRate', 'added a new, configured F
#######################################################################
my $shippers;
$driver2 = $ship->addShipper('WebGUI::Shop::ShipDriver::FlatRate', { enabled=>0, label=>q{Tommy's cut-rate shipping}, groupToUse=>7});
my $driver2 = $ship->addShipper('WebGUI::Shop::ShipDriver::FlatRate', { enabled=>0, label=>q{Tommy's cut-rate shipping}, groupToUse=>7});
WebGUI::Test->addToCleanup($driver2);
$shippers = $ship->getShippers();
@ -204,9 +205,4 @@ $cart->delete;
done_testing();
#----------------------------------------------------------------------------
# Cleanup
END {
$driver->delete;
$driver2->delete;
}
#vim:ft=perl

7
t/Shop/ShipDriver.t
View file

@ -43,10 +43,6 @@ my $loaded = use_ok('WebGUI::Shop::ShipDriver');
my $storage;
SKIP: {
skip 'Unable to load module WebGUI::Shop::ShipDriver', $tests unless $loaded;
#######################################################################
#
# definition
@ -163,6 +159,7 @@ my $options = {
};
$driver = WebGUI::Shop::ShipDriver->create( $session, $options );
WebGUI::Test->addToCleanup($driver);
isa_ok($driver, 'WebGUI::Shop::ShipDriver');
@ -399,5 +396,3 @@ is($count, 0, 'delete deleted the object');
undef $driver;
}

9
t/Shop/TaxDriver/Generic.t
View file

@ -41,6 +41,8 @@ my $addExceptions = getAddExceptions($session);
plan tests => 79
+ 2*scalar(@{$addExceptions});
WebGUI::Test->addToCleanup(SQL => 'delete from tax_generic_rates');
#----------------------------------------------------------------------------
# put your tests here
@ -666,9 +668,4 @@ sub getAddExceptions {
},
];
}
#----------------------------------------------------------------------------
# Cleanup
END {
$session->db->write('delete from tax_generic_rates');
}
#vim:ft=perl

1
t/Shop/Transaction.t
View file

@ -267,6 +267,7 @@ $templateMock->mock('process', sub { push @templateVars, clone $_[1]; } );
$session->setting->set('shopReceiptEmailTemplateId', $templateId);
{
WebGUI::Test->addToCleanup(sub { WebGUI::Test->cleanupAdminInbox(); });
$trans->sendNotifications;
is(@templateVars, 2, '... called template->process twice');
my $inbox = WebGUI::Inbox->new($session);

18
t/Shop/Vendor.t
View file

@ -31,8 +31,7 @@ my $session = WebGUI::Test->session;
#----------------------------------------------------------------------------
# Tests
my $tests = 49;
plan tests => 1 + $tests;
plan tests => 49;
#----------------------------------------------------------------------------
# put your tests here
@ -47,10 +46,6 @@ my $guardUser = WebGUI::User->new($session, 'new');
$guardUser->username('guard');
WebGUI::Test->addToCleanup($fenceUser, $guardUser);
SKIP: {
skip 'Unable to load module WebGUI::Shop::Vendor', $tests unless $loaded;
$numberOfVendors = scalar @{ WebGUI::Shop::Vendor->getVendors($session) };
#######################################################################
@ -130,6 +125,7 @@ cmp_deeply(
my $now = WebGUI::DateTime->new($session, time);
eval { $fence = WebGUI::Shop::Vendor->create($session, { userId => $fenceUser->userId, }); };
WebGUI::Test->addToCleanup($fence);
$e = Exception::Class->caught();
ok(!$e, 'No exception thrown by create');
isa_ok($vendor, 'WebGUI::Shop::Vendor', 'create returns correct type of object');
@ -251,6 +247,7 @@ my $defaultVendor = WebGUI::Shop::Vendor->newByUserId($session, 3);
#######################################################################
$guard = WebGUI::Shop::Vendor->create($session, { userId => $guardUser->userId, name => q|Warden Norton|});
WebGUI::Test->addToCleanup($guard);
my $vendorsList = WebGUI::Shop::Vendor->getVendors($session);
cmp_deeply(
$vendorsList,
@ -307,11 +304,4 @@ foreach (keys %completeProps ) {
undef $guard;
}
#----------------------------------------------------------------------------
# Cleanup
END {
$fence->delete;
is( scalar @{ WebGUI::Shop::Vendor->getVendors($session) }, $numberOfVendors, 'No vendors leaked');
}
#vim:ft=perl

8
t/Storage.t
View file

@ -68,8 +68,8 @@ is( $storage1->getLastError, undef, "No errors during path creation");
#
####################################################
is( $storage1->getPathFrag, '7e/8a/7e8a1b6a', 'pathFrag returns correct value');
is( $storage1->getDirectoryId, '7e8a1b6a', 'getDirectoryId returns the last path element');
is( $storage1->getPathFrag, '7e/8a/7e8a1b6ab', 'pathFrag returns correct value');
is( $storage1->getDirectoryId, '7e8a1b6ab', 'getDirectoryId returns the last path element');
##Build an old-style GUID storage location
my $uploadsBase = Path::Class::Dir->new($uploadDir);
@ -94,12 +94,12 @@ is($guidStorage->getDirectoryId, $newGuid, '... getDirectoryId');
$session->config->delete('cdn');
# Note: the CDN configuration will be reverted after CDN tests below
my $storageDir1 = join '/', $uploadDir, '7e', '8a', '7e8a1b6a';
my $storageDir1 = join '/', $uploadDir, '7e', '8a', '7e8a1b6ab';
is ($storage1->getPath, $storageDir1, 'getPath: path calculated correctly for directory');
my $storageFile1 = join '/', $storageDir1, 'baz';
is ($storage1->getPath('baz'), $storageFile1, 'getPath: path calculated correctly for file');
my $storageUrl1 = join '/', $uploadUrl, '7e', '8a', '7e8a1b6a';
my $storageUrl1 = join '/', $uploadUrl, '7e', '8a', '7e8a1b6ab';
is ($storage1->getUrl, $storageUrl1, 'getUrl: url calculated correctly for directory');
my $storageUrl2 = join '/', $storageUrl1, 'bar';
is ($storage1->getUrl('bar'), $storageUrl2, 'getUrl: url calculated correctly for file');

37
t/VersionTag.t
View file

@ -14,7 +14,7 @@ use lib "$FindBin::Bin/lib";
use WebGUI::Test;
use WebGUI::Session;
use WebGUI::VersionTag;
use Test::More tests => 81; # increment this value for each test you create
use Test::More tests => 85; # increment this value for each test you create
my $session = WebGUI::Test->session;
@ -184,15 +184,39 @@ is($tag3->getRevisionCount, 5, 'original tag still with five revisions');
$tag4->clearWorking;
$tag3->rollback;
$tag4->rollback;
($asset1, $asset2, $asset3, $tag3, $tag4) = ();
#Test commitAsUser
my $tag5 = WebGUI::VersionTag->create($session, {});
$tag5->setWorking;
my $asset5 = WebGUI::Asset->getRoot($session)->addChild({ className => 'WebGUI::Asset::Snippet' });
is($tag5->get("createdBy"),1,'tag created by visitor');
$tag5->commitAsUser(3);
$tag5 = WebGUI::VersionTag->new($session, $tag5->getId); #Get the tag again - properties have changed
is($tag5->get("committedBy"),3,'tag committed by admin');
$tag5->clearWorking;
$tag5->rollback;
#Test commitAsUser with options
my $tag6 = WebGUI::VersionTag->create($session, {});
$tag6->setWorking;
my $asset6 = WebGUI::Asset->getRoot($session)->addChild({ className => 'WebGUI::Asset::Snippet' });
$tag6->commitAsUser(3, { commitNow => "yes" });
$tag6 = WebGUI::VersionTag->new($session, $tag6->getId); #Get the tag again - properties have changed
is($tag6->get("committedBy"),3,'tag committed by admin again');
$asset6 = WebGUI::Asset->newById($session,$asset6->getId); #Get the asset again - properties have changed
is($asset6->get("status"),"approved","asset status approved");
$tag6->clearWorking;
$tag6->rollback;
($asset1, $asset2, $asset3, $asset5, $asset6, $tag3, $tag4, $tag5, $tag6) = ();
#additional tests for versionTagMode
#
setSiteVersionTagMode($session, q{singlePerUser});
setUserVersionTagMode($user, q{inherited});
ok(!defined getWorking(1), 'versionTagMode singlePerUser: no working tag initially present');
ok(!defined getWorking(1), 'versionTagMode singlePerUser: no working tag initially present')
or diag(getWorking(1)->getId);
$tag = WebGUI::VersionTag->create($session, {});
isa_ok($tag, 'WebGUI::VersionTag', 'versionTagMode singlePerUser: empty tag');
@ -304,8 +328,8 @@ $adminUserTag->rollback();
is($tag->getAssetCount, 1, qq{$test_prefix [singlePerUser] tag with 1 asset});
# create admin session
my $admin_session = WebGUI::Session->open(WebGUI::Test->file);
addToCleanup($session);
my $admin_session = WebGUI::Test->newSession;
WebGUI::Test->addToCleanup($admin_session);
$admin_session->user({'userId' => 3});
setUserVersionTagMode($admin_session->user(), q{autoCommit});
@ -356,7 +380,8 @@ $adminUserTag->rollback();
is($tag->getAssetCount, 1, qq{$test_prefix [siteWide] tag with 1 asset});
# create admin session
$admin_session = WebGUI::Session->open(WebGUI::Test->file);
$admin_session = WebGUI::Test->newSession;
WebGUI::Test->addToCleanup($admin_session);
addToCleanup($admin_session);
$admin_session->user({'userId' => 3});

7
t/Workflow/Activity/CalendarUpdateFeeds.t
View file

@ -74,6 +74,7 @@ my $workflow = WebGUI::Workflow->create($session,
mode => 'realtime',
},
);
WebGUI::Test->addToCleanup($workflow);
my $icalFetch = $workflow->addActivity('WebGUI::Workflow::Activity::CalendarUpdateFeeds');
my $instance1 = WebGUI::Workflow::Instance->create($session,
@ -127,8 +128,4 @@ is(scalar @{ $newEvents }, 1, 'reimport does not create new children');
$anniversary = pop @{ $newEvents };
is($anniversary->get('description'), $party->get('description'), '... description, checks for line unwrapping');
END {
$instance1 && $instance1->delete('skipNotify');
$instance2 && $instance2->delete('skipNotify');
$workflow && $workflow->delete;
}
#vim:ft=perl

8
t/Workflow/Activity/DeleteExpiredSessions.t
View file

@ -30,6 +30,7 @@ my $workflow = WebGUI::Workflow->create($session,
mode => 'realtime',
},
);
WebGUI::Test->addToCleanup($workflow);
my $activity = $workflow->addActivity('WebGUI::Workflow::Activity::DeleteExpiredSessions');
my $instance1 = WebGUI::Workflow::Instance->create($session,
@ -52,9 +53,6 @@ my $origSessionTimeout = $session->setting->get('sessionTimeout');
my $sessionCount = $session->db->quickScalar('select count(*) from userSession');
my $scratchCount = $session->db->quickScalar('select count(*) from userSessionScratch');
note $sessionCount;
note $scratchCount;
my @sessions;
foreach (1..2) {
@ -113,6 +111,4 @@ foreach my $testSession (@sessions) {
## Make sure that one scratch session was deleted and the other kept.
## Close and end all four sessions
END {
$workflow->delete;
}
#vim:ft=perl

5
t/Workflow/Activity/ExpireIncompleteSurveyResponses.t
View file

@ -158,7 +158,4 @@ is($session->db->quickScalar('select count(*) from Survey_response where Survey_
# Afterwards, back to no incomplete responses
is( scalar $session->db->buildArray($SQL), 0, 'Afterwards, back to no incomplete responses');
END {
$session->db->write('delete from Survey_response where userId = ?', [$user->userId]) if $user;
$survey->purge if $survey;
}
#vim:ft=perl

36
t/Workflow/Activity/NotifyAboutLowStock.t
View file

@ -23,11 +23,13 @@ use Test::More;
use Test::Exception;
use URI;
plan tests => 20; # increment this value for each test you create
plan tests => 19; # increment this value for each test you create
my $session = WebGUI::Test->session;
$session->user({userId => 3});
my $admin = $session->user;
WebGUI::Test->addToCleanup(sub { WebGUI::Test->cleanupAdminInbox; });
WebGUI::Test->addToCleanup(SQL => "delete from mailQueue where message like '%Threshold=15%'");
my $inbox = WebGUI::Inbox->new($session);
my $import = WebGUI::Asset->getImportNode($session);
@ -122,7 +124,7 @@ my $uri = URI->new($url);
is($uri->path, $posters->getUrl, 'Link in message has correct URL path');
is($uri->query, 'func=editVariant;vid='.$marilynVarId, 'Link in message has function and variant id');
wipeMessages($inbox, $admin);
WebGUI::Test->cleanupAdminInbox;
is(scalar @{$inbox->getMessagesForUser($admin)}, 0, 'All messages deleted');
$instance1->delete;
@ -148,6 +150,13 @@ $message = $inbox->getMessagesForUser($admin)->[0];
note "Test that the workflow does not die when encountering bad assets";
my $otherPosters = $posters->duplicate;
WebGUI::Test->addToCleanup(sub {
$session->db->write("delete from asset where assetId=?",[$otherPosters->getId]);
$session->db->write("delete from assetData where assetId=?",[$otherPosters->getId]);
$session->db->write("delete from sku where assetId=?",[$otherPosters->getId]);
$session->db->write("delete from Product where assetId=?",[$otherPosters->getId]);
$session->db->write("delete from assetIndex where assetId=?",[$otherPosters->getId]);
});
my $movie_posters = $import->addChild({
className => 'WebGUI::Asset::Sku::Product',
url => 'movie_posters',
@ -181,7 +190,7 @@ is($retVal, 'done', 'Workflow is done');
$messages = $inbox->getMessagesForUser($admin);
is(scalar @{$messages}, 1, 'Received one message');
wipeMessages($inbox, $admin);
WebGUI::Test->cleanupAdminInbox;
my $instance4 = WebGUI::Workflow::Instance->create($session,
{
@ -200,24 +209,5 @@ is($retVal, 'done', 'Workflow is done');
$messages = $inbox->getMessagesForUser($admin);
is(scalar @{$messages}, 1, 'Still received one message');
wipeMessages($inbox, $admin);
END {
wipeMessages($inbox, $admin);
$messages = $inbox->getMessagesForUser($admin);
is(scalar @{$messages}, 0, 'Inbox cleaned up');
$session->db->write("delete from mailQueue where message like '%Threshold=15%'");
$session->db->write("delete from asset where assetId=?",[$otherPosters->getId]);
$session->db->write("delete from assetData where assetId=?",[$otherPosters->getId]);
$session->db->write("delete from sku where assetId=?",[$otherPosters->getId]);
$session->db->write("delete from Product where assetId=?",[$otherPosters->getId]);
$session->db->write("delete from assetIndex where assetId=?",[$otherPosters->getId]);
}
sub wipeMessages {
my ($inbox, $user) = @_;
foreach my $message (@{ $inbox->getMessagesForUser($user) }) {
$message->delete;
}
}
#vim:ft=perl

103
t/Workflow/Activity/TrashExpiredEvents.t Normal file
View file

@ -0,0 +1,103 @@
#-------------------------------------------------------------------
# WebGUI is Copyright 2001-2009 Plain Black Corporation.
#-------------------------------------------------------------------
# Please read the legal notices (docs/legal.txt) and the license
# (docs/license.txt) that came with this distribution before using
# this software.
#-------------------------------------------------------------------
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
use FindBin;
use strict;
use lib "$FindBin::Bin/../../lib";
use WebGUI::Test;
use WebGUI::Session;
use WebGUI::Utility;
use WebGUI::Workflow::Activity::TrashExpiredEvents;
use WebGUI::Asset;
use Test::More;
use Test::Deep;
plan tests => 5; # increment this value for each test you create
my $session = WebGUI::Test->session;
$session->user({userId => 3});
my $bday = WebGUI::DateTime->new($session, WebGUI::Test->webguiBirthday)->cloneToUserTimeZone;
my $now = WebGUI::DateTime->new($session, time())->cloneToUserTimeZone;
my $tz = $session->datetime->getTimeZone();
my $root = WebGUI::Asset->getRoot($session);
my $calendar = $root->addChild({
className => 'WebGUI::Asset::Wobject::Calendar',
title => 'Test Calendar',
});
my $wgBday = $calendar->addChild({
className => 'WebGUI::Asset::Event',
title => 'WebGUI Birthday',
startDate => $bday->toDatabaseDate,
endDate => $bday->toDatabaseDate,
timeZone => $tz,
}, undef, undef, {skipAutoCommitWorkflows => 1});
my $wrongBday = $calendar->addChild({
className => 'WebGUI::Asset::Event',
title => 'Wrong Birthday',
startDate => $bday->toDatabaseDate,
endDate => $bday->toDatabaseDate,
timeZone => $tz,
}, undef, time()-5, {skipAutoCommitWorkflows => 1});
$wrongBday->addRevision({
startDate => $now->toDatabaseDate,
endDate => $now->toDatabaseDate,
}, undef, undef, {skipAutoCommitWorkflows => 1});
my $nowEvent = $calendar->addChild({
className => 'WebGUI::Asset::Event',
title => 'WebGUI Birthday',
startDate => $now->toDatabaseDate,
endDate => $now->toDatabaseDate,
timeZone => $tz,
}, undef, undef, {skipAutoCommitWorkflows => 1});
my $tag = WebGUI::VersionTag->getWorking($session);
$tag->commit;
WebGUI::Test->addToCleanup($tag);
my $workflow = WebGUI::Workflow->create($session,
{
enabled => 1,
objectType => 'None',
mode => 'realtime',
},
);
WebGUI::Test->addToCleanup($workflow);
my $eventNuker = $workflow->addActivity('WebGUI::Workflow::Activity::TrashExpiredEvents');
$eventNuker->set('trashAfter', 3600);
my $instance1 = WebGUI::Workflow::Instance->create($session,
{
workflowId => $workflow->getId,
skipSpectreNotification => 1,
}
);
my $retVal;
$retVal = $instance1->run();
is($retVal, 'complete', 'cleanup: activity complete');
$retVal = $instance1->run();
is($retVal, 'done', 'cleanup: activity is done');
$instance1->delete('skipNotify');
my $wgBdayCopy = $wgBday->cloneFromDb;
my $nowEventCopy = $nowEvent->cloneFromDb;
my $wrongBdayCopy = $wrongBday->cloneFromDb;
is $wgBdayCopy->get('state'), 'trash', 'old event was trashed';
is $nowEventCopy->get('state'), 'published', 'recent event was left alone';
is $wrongBdayCopy->get('state'), 'published', 'revisioned event was left alone';

1
t/i18n/template.t
View file

@ -30,6 +30,7 @@ my $numTests = 0;
my $session = WebGUI::Test->session;
## Remove all macros but International, and set them to call WebGUI::Macro::Callback
WebGUI::Test->originalConfig('macros');
my $originalMacros = $session->config->get('macros');
my $configFileMacros = {};
for my $macro (keys %$originalMacros) {

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

@ -32,6 +32,9 @@ use Log::Log4perl; # load early to ensure proper order of END blocks
use Clone qw(clone);
use File::Basename qw(dirname fileparse);
use File::Spec::Functions qw(abs2rel rel2abs catdir catfile updir);
use IO::Handle ();
use IO::Select ();
use Cwd ();
use Scalar::Util qw( blessed );
use Carp qw( carp croak );
use List::MoreUtils qw(any);
@ -106,6 +109,9 @@ sub _initSession {
Workflows => 'Workflow',
'Workflow Instances' => 'WorkflowInstance',
Carts => 'cart',
AdSpaces => 'adSpace',
Ads => 'advertisement',
Inbox => 'inbox',
Transactions => 'transaction',
'Transaction Items' => 'transactionItem',
'Address Books' => 'addressBook',
@ -516,6 +522,25 @@ sub originalConfig {
#----------------------------------------------------------------------------
=head2 cleanupAdminInbox ( )
Push a list of Asset objects onto the stack of assets to be automatically purged
at the end of the test. This will also clean-up all version tags associated
with the Asset.
This is a class method.
=cut
sub cleanupAdminInbox {
my $class = shift;
my $admin = WebGUI::User->new($class->session, '3');
my $inbox = WebGUI::Inbox->new($class->session);
$inbox->deleteMessagesForUser($admin);
}
#----------------------------------------------------------------------------
=head2 cleanupGuard ( $object, $class => $ident )
Pass in a list of objects or pairs of classes and identifiers, and
@ -524,6 +549,7 @@ object goes out of scope, it will automatically clean up all of the
passed in objects. Objects will be destroyed in the order they
were passed in. Currently able to destroy:
WebGUI::AdSpace
WebGUI::Asset
WebGUI::Group
WebGUI::Session
@ -535,9 +561,11 @@ were passed in. Currently able to destroy:
WebGUI::Shop::ShipDriver
WebGUI::Shop::PayDriver
WebGUI::Shop::Transaction
WebGUI::Shop::Vendor
WebGUI::Shop::AddressBook
WebGUI::DatabaseLink
WebGUI::LDAPLink
WebGUI::Inbox::Message
Example call:
@ -637,9 +665,13 @@ Example call:
'WebGUI::Shop::Transaction' => 'delete',
'WebGUI::Shop::ShipDriver' => 'delete',
'WebGUI::Shop::PayDriver' => 'delete',
'WebGUI::Shop::Vendor' => 'delete',
'WebGUI::Inbox::Message' => 'purge',
'WebGUI::AdSpace' => 'delete',
'WebGUI::FilePump::Bundle' => 'delete',
'WebGUI::Shop::Cart' => sub {
my $cart = shift;
my $addressBook = $cart->getAddressBook();
my $addressBook = eval { $cart->getAddressBook(); };
$addressBook->delete if $addressBook; ##Should we call cleanupGuard instead???
$cart->delete;
},