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

Revert "use temp config file for testing"

Browse source 
This reverts commit 9b725c6d42.
This commit is contained in:
Colin Kuskie 2010-06-14 15:19:54 -07:00
parent ce6f70ca94
commit 6c3369d0cb
22 changed files with 94 additions and 57 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -32,22 +32,22 @@ 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 List::MoreUtils qw( any );
use Carp qw( carp croak );
use JSON qw( from_json to_json );
use File::Copy ();
use File::Temp ();
use Scope::Guard;
our ($WEBGUI_TEST_ROOT, $WEBGUI_TEST_COLLATERAL, $WEBGUI_ROOT, $WEBGUI_LIB);
BEGIN {
our $WEBGUI_TEST_ROOT = rel2abs( catdir( dirname( __FILE__ ), (updir) x 2 ) );
our $WEBGUI_TEST_COLLATERAL = catdir(
our $WEBGUI_TEST_ROOT = File::Spec->catdir(
File::Spec->catpath((File::Spec->splitpath(__FILE__))[0,1], ''),
(File::Spec->updir) x 2
);
our $WEBGUI_TEST_COLLATERAL = File::Spec->catdir(
$WEBGUI_TEST_ROOT,
'supporting_collateral'
);
@ -86,30 +86,21 @@ our @EXPORT_OK = qw(session config collateral);
my $CLASS = __PACKAGE__;
my $original_config_file;
sub import {
if ( ! $original_config_file ) {
my $config = $ENV{WEBGUI_CONFIG};
die "Enviroment variable WEBGUI_CONFIG must be set to the full path to a WebGUI config file.\n"
unless $config;
our $CONFIG_FILE = $ENV{ WEBGUI_CONFIG };
for my $tryPath (
rel2abs( $config ),
rel2abs( $config, $CLASS->root, 'etc' )
) {
if ( -e $tryPath ) {
$config = $tryPath;
}
}
die "Enviroment variable WEBGUI_CONFIG must be set to the full path to a WebGUI config file.\n"
unless $CONFIG_FILE;
die "WEBGUI_CONFIG path '$CONFIG_FILE' does not exist.\n"
unless -e $CONFIG_FILE;
die "WEBGUI_CONFIG path '$CONFIG_FILE' is not a file.\n"
unless -f _;
die "WEBGUI_CONFIG path '$CONFIG_FILE' is not readable by effective uid '$>'.\n"
unless -r _;
my $etcDir = Cwd::realpath(File::Spec->catdir($CLASS->root, 'etc'));
$CONFIG_FILE = File::Spec->abs2rel($CONFIG_FILE, $etcDir);
die "WEBGUI_CONFIG path '$config' does not exist.\n"
unless -e $config;
die "WEBGUI_CONFIG path '$config' is not a file.\n"
unless -f _;
die "WEBGUI_CONFIG path '$config' is not readable by effective uid '$>'.\n"
unless -r _;
$original_config_file = abs2rel( $config, catdir( $CLASS->root, 'etc') );
}
goto &{ $_[0]->can('SUPER::import') };
}
@ -370,26 +361,8 @@ Returns the name of the WebGUI config file used for this test.
=cut
my $config_copy;
sub file {
return $config_copy
if $config_copy;
my $config_base = fileparse( $original_config_file, '.conf' );
my (undef, $config_copy_abs) = File::Temp::tempfile(
"$config_base-XXXX",
SUFFIX => '.conf',
UNLINK => 0,
OPEN => 0,
TMPDIR => 1,
);
File::Copy::copy($original_config_file, $config_copy_abs);
$CLASS->addToCleanup(sub {
unlink $config_copy_abs;
undef $config_copy;
undef $config;
});
$config_copy = abs2rel( $config_copy_abs, catdir( $WEBGUI_ROOT, 'etc') );
return $config_copy;
return our $CONFIG_FILE;
}
#----------------------------------------------------------------------------
@ -478,7 +451,7 @@ Optionally adds a filename to the end.
sub getTestCollateralPath {
my $class = shift;
my @path = @_;
return catfile(our $WEBGUI_TEST_COLLATERAL, @path);
return File::Spec->catfile(our $WEBGUI_TEST_COLLATERAL, @path);
}
sub collateral {
@ -596,6 +569,7 @@ sub prepareMailServer {
$CLASS->session->setting->set( 'smtpServer', $SMTP_HOST . ':' . $SMTP_PORT );
$CLASS->originalConfig('emailToLog');
$CLASS->session->config->set( 'emailToLog', 0 );
# Let it start up yo
@ -618,6 +592,38 @@ sub prepareMailServer {
#----------------------------------------------------------------------------
=head2 originalConfig ( $param )
Stores the original data from the config file, to be restored
automatically at the end of the test. This is a class method.
=cut
my %originalConfig;
sub originalConfig {
my ($class, $param) = @_;
my $safeValue = my $value = $CLASS->session->config->get($param);
if (ref $value) {
$safeValue = clone $value;
}
# add cleanup handler if this is the first time we were run
if (! keys %originalConfig) {
$class->addToCleanup(sub {
while (my ($key, $value) = each %originalConfig) {
if (defined $value) {
$CLASS->session->config->set($key, $value);
}
else {
$CLASS->session->config->delete($key);
}
}
});
}
$originalConfig{$param} = $safeValue;
}
#----------------------------------------------------------------------------
=head2 getMail ( )
Read a sent mail from the prepared mail server (L<prepareMailServer>)