Introduce WebGUI::Test::getPage2, similar to WebGUI::Test::getPage, that makes

requests using Plack::Test and attempts to maintain getPage's API.
Change three tests in t/Asset/AssetExportHtml.t to use this instead.
Backstory:
Forthcoming WebGUI::Session::HTTP, ::Request, ::Responses mucking abouts broke
some tests that use WebGUI::Test::getPage; in the case of t/Asset/AssetExportHtml.t,
files were written correctly to disc but tests failed because it was comparing them
to undef, which it got back for the page, apparently because getPage bypasses the
logic that traps printing to a filehandle.
This commit is contained in:
Scott Walters 2011-05-11 13:58:20 -04:00
parent 2d31f7234a
commit d2c8670098
2 changed files with 106 additions and 10 deletions

View file

@ -46,6 +46,12 @@ use WebGUI::Paths -inc;
use namespace::clean;
use WebGUI::User;
use Plack::Test;
use Plack::Util;
use HTTP::Request::Common;
use WebGUI::GUID;
our @EXPORT = qw(cleanupGuard addToCleanup);
our @EXPORT_OK = qw(session config collateral);
@ -377,6 +383,7 @@ below.
# I think that getPage should be entirely replaced with calles to Plack::Test::test_psgi
# - testing with the callback is better and it means we can run on any backend
# I agree.
sub getPage {
my $class = shift;
my $actor = shift; # The actor to work on
@ -431,6 +438,90 @@ sub getPage {
return join '', @{$session->response->body};
}
=head2 getPage2 ( request|url [, opts] )
Get the entire response from a page request using L<Plack::Test>.
Accepts an L<HTTP::Request> object as an argument, which cooked up auth info will be added to.
An L<HTTP::Request> will be constructed from a simple relative URL such as C<home> if a string is passed instead.
Returns an L<HTTP::Response> object on which you may call C<< decoded_content() >> to get the body content as a string.
C<options> is a hash reference of options with keys outlined below.
user => A user object to set for this request
userId => A userId to set for this request
formParams => A hash reference of form parameters
Compared to C<getPage> above, these are not yet supported:
uploads
args
=cut
sub getPage2 {
my $class = shift;
my $request = shift;
my $optionsRef = shift; # A hashref of options
# args => Array ref of args to the page sub
# user => A user object to set
# userId => A user ID to set, "user" takes
# precedence
die "not supported" if exists $optionsRef->{args};
die "not supported" if exists $optionsRef->{formParams};
die "not supported" if exists $optionsRef->{uploads};
my $session = $CLASS->session;
# Save state
my $oldUser = $session->user;
my $oldRequest = $session->request;
# Set the appropriate user
if ($optionsRef->{user}) {
$session->user({ user => $optionsRef->{user} });
}
elsif ($optionsRef->{userId}) {
$session->user({ userId => $optionsRef->{userId} });
}
$session->user->uncache;
# Fake up a logged in session
my $wgSession = WebGUI::GUID->generate;
$session->db->write(qq{
replace into userSession (sessionId, expires, lastPageView, userId)
values (?, ?, ?, ?)
}, [
$wgSession, scalar time + 60 * 20, scalar time, $session->user->userId,
] ) or die;
my $response;
# Create a new request object, or fix up the one given to us
if( ! eval { $request->isa('HTTP::Request') } ) {
if( $optionsRef->{formParams} ) {
$request = HTTP::Request::Common::POST( "http://127.0.0.1/$request", [ %{ $optionsRef->{formParams} } ] ) or die;
} else {
$request = HTTP::Request->new( GET => "http://127.0.0.1/$request" ) or die;
}
}
$request->header( 'Set-Cookie3' => qq{wgSession=$wgSession; path="/"; domain=127.0.0.1; path_spec; discard; version=0} );
my $app = Plack::Util::load_psgi( WebGUI::Paths->defaultPSGI ) or die;
test_psgi $app, sub {
my $cb = shift;
$response = $cb->( $request );
};
# Restore the former user and request
$session->user({ user => $oldUser });
$session->{_request} = $oldRequest; # dubious about this; if we're going to try to support requests inside of other requests, it should be tested and actually supported rather than just some optimistic arm waving done
return $response;
}
#----------------------------------------------------------------------------
=head2 getTestCollateralPath ( [filename] )

View file

@ -378,7 +378,7 @@ is($fileAsPath->absolute($exportPath)->stringify, $litmus->absolute($exportPath)
# we need to be tricky here and call code in wG proper which calls www_ methods
# even though we don't have access to modperl. the following hack lets us do
# that.
#$session->http->setNoHeader(1);
#$session->response->setNoHeader(1);
$session->user( { userId => 1 } );
my $content;
@ -392,7 +392,12 @@ is($@, '', "exportWriteFile works when creating exportPath");
ok(-e $parent->exportGetUrlAsPath->absolute->stringify, "exportWriteFile actually writes the file when creating exportPath");
# now make sure that it contains the correct content
eval { $content = WebGUI::Test->getPage($parent, 'exportHtml_view', { user => WebGUI::User->new($session, 1) } ) };
eval {
$content = WebGUI::Test->getPage2(
$parent->get('url').'?func=exportHtml_view',
{ user => WebGUI::User->new($session, 1) },
)->decoded_content
};
is(scalar $parent->exportGetUrlAsPath->slurp, $content, "exportWriteFile puts the correct contents in exported parent");
@ -405,7 +410,7 @@ my $unwritablePath = Path::Class::Dir->new($config->get('uploadsPath'), 'temp',
chmod 0000, $guidPath->stringify;
$config->set('exportPath', $unwritablePath->absolute->stringify);
$session->http->setNoHeader(1);
$session->response->setNoHeader(1);
SKIP: {
skip 'Root will cause this test to fail since it does not obey file permissions', 2
if $< == 0;
@ -436,7 +441,7 @@ $config->set('exportPath', $guidPath->absolute->stringify);
chmod 0755, $guidPath->stringify;
$unwritablePath->remove;
$session->http->setNoHeader(1);
$session->response->setNoHeader(1);
eval { $firstChild->exportWriteFile() };
is($@, '', "exportWriteFile works for first_child");
@ -444,14 +449,14 @@ is($@, '', "exportWriteFile works for first_child");
ok(-e $firstChild->exportGetUrlAsPath->absolute->stringify, "exportWriteFile actually writes the first_child file");
# verify it has the correct contents
eval { $content = WebGUI::Test->getPage($firstChild, 'exportHtml_view') };
eval { $content = WebGUI::Test->getPage2( $firstChild->get('url').'?func=exportHtml_view', )->decoded_content };
is(scalar $firstChild->exportGetUrlAsPath->absolute->slurp, $content, "exportWriteFile puts the correct contents in exported first_child");
# and one more level. remove the export path to ensure directory creation keeps
# working.
$guidPath->rmtree;
$session->http->setNoHeader(1);
$session->response->setNoHeader(1);
$session->user( { userId => 1 } );
eval { $grandChild->exportWriteFile() };
is($@, '', "exportWriteFile works for grandchild");
@ -461,13 +466,13 @@ ok(-e $grandChild->exportGetUrlAsPath->absolute->stringify, "exportWriteFile act
# finally, check its contents
$session->style->sent(0);
eval { $content = WebGUI::Test->getPage($grandChild, 'exportHtml_view') };
eval { $content = WebGUI::Test->getPage2( $grandChild->get('url').'?func=exportHtml_view', )->decoded_content };
is(scalar $grandChild->exportGetUrlAsPath->absolute->slurp, $content, "exportWriteFile puts correct content in exported grandchild");
# test different extensions
$guidPath->rmtree;
$asset = WebGUI::Asset->newById($session, 'ExportTest000000000001');
$session->http->setNoHeader(1);
$session->response->setNoHeader(1);
eval { $asset->exportWriteFile() };
is($@, '', 'exportWriteFile for perl file works');
@ -488,7 +493,7 @@ $guidPath->rmtree;
# isn't allowed to see. this means that we'll need to temporarily change the
# permissions on something.
$parent->update( { groupIdView => 3 } ); # admins
$session->http->setNoHeader(1);
$session->response->setNoHeader(1);
eval { $parent->exportWriteFile() };
$e = Exception::Class->caught();
isa_ok($e, 'WebGUI::Error', "exportWriteFile throws when user can't view asset");
@ -912,7 +917,7 @@ SKIP: {
# user can't view asset
$parent->update( { groupIdView => 3 } );
$session->http->setNoHeader(1);
$session->response->setNoHeader(1);
chmod 0755, $tempDirectory;
eval { ($message) = $parent->exportAsHtml( { userId => 1, depth => 99 } ) };