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

use temp config file for testing

Browse source
This commit is contained in:
Graham Knop 2010-06-10 09:48:18 -05:00
parent e10f4d0aec
commit 9b725c6d42
18 changed files with 47 additions and 93 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -30,23 +30,24 @@ use Test::MockObject;
use Test::MockObject::Extends;
use Log::Log4perl; # load early to ensure proper order of END blocks
use Clone qw(clone);
use IO::Handle ();
use File::Spec ();
use File::Basename qw(dirname);
use File::Spec::Functions qw(abs2rel rel2abs catdir catfile updir);
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 = File::Spec->catdir(
File::Spec->catpath((File::Spec->splitpath(__FILE__))[0,1], ''),
(File::Spec->updir) x 2
);
our $WEBGUI_TEST_COLLATERAL = File::Spec->catdir(
our $WEBGUI_TEST_ROOT = rel2abs( catdir( dirname( __FILE__ ), (updir) x 2 ) );
our $WEBGUI_TEST_COLLATERAL = catdir(
$WEBGUI_TEST_ROOT,
'supporting_collateral'
);
@ -85,20 +86,30 @@ our @EXPORT_OK = qw(session config collateral);
my $CLASS = __PACKAGE__;
my $original_config_file;
sub import {
our $CONFIG_FILE = $ENV{ WEBGUI_CONFIG };
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;
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 _;
$CONFIG_FILE = File::Spec->abs2rel($CONFIG_FILE, File::Spec->catdir($CLASS->root, 'etc'));
for my $tryPath (
rel2abs( $config ),
rel2abs( $config, $CLASS->root, 'etc' )
) {
if ( -e $tryPath ) {
$config = $tryPath;
}
}
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') };
}
@ -347,7 +358,7 @@ sub config {
return $config
if $config;
require WebGUI::Config;
$config = WebGUI::Config->new(our $CONFIG_FILE);
$config = WebGUI::Config->new($CLASS->file, 1);
return $config;
}
@ -359,8 +370,20 @@ Returns the name of the WebGUI config file used for this test.
=cut
my $config_copy;
sub file {
return our $CONFIG_FILE;
return $config_copy
if $config_copy;
my $config_base = $original_config_file;
$config_base =~ s/\.conf$//;
(undef, $config_copy) = File::Temp::tempfile("$config_base-XXXX", SUFFIX => '.conf', UNLINK => 0, OPEN => 0);
File::Copy::copy($original_config_file, $config_copy);
$CLASS->addToCleanup(sub {
unlink $config_copy;
undef $config_copy;
undef $config;
});
return $config_copy;
}
#----------------------------------------------------------------------------
@ -449,7 +472,7 @@ Optionally adds a filename to the end.
sub getTestCollateralPath {
my $class = shift;
my @path = @_;
return File::Spec->catfile(our $WEBGUI_TEST_COLLATERAL, @path);
return catfile(our $WEBGUI_TEST_COLLATERAL, @path);
}
sub collateral {
@ -567,7 +590,6 @@ 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
@ -590,38 +612,6 @@ 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>)