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

Forward port auto storage deletion code for WebGUI::Test.

Browse source
This commit is contained in:
Colin Kuskie 2009-04-13 17:36:23 +00:00
parent d5893a5a6a
commit decde00451
1 changed files with 28 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -52,6 +52,7 @@ my %originalConfig;
my $originalSetting; my $originalSetting;
my @groupsToDelete; my @groupsToDelete;
my @storagesToDelete;
BEGIN { BEGIN {
@ -140,6 +141,15 @@ END {
foreach my $group (@groupsToDelete) { foreach my $group (@groupsToDelete) {
$group->delete; $group->delete;
} }
foreach my $stor (@storagesToDelete) {
if ($SESSION->id->valid($stor)) {
my $storage = WebGUI::Storage->get($SESSION, $stor);
$storage->delete if $storage;
}
else {
$stor->delete;
}
}
if ($ENV{WEBGUI_TEST_DEBUG}) { if ($ENV{WEBGUI_TEST_DEBUG}) {
$Test->diag('Sessions: '.$SESSION->db->quickScalar('select count(*) from userSession')); $Test->diag('Sessions: '.$SESSION->db->quickScalar('select count(*) from userSession'));
$Test->diag('Scratch : '.$SESSION->db->quickScalar('select count(*) from userSessionScratch')); $Test->diag('Scratch : '.$SESSION->db->quickScalar('select count(*) from userSessionScratch'));
@ -379,6 +389,8 @@ sub originalConfig {
Push a list of group objects onto the stack of groups to be automatically deleted Push a list of group objects onto the stack of groups to be automatically deleted
at the end of the test. at the end of the test.
This is a class method.
=cut =cut
sub groupsToDelete { sub groupsToDelete {
@ -388,6 +400,22 @@ sub groupsToDelete {
#---------------------------------------------------------------------------- #----------------------------------------------------------------------------
=head2 storagesToDelete ( $storage, [$storageId ] )
Push a list of storage objects or storageIds onto the stack of storage locaitons
at the end of the test.
This is a class method.
=cut
sub storagesToDelete {
my $class = shift;
push @storagesToDelete, @_;
}
#----------------------------------------------------------------------------
=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