X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FTest.pm;h=7befe9947e929728ccfcb4537200cbedc79fa37c;hb=fb495632d15d5aa112371bb5c3c39a6189ddb9a0;hp=8776803e7d70a8d0c518a49e170fc528a11c6ce9;hpb=12755afcb3cde2d52091b9e7c664b1a7a9bb2d62;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Test.pm b/lib/Catalyst/Test.pm index 8776803..7befe99 100644 --- a/lib/Catalyst/Test.pm +++ b/lib/Catalyst/Test.pm @@ -44,7 +44,7 @@ my $build_exports = sub { ### place holder for $c after the request finishes; reset every time ### requests are done. - my $c; + my $ctx_closed_over; ### hook into 'dispatch' -- the function gets called after all plugins ### have done their work, and it's an easy place to capture $c. @@ -52,7 +52,7 @@ my $build_exports = sub { my $meta = Class::MOP::get_metaclass_by_name($class); $meta->make_mutable; $meta->add_after_method_modifier( "dispatch", sub { - $c = shift; + $ctx_closed_over = shift; }); $meta->make_immutable( replace_constructor => 1 ); Class::C3::reinitialize(); # Fixes RT#46459, I've failed to write a test for how/why, but it does. @@ -60,8 +60,18 @@ my $build_exports = sub { ### we've already stopped it from doing remote requests above. my $res = $request->( @_ ); + # Make sure not to leave a reference $ctx hanging around. + # This means that the context will go out of scope as soon as the + # caller disposes of it, rather than waiting till the next time + # that ctx_request is called. This can be important if your $ctx + # ends up with a reference to a shared resource or lock (for example) + # which you want to clean up in test teardown - if the $ctx is still + # closed over then you're stuffed... + my $ctx = $ctx_closed_over; + undef $ctx_closed_over; + ### return both values - return ( $res, $c ); + return ( $res, $ctx ); }; return { @@ -74,15 +84,21 @@ my $build_exports = sub { }, action_ok => sub { my $action = shift; - return Test::More->builder->ok($request->($action)->is_success, @_); + my $meth = $request->($action)->request->method; + my @args = @_ ? @_ : ("$meth $action returns successfully"); + return Test::More->builder->ok($request->($action)->is_success,@args); }, action_redirect => sub { my $action = shift; - return Test::More->builder->ok($request->($action)->is_redirect,@_); + my $meth = $request->($action)->request->method; + my @args = @_ ? @_ : ("$meth $action returns a redirect"); + return Test::More->builder->ok($request->($action)->is_redirect,@args); }, action_notfound => sub { my $action = shift; - return Test::More->builder->is_eq($request->($action)->code,404,@_); + my $meth = $request->($action)->request->method; + my @args = @_ ? @_ : ("$meth $action returns a 404"); + return Test::More->builder->is_eq($request->($action)->code,404,@args); }, contenttype_is => sub { my $action = shift; @@ -103,6 +119,12 @@ our $default_host; sub import { my ($self, $class, $opts) = @_; + Carp::carp( +qq{Importing Catalyst::Test without an application name is deprecated:\n +Instead of saying: use Catalyst::Test; +say: use Catalyst::Test (); # If you don't want to import a test app right now. +or say: use Catalyst::Test 'MyApp'; # If you do want to import a test app.\n\n}) + unless $class; $import->($self, '-all' => { class => $class }); $opts = {} unless ref $opts eq 'HASH'; $default_host = $opts->{default_host} if exists $opts->{default_host}; @@ -196,6 +218,9 @@ method and the L method below: is ( $uri->path , '/y'); my $content = get($uri->path); +Note also that the content is returned as raw bytes, without any attempt +to decode it into characters. + =head2 $res = request( ... ); Returns an L object. Accepts an optional hashref for request @@ -230,6 +255,21 @@ sub local_request { my $response = $cgi->restore->response; $response->request( $request ); + + # HTML head parsing based on LWP::UserAgent + + require HTML::HeadParser; + + my $parser = HTML::HeadParser->new(); + $parser->xml_mode(1) if $response->content_is_xhtml; + $parser->utf8_mode(1) if $] >= 5.008 && $HTML::Parser::VERSION >= 3.40; + + $parser->parse( $response->content ); + my $h = $parser->header; + for my $f ( $h->header_field_names ) { + $response->init_header( $f, [ $h->header($f) ] ); + } + return $response; } @@ -310,25 +350,29 @@ sub _customize_request { } } -=head2 action_ok +=head2 action_ok($url [, $test_name ]) -Fetches the given URL and checks that the request was successful. +Fetches the given URL and checks that the request was successful. An optional +second argument can be given to specify the name of the test. -=head2 action_redirect +=head2 action_redirect($url [, $test_name ]) -Fetches the given URL and checks that the request was a redirect. +Fetches the given URL and checks that the request was a redirect. An optional +second argument can be given to specify the name of the test. -=head2 action_notfound +=head2 action_notfound($url [, $test_name ]) -Fetches the given URL and checks that the request was not found. +Fetches the given URL and checks that the request was not found. An optional +second argument can be given to specify the name of the test. -=head2 content_like( $url, $regexp [, $test_name] ) +=head2 content_like( $url, $regexp [, $test_name ] ) -Fetches the given URL and returns whether the content matches the regexp. +Fetches the given URL and returns whether the content matches the regexp. An +optional third argument can be given to specify the name of the test. -=head2 contenttype_is +=head2 contenttype_is($url, $type [, $test_name ]) -Check for given MIME type. +Verify the given URL has a content type of $type and optionally specify a test name. =head1 SEE ALSO