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

Handle automatically cleaning up users at the end of a test.

Browse source
This commit is contained in:
Colin Kuskie 2009-04-24 03:40:16 +00:00
parent 25ead75eba
commit 6137a06bb9
1 changed files with 24 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -35,6 +35,7 @@ use Cwd qw[];
use Test::MockObject::Extends; use Test::MockObject::Extends;
use WebGUI::PseudoRequest; use WebGUI::PseudoRequest;
use Scalar::Util qw( blessed ); use Scalar::Util qw( blessed );
use List::MoreUtils qw/ any /;
##Hack to get ALL test output onto STDOUT. ##Hack to get ALL test output onto STDOUT.
use Test::Builder; use Test::Builder;
@ -52,6 +53,7 @@ my %originalConfig;
my $originalSetting; my $originalSetting;
my @groupsToDelete; my @groupsToDelete;
my @usersToDelete;
my @storagesToDelete; my @storagesToDelete;
BEGIN { BEGIN {
@ -138,9 +140,14 @@ BEGIN {
END { END {
my $Test = Test::Builder->new; my $Test = Test::Builder->new;
foreach my $group (@groupsToDelete) { GROUP: foreach my $group (@groupsToDelete) {
$group->delete; $group->delete;
} }
USER: foreach my $user (@usersToDelete) {
my $userId = $user->userId;
next USER if any { $userId eq $_ } (1,3);
$user->delete;
}
foreach my $stor (@storagesToDelete) { foreach my $stor (@storagesToDelete) {
if ($SESSION->id->valid($stor)) { if ($SESSION->id->valid($stor)) {
my $storage = WebGUI::Storage->get($SESSION, $stor); my $storage = WebGUI::Storage->get($SESSION, $stor);
@ -416,6 +423,22 @@ sub storagesToDelete {
#---------------------------------------------------------------------------- #----------------------------------------------------------------------------
=head2 usersToDelete ( $user, [$user, ...] )
Push a list of user objects onto the stack of groups to be automatically deleted
at the end of the test. If found in the stack, the Admin and Visitor users will not be deleted.
This is a class method.
=cut
sub usersToDelete {
my $class = shift;
push @usersToDelete, @_;
}
#----------------------------------------------------------------------------
=head1 BUGS =head1 BUGS
When trying to load the APR module, perl invariably throws an Out Of Memory When trying to load the APR module, perl invariably throws an Out Of Memory