clean up some parts of WebGUI::Test
This commit is contained in:
parent
1450d1361d
commit
7c87a34bf5
1 changed files with 32 additions and 32 deletions
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue