clean up some parts of WebGUI::Test

This commit is contained in:
Graham Knop 2010-05-08 16:35:54 -05:00
parent 1450d1361d
commit 7c87a34bf5

View file

@ -57,8 +57,6 @@ our @EXPORT_OK = qw(session config collateral);
my $CLASS = __PACKAGE__;
my @guarded;
sub import {
our $CONFIG_FILE = $ENV{ WEBGUI_CONFIG };
@ -80,7 +78,7 @@ sub _initSession {
my $session = our $SESSION = $CLASS->newSession(1);
my $originalSetting = clone $session->setting->get;
push @guarded, Scope::Guard->new(sub {
$CLASS->addToCleanup(sub {
while (my ($param, $value) = each %{ $originalSetting }) {
$session->setting->set($param, $value);
}
@ -110,7 +108,7 @@ sub _initSession {
my ($label, $table) = @checkCount[$i, $i+1];
$initCounts{$table} = $session->db->quickScalar('SELECT COUNT(*) FROM ' . $table);
}
push @guarded, Scope::Guard->new(sub {
$CLASS->addToCleanup(sub {
for ( my $i = 0; $i < @checkCount; $i += 2) {
my ($label, $table) = @checkCount[$i, $i+1];
my $quant = $session->db->quickScalar('SELECT COUNT(*) FROM ' . $table);
@ -127,19 +125,6 @@ END {
$CLASS->cleanup;
}
sub cleanup {
# remove guards in reverse order they were added, triggering all of the
# requested cleanup operations
pop @guarded
while @guarded;
if ( our $SESSION ) {
$SESSION->var->end;
$SESSION->close;
undef $SESSION;
}
}
#----------------------------------------------------------------------------
=head2 newSession ( $noCleanup )
@ -159,7 +144,7 @@ sub newSession {
my $session = WebGUI::Session->open( $CLASS->config );
$session->{_request} = $pseudoRequest;
if ( ! $noCleanup ) {
$CLASS->sessionsToDelete($session);
$CLASS->addToCleanup($session);
}
return $session;
}
@ -543,7 +528,7 @@ sub prepareMailServer {
# Let it start up yo
sleep 2;
push @guarded, Scope::Guard->new(sub {
$CLASS->addToCleanup(sub {
# Close SMTPD
if ($smtpdPid) {
kill INT => $smtpdPid;
@ -576,7 +561,7 @@ sub originalConfig {
}
# add cleanup handler if this is the first time we were run
if (! keys %originalConfig) {
push @guarded, Scope::Guard->new(sub {
$class->addToCleanup(sub {
while (my ($key, $value) = each %originalConfig) {
if (defined $value) {
$CLASS->session->config->set($key, $value);
@ -592,7 +577,7 @@ sub originalConfig {
#----------------------------------------------------------------------------
=head2 getMail ( )
=head2 getMail ( )
Read a sent mail from the prepared mail server (L<prepareMailServer>)
@ -600,7 +585,7 @@ Read a sent mail from the prepared mail server (L<prepareMailServer>)
sub getMail {
my $json;
if ( !$smtpdSelect ) {
return from_json ' { "error": "mail server not prepared" }';
}
@ -611,11 +596,11 @@ sub getMail {
else {
$json = ' { "error": "mail not sent" } ';
}
if (!$json) {
$json = ' { "error": "error in getting mail" } ';
}
return from_json( $json );
}
@ -635,7 +620,7 @@ sub getMailFromQueue {
if ( !$smtpdSelect ) {
$class->prepareMailServer;
}
my $messageId = $CLASS->session->db->quickScalar( "SELECT messageId FROM mailQueue" );
warn $messageId;
return unless $messageId;
@ -646,6 +631,7 @@ sub getMailFromQueue {
return $class->getMail;
}
#----------------------------------------------------------------------------
=head2 sessionsToDelete ( $session, [$session, ...] )
@ -660,7 +646,7 @@ This is a class method.
sub sessionsToDelete {
my $class = shift;
push @guarded, cleanupGuard(@_);
$class->addToCleanup(@_);
}
#----------------------------------------------------------------------------
@ -677,7 +663,7 @@ This is a class method.
sub assetsToPurge {
my $class = shift;
push @guarded, cleanupGuard(@_);
$class->addToCleanup(@_);
}
#----------------------------------------------------------------------------
@ -693,7 +679,7 @@ This is a class method.
sub groupsToDelete {
my $class = shift;
push @guarded, cleanupGuard(@_);
$class->addToCleanup(@_);
}
@ -710,7 +696,7 @@ This is a class method.
sub storagesToDelete {
my $class = shift;
push @guarded, cleanupGuard(map {
$class->addToCleanup(map {
ref $_ ? $_ : ('WebGUI::Storage' => $_)
} @_);
}
@ -727,7 +713,7 @@ This is a class method.
sub tagsToRollback {
my $class = shift;
push @guarded, cleanupGuard(@_);
$class->addToCleanup(@_);
}
#----------------------------------------------------------------------------
@ -743,7 +729,7 @@ This is a class method.
sub usersToDelete {
my $class = shift;
push @guarded, cleanupGuard(@_);
$class->addToCleanup(@_);
}
#----------------------------------------------------------------------------
@ -759,7 +745,7 @@ This is a class method.
sub workflowsToDelete {
my $class = shift;
push @guarded, cleanupGuard(@_);
$class->addToCleanup(@_);
}
@ -973,12 +959,26 @@ This is a class method.
=cut
my @guarded;
sub addToCleanup {
shift
if eval { $_[0]->isa($CLASS) };
push @guarded, cleanupGuard(@_);
}
sub cleanup {
# remove guards in reverse order they were added, triggering all of the
# requested cleanup operations
pop @guarded
while @guarded;
if ( our $SESSION ) {
$SESSION->var->end;
$SESSION->close;
undef $SESSION;
}
}
#----------------------------------------------------------------------------
=head1 BUGS