diff --git a/lib/WebGUI/Test.pm b/lib/WebGUI/Test.pm index 2fd561098..2eb15b6ed 100644 --- a/lib/WebGUI/Test.pm +++ b/lib/WebGUI/Test.pm @@ -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. + +Accepts an L object as an argument, which cooked up auth info will be added to. +An L will be constructed from a simple relative URL such as C if a string is passed instead. + +Returns an L object on which you may call C<< decoded_content() >> to get the body content as a string. +C 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 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] ) diff --git a/t/Asset/AssetExportHtml.t b/t/Asset/AssetExportHtml.t index 58b9673c7..94914c6df 100644 --- a/t/Asset/AssetExportHtml.t +++ b/t/Asset/AssetExportHtml.t @@ -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 } ) };