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

backport WebGUI::Test improvements

Browse source
This commit is contained in:
Graham Knop 2010-06-10 09:24:18 -05:00
parent b832deecd1
commit e10f4d0aec
1 changed files with 62 additions and 28 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -28,8 +28,8 @@ use base qw(Test::Builder::Module);
use Test::MockObject; use Test::MockObject;
use Test::MockObject::Extends; use Test::MockObject::Extends;
use Log::Log4perl; # load early to ensure proper order of END blocks
use Clone qw(clone); use Clone qw(clone);
use Config ();
use IO::Handle (); use IO::Handle ();
use File::Spec (); use File::Spec ();
use IO::Select (); use IO::Select ();
@ -41,35 +41,47 @@ use JSON qw( from_json to_json );
use Scope::Guard; use Scope::Guard;
BEGIN { BEGIN {
my $file_root = File::Spec->catpath((File::Spec->splitpath(__FILE__))[0,1], '');
our $WEBGUI_ROOT = Cwd::realpath( File::Spec->catdir( $file_root, (File::Spec->updir) x 3 )); our $WEBGUI_TEST_ROOT = File::Spec->catdir(
our $WEBGUI_TEST_COLLATERAL = File::Spec->catdir($WEBGUI_ROOT, 't', 'supporting_collateral'); File::Spec->catpath((File::Spec->splitpath(__FILE__))[0,1], ''),
our $WEBGUI_LIB = File::Spec->catdir( $WEBGUI_ROOT, 'lib' ); (File::Spec->updir) x 2
);
our $WEBGUI_TEST_COLLATERAL = File::Spec->catdir(
$WEBGUI_TEST_ROOT,
'supporting_collateral'
);
our $WEBGUI_ROOT = File::Spec->catdir(
$WEBGUI_TEST_ROOT,
File::Spec->updir,
);
our $WEBGUI_LIB = File::Spec->catdir(
$WEBGUI_ROOT,
'lib',
);
push @INC, $WEBGUI_LIB; push @INC, $WEBGUI_LIB;
##Handle custom loaded library paths ##Handle custom loaded library paths
my $customPreload = File::Spec->catfile( $WEBGUI_ROOT, 'sbin', 'preload.custom'); my $customPreload = File::Spec->catfile( $WEBGUI_ROOT, 'sbin', 'preload.custom');
if (-e $customPreload) { if (-e $customPreload) {
open my $PRELOAD, '<', $customPreload or open my $PRELOAD, '<', $customPreload or
croak "Unload to open $customPreload: $!\n"; croak "Unload to open $customPreload: $!\n";
LINE: while (my $line = <$PRELOAD>) { LINE: while (my $line = <$PRELOAD>) {
$line =~ s/#.*//; $line =~ s/#.*//;
$line =~ s/^\s+//; $line =~ s/^\s+//;
$line =~ s/\s+$//; $line =~ s/\s+$//;
next LINE if !$line; next LINE if !$line;
unshift @INC, $line; unshift @INC, $line;
}
close $PRELOAD;
} }
close $PRELOAD;
}
} }
use WebGUI::Session;
use WebGUI::PseudoRequest; use WebGUI::PseudoRequest;
our @EXPORT = qw(cleanupGuard addToCleanup); our @EXPORT = qw(cleanupGuard addToCleanup);
our @EXPORT_OK = qw(session config); our @EXPORT_OK = qw(session config collateral);
my $CLASS = __PACKAGE__; my $CLASS = __PACKAGE__;
@ -86,6 +98,11 @@ sub import {
unless -r _; unless -r _;
$CONFIG_FILE = File::Spec->abs2rel($CONFIG_FILE, File::Spec->catdir($CLASS->root, 'etc')); $CONFIG_FILE = File::Spec->abs2rel($CONFIG_FILE, File::Spec->catdir($CLASS->root, 'etc'));
goto &{ $_[0]->can('SUPER::import') };
}
sub _initSession {
my $session = our $SESSION = $CLASS->newSession(1); my $session = our $SESSION = $CLASS->newSession(1);
my $originalSetting = clone $session->setting->get; my $originalSetting = clone $session->setting->get;
@ -134,8 +151,6 @@ sub import {
} }
}); });
} }
goto &{ $_[0]->can('SUPER::import') };
} }
END { END {
@ -155,8 +170,11 @@ If true, the session won't be registered for automatic deletion.
=cut =cut
sub newSession { sub newSession {
shift
if eval { $_[0]->isa($CLASS) };
my $noCleanup = shift; my $noCleanup = shift;
my $pseudoRequest = WebGUI::PseudoRequest->new; my $pseudoRequest = WebGUI::PseudoRequest->new;
require WebGUI::Session;
my $session = WebGUI::Session->open( $CLASS->root, $CLASS->file ); my $session = WebGUI::Session->open( $CLASS->root, $CLASS->file );
$session->{_request} = $pseudoRequest; $session->{_request} = $pseudoRequest;
if ( ! $noCleanup ) { if ( ! $noCleanup ) {
@ -324,9 +342,13 @@ Returns the config object from the session.
=cut =cut
my $config;
sub config { sub config {
return undef unless defined $CLASS->session; return $config
return $CLASS->session->config; if $config;
require WebGUI::Config;
$config = WebGUI::Config->new(our $CONFIG_FILE);
return $config;
} }
#---------------------------------------------------------------------------- #----------------------------------------------------------------------------
@ -426,8 +448,12 @@ Optionally adds a filename to the end.
sub getTestCollateralPath { sub getTestCollateralPath {
my $class = shift; my $class = shift;
my $filename = shift; my @path = @_;
return File::Spec->catfile(our $WEBGUI_TEST_COLLATERAL, $filename); return File::Spec->catfile(our $WEBGUI_TEST_COLLATERAL, @path);
}
sub collateral {
return $CLASS->getTestCollateralPath(@_);
} }
#---------------------------------------------------------------------------- #----------------------------------------------------------------------------
@ -470,7 +496,11 @@ disabled.
=cut =cut
sub session { sub session {
return our $SESSION; our $SESSION;
if (! $SESSION) {
_initSession();
}
return $SESSION;
} }
#---------------------------------------------------------------------------- #----------------------------------------------------------------------------
@ -711,6 +741,10 @@ Example call:
my ($class, $ident) = @_; my ($class, $ident) = @_;
return $class->new($CLASS->session, $ident); return $class->new($CLASS->session, $ident);
}, },
'WebGUI::Asset' => sub {
my ($class, $ident) = @_;
return WebGUI::Asset->newPending($CLASS->session, $ident);
},
'WebGUI::Storage' => sub { 'WebGUI::Storage' => sub {
my ($class, $ident) = @_; my ($class, $ident) = @_;
return WebGUI::Storage->get($CLASS->session, $ident); return WebGUI::Storage->get($CLASS->session, $ident);