File Coverage

blib/lib/Dancer2/Test.pm
Criterion Covered Total %
statement 229 283 80.9
branch 64 106 60.3
condition 7 31 22.5
subroutine 36 42 85.7
pod 15 15 100.0
total 351 477 73.5


line stmt bran cond sub pod time code
1             # ABSTRACT: Useful routines for testing Dancer2 apps
2             $Dancer2::Test::VERSION = '0.400000';
3             use strict;
4 2     2   1100 use warnings;
  2         18  
  2         59  
5 2     2   11  
  2         3  
  2         66  
6             use Carp qw<carp croak>;
7 2     2   10 use Test::More;
  2         4  
  2         121  
8 2     2   14 use Test::Builder;
  2         3  
  2         30  
9 2     2   561 use URI::Escape;
  2         3  
  2         43  
10 2     2   7 use Data::Dumper;
  2         4  
  2         96  
11 2     2   10 use File::Temp;
  2         3  
  2         83  
12 2     2   10 use Ref::Util qw<is_arrayref>;
  2         4  
  2         135  
13 2     2   12  
  2         5  
  2         83  
14             use parent 'Exporter';
15 2     2   11 our @EXPORT = qw(
  2         4  
  2         15  
16             dancer_response
17              
18             response_content_is
19             response_content_isnt
20             response_content_is_deeply
21             response_content_like
22             response_content_unlike
23              
24             response_status_is
25             response_status_isnt
26              
27             response_headers_include
28             response_headers_are_deeply
29              
30             response_is_file
31              
32             route_exists
33             route_doesnt_exist
34              
35             is_pod_covered
36             route_pod_coverage
37              
38             );
39              
40             #dancer1 also has read_logs, response_redirect_location_is
41             #cf. https://github.com/PerlDancer2/Dancer22/issues/25
42              
43             use Dancer2::Core::Dispatcher;
44 2     2   182 use Dancer2::Core::Request;
  2         3  
  2         59  
45 2     2   11  
  2         3  
  2         296  
46             # singleton to store all the apps
47             my $_dispatcher = Dancer2::Core::Dispatcher->new;
48              
49             # prevent deprecation warnings
50             our $NO_WARN = 0;
51              
52             # can be called with the ($method, $path, $option) triplet,
53             # or can be fed a request object directly, or can be fed
54             # a single string, assumed to be [ GET => $string ]
55             # or can be fed a response (which is passed through without
56             # any modification)
57             carp 'DEPRECATED: Dancer2::Test. Please use Plack::Test instead'
58             unless $NO_WARN;
59 39 50   39 1 4375  
60             _find_dancer_apps_for_dispatcher();
61              
62 39         78 # useful for the high-level tests
63             return $_[0] if ref $_[0] eq 'Dancer2::Core::Response';
64              
65 39 100       274 my ( $request, $env ) =
66             ref $_[0] eq 'Dancer2::Core::Request'
67 31 100       85 ? _build_env_from_request(@_)
68             : _build_request_from_env(@_);
69              
70             # override the set_request so it actually sets our request instead
71             {
72             ## no critic qw(TestingAndDebugging::ProhibitNoWarnings)
73             no warnings qw<redefine once>;
74             *Dancer2::Core::App::set_request = sub {
75 2     2   13 my $self = shift;
  2         3  
  2         6414  
  31         46  
76             $self->_set_request( $request );
77 31     31   39 $_->set_request( $request ) for @{ $self->defined_engines };
78 31         427 };
79 31         679 }
  31         60  
80 31         357  
81             # since the response is a PSGI response
82             # we create a Response object which was originally expected
83             my $psgi_response = $_dispatcher->dispatch($env);
84             return Dancer2::Core::Response->new(
85 31         921 status => $psgi_response->[0],
86 31         566 headers => $psgi_response->[1],
87             content => $psgi_response->[2][0],
88             );
89             }
90              
91              
92              
93              
94             # arguments can be passed as the triplet
95             # or as a arrayref, or as a simple string
96             my ( $method, $path, $options ) =
97             @_ > 1 ? @_
98             : is_arrayref($_[0]) ? @{ $_[0] }
99             : ( GET => $_[0], {} );
100              
101 28 100   28   89 my $env = {
  10 100       24  
102             %ENV,
103             REQUEST_METHOD => uc($method),
104 28         220 PATH_INFO => $path,
105             QUERY_STRING => '',
106             'psgi.url_scheme' => 'http',
107             SERVER_PROTOCOL => 'HTTP/1.0',
108             SERVER_NAME => 'localhost',
109             SERVER_PORT => 3000,
110             HTTP_HOST => 'localhost',
111             HTTP_USER_AGENT => "Dancer2::Test simulator v " . Dancer2->VERSION,
112             };
113              
114             if ( defined $options->{params} ) {
115             my @params;
116             while ( my ( $p, $value ) = each %{ $options->{params} } ) {
117 28 100       115 if ( is_arrayref($value) ) {
118 3         6 for my $v (@$value) {
119 3         5 push @params,
  6         158  
120 3 100       8 uri_escape_utf8($p) . '=' . uri_escape_utf8($v);
121 2         4 }
122 4         71 }
123             else {
124             push @params,
125             uri_escape_utf8($p) . '=' . uri_escape_utf8($value);
126             }
127 1         6 }
128             $env->{QUERY_STRING} = join( '&', @params );
129             }
130              
131 3         10 my $request = Dancer2::Core::Request->new( env => $env );
132              
133             # body
134 28         93 $request->body( $options->{body} ) if exists $options->{body};
135              
136             # headers
137 28 50       65 if ( $options->{headers} ) {
138             for my $header ( @{ $options->{headers} } ) {
139             my ( $name, $value ) = @{$header};
140 28 100       54 $request->header( $name => $value );
141 2         10 if ( $name =~ /^cookie$/i ) {
  2         6  
142 4         6 $env->{HTTP_COOKIE} = $value;
  4         8  
143 4         12 }
144 4 100       402 }
145 2         5 }
146              
147             # files
148             if ( $options->{files} ) {
149             for my $file ( @{ $options->{files} } ) {
150             my $headers = $file->{headers};
151 28 100       54 $headers->{'Content-Type'} ||= 'text/plain';
152 2         4  
  2         5  
153 2         3 my $temp = File::Temp->new();
154 2   50     9 if ( $file->{data} ) {
155             print $temp $file->{data};
156 2         12 close($temp);
157 2 100       898 }
158 1         23 else {
159 1         50 require File::Copy;
160             File::Copy::copy( $file->{filename}, $temp );
161             }
162 1         419  
163 1         2046 my $upload = Dancer2::Core::Request::Upload->new(
164             filename => $file->{filename},
165             size => -s $temp->filename,
166             tempname => $temp->filename,
167             headers => $headers,
168 2         321 );
169              
170             ## keep temp_fh in scope so it doesn't get deleted too early
171             ## But will get deleted by the time the test is finished.
172             $upload->{temp_fh} = $temp;
173              
174             $request->uploads->{ $file->{name} } = $upload;
175 2         2804 }
176             }
177 2         8  
178             # content-type
179             if ( $options->{content_type} ) {
180             $request->content_type( $options->{content_type} );
181             }
182 28 50       52  
183 0         0 return ( $request, $env );
184             }
185              
186 28         58 my ($request) = @_;
187              
188             my $env = {
189             REQUEST_METHOD => $request->method,
190 10     10   19 PATH_INFO => $request->path,
191             QUERY_STRING => '',
192 10         27 'psgi.url_scheme' => 'http',
193             SERVER_PROTOCOL => 'HTTP/1.0',
194             SERVER_NAME => 'localhost',
195             SERVER_PORT => 3000,
196             HTTP_HOST => 'localhost',
197             HTTP_USER_AGENT => "Dancer2::Test simulator v" . Dancer2->VERSION,
198             };
199              
200             # TODO
201             if ( my $params = $request->{_query_params} ) {
202             my @params;
203             while ( my ( $p, $value ) = each %{$params} ) {
204             if ( is_arrayref($value) ) {
205 10 50       32 for my $v (@$value) {
206 0         0 push @params,
207 0         0 uri_escape_utf8($p) . '=' . uri_escape_utf8($v);
  0         0  
208 0 0       0 }
209 0         0 }
210 0         0 else {
211             push @params,
212             uri_escape_utf8($p) . '=' . uri_escape_utf8($value);
213             }
214             }
215 0         0 $env->{QUERY_STRING} = join( '&', @params );
216             }
217              
218             # TODO files
219 0         0  
220             return ( $request, $env );
221             }
222              
223             my ( $req, $status, $test_name ) = @_;
224 10         23 carp 'DEPRECATED: Dancer2::Test. Please use Plack::Test instead'
225             unless $NO_WARN;
226              
227             $test_name ||= "response status is $status for " . _req_label($req);
228 4     4 1 1913  
229 4 50       20 my $response = dancer_response($req);
230              
231             my $tb = Test::Builder->new;
232 4   33     19 local $Test::Builder::Level = $Test::Builder::Level + 1;
233             $tb->is_eq( $response->[0], $status, $test_name );
234 4         14 }
235              
236 4         93 my ( $request, $env ) =
237 4         22 ref $_[0] eq 'Dancer2::Core::Request'
238 4         13 ? _build_env_from_request(@_)
239             : _build_request_from_env(@_);
240              
241             for my $app (@{$_dispatcher->apps}) {
242 7 100   7   26 for my $route (@{$app->routes->{lc($request->method)}}) {
243             if ( $route->match($request) ) {
244             return 1;
245             }
246             }
247 7         9 }
  7         135  
248 7         44 return 0;
  7         93  
249 3 50       32 }
250 3         86  
251             carp 'DEPRECATED: Dancer2::Test. Please use Plack::Test instead'
252             unless $NO_WARN;
253              
254 4         69 my $tb = Test::Builder->new;
255             local $Test::Builder::Level = $Test::Builder::Level + 1;
256             $tb->ok( _find_route_match($_[0]), $_[1]);
257             }
258 3 50   3 1 556  
259             carp 'DEPRECATED: Dancer2::Test. Please use Plack::Test instead'
260             unless $NO_WARN;
261 3         9  
262 3         17 my $tb = Test::Builder->new;
263 3         6 local $Test::Builder::Level = $Test::Builder::Level + 1;
264             $tb->ok( !_find_route_match($_[0]), $_[1]);
265             }
266              
267 4 50   4 1 920 my ( $req, $status, $test_name ) = @_;
268              
269             carp 'DEPRECATED: Dancer2::Test. Please use Plack::Test instead'
270 4         14 unless $NO_WARN;
271 4         26  
272 4         8 $test_name ||= "response status is not $status for " . _req_label($req);
273              
274             my $response = dancer_response($req);
275              
276 4     4 1 1911 my $tb = Test::Builder->new;
277             local $Test::Builder::Level = $Test::Builder::Level + 1;
278 4 50       10 $tb->isnt_eq( $response->[0], $status, $test_name );
279             }
280              
281 4   33     15 {
282             # Map comparison operator names to human-friendly ones
283 4         16 my %cmp_name = (
284             is_eq => "is",
285 4         97 isnt_eq => "is not",
286 4         21 like => "matches",
287 4         13 unlike => "doesn't match",
288             );
289              
290             my ( $req, $want, $test_name, $cmp ) = @_;
291              
292             if ( @_ == 3 ) {
293             $cmp = $test_name;
294             $test_name = $cmp_name{$cmp};
295             $test_name =
296             "response content $test_name $want for " . _req_label($req);
297             }
298              
299             my $response = dancer_response($req);
300 16     16   32  
301             my $tb = Test::Builder->new;
302 16 100       32 local $Test::Builder::Level = $Test::Builder::Level + 1;
303 8         9 $tb->$cmp( $response->[2][0], $want, $test_name );
304 8         15 }
305 8         22 }
306              
307             carp 'DEPRECATED: Dancer2::Test. Please use Plack::Test instead'
308             unless $NO_WARN;
309 16         52 local $Test::Builder::Level = $Test::Builder::Level + 1;
310             _cmp_response_content( @_, 'is_eq' );
311 16         368 }
312 16         83  
313 16         47 carp 'DEPRECATED: Dancer2::Test. Please use Plack::Test instead'
314             unless $NO_WARN;
315             local $Test::Builder::Level = $Test::Builder::Level + 1;
316             _cmp_response_content( @_, 'isnt_eq' );
317             }
318 4 50   4 1 1406  
319             carp 'DEPRECATED: Dancer2::Test. Please use Plack::Test instead'
320 4         8 unless $NO_WARN;
321 4         8 local $Test::Builder::Level = $Test::Builder::Level + 1;
322             _cmp_response_content( @_, 'like' );
323             }
324              
325 4 50   4 1 1415 carp 'DEPRECATED: Dancer2::Test. Please use Plack::Test instead'
326             unless $NO_WARN;
327 4         5 local $Test::Builder::Level = $Test::Builder::Level + 1;
328 4         9 _cmp_response_content( @_, 'unlike' );
329             }
330              
331             my ( $req, $matcher, $test_name ) = @_;
332 4 50   4 1 2010 carp 'DEPRECATED: Dancer2::Test. Please use Plack::Test instead'
333             unless $NO_WARN;
334 4         8 $test_name ||= "response content looks good for " . _req_label($req);
335 4         6  
336             local $Test::Builder::Level = $Test::Builder::Level + 1;
337             my $response = _req_to_response($req);
338             is_deeply $response->[2][0], $matcher, $test_name;
339 4 50   4 1 1995 }
340              
341 4         8 my ( $req, $test_name ) = @_;
342 4         6 carp 'DEPRECATED: Dancer2::Test. Please use Plack::Test instead'
343             unless $NO_WARN;
344             $test_name ||= "a file is returned for " . _req_label($req);
345              
346 0     0 1 0 my $response = _get_file_response($req);
347 0 0       0 my $tb = Test::Builder->new;
348             local $Test::Builder::Level = $Test::Builder::Level + 1;
349 0   0     0 return $tb->ok( defined($response), $test_name );
350             }
351 0         0  
352 0         0 my ( $req, $expected, $test_name ) = @_;
353 0         0 carp 'DEPRECATED: Dancer2::Test. Please use Plack::Test instead'
354             unless $NO_WARN;
355             $test_name ||= "headers are as expected for " . _req_label($req);
356              
357 0     0 1 0 local $Test::Builder::Level = $Test::Builder::Level + 1;
358 0 0       0 my $response = dancer_response( _expand_req($req) );
359              
360 0   0     0 is_deeply(
361             _sort_headers( $response->[1] ),
362 0         0 _sort_headers($expected), $test_name
363 0         0 );
364 0         0 }
365 0         0  
366             my ( $req, $expected, $test_name ) = @_;
367             carp 'DEPRECATED: Dancer2::Test. Please use Plack::Test instead'
368             unless $NO_WARN;
369 0     0 1 0 $test_name ||= "headers include expected data for " . _req_label($req);
370 0 0       0 my $tb = Test::Builder->new;
371              
372 0   0     0 my $response = dancer_response($req);
373             local $Test::Builder::Level = $Test::Builder::Level + 1;
374 0         0  
375 0         0 print STDERR "Headers are: "
376             . Dumper( $response->[1] )
377 0         0 . "\n Expected to find header: "
378             . Dumper($expected)
379             if !$tb->ok(
380             _include_in_headers( $response->[1], $expected ),
381             $test_name
382             );
383             }
384 4     4 1 9  
385 4 50       10  
386             require Pod::Simple::Search;
387 4   33     14 require Pod::Simple::SimpleTree;
388 4         17  
389             my $all_routes = {};
390 4         22  
391 4         88 foreach my $app ( @{ $_dispatcher->apps } ) {
392             my $routes = $app->routes;
393 4 50       12 my $available_routes = [];
394             foreach my $method ( sort { $b cmp $a } keys %$routes ) {
395             foreach my $r ( @{ $routes->{$method} } ) {
396              
397             # we don't need pod coverage for head
398             next if $method eq 'head';
399             push @$available_routes, $method . ' ' . $r->spec_route;
400             }
401             }
402             ## copy dereferenced array
403             $all_routes->{ $app->name }{routes} = [@$available_routes]
404             if @$available_routes;
405 2     2 1 2164  
406 2         5901 # Pod::Simple v3.30 excluded the current directory even when in @INC.
407             # include the current directory as a search path; its backwards compatible
408 2         25512 # with previous version.
409             my $undocumented_routes = [];
410 2         3 my $file = Pod::Simple::Search->new->find( $app->name, '.' );
  2         50  
411 2         52 if ($file) {
412 2         19 $all_routes->{ $app->name }{has_pod} = 1;
413 2         12 my $parser = Pod::Simple::SimpleTree->new->parse_file($file);
  22         27  
414 12         14 my $pod_dataref = $parser->root;
  12         21  
415             my $found_routes = {};
416             for ( my $i = 0; $i < @$available_routes; $i++ ) {
417 16 100       28  
418 10         33 my $r = $available_routes->[$i];
419             my $app_string = lc $r;
420             $app_string =~ s/\*/_REPLACED_STAR_/g;
421              
422 2 50       14 for ( my $idx = 0; $idx < @$pod_dataref; $idx++ ) {
423             my $pod_part = $pod_dataref->[$idx];
424              
425             next if !is_arrayref($pod_part);
426             foreach my $ref_part (@$pod_part) {
427             is_arrayref($ref_part)
428 2         4 and push @$pod_dataref, $ref_part;
429 2         12 }
430 2 50       700  
431 2         10 my $pod_string = lc $pod_part->[2];
432 2         13 $pod_string =~ s/['|"|\s]+/ /g;
433 2         8518 $pod_string =~ s/\s$//g;
434 2         12 $pod_string =~ s/\*/_REPLACED_STAR_/g;
435 2         9 if ( $pod_string =~ m/^$app_string$/ ) {
436             $found_routes->{$app_string} = 1;
437 10         18 next;
438 10         14 }
439 10         17 }
440             if ( !$found_routes->{$app_string} ) {
441 10         16 push @$undocumented_routes, $r;
442 380         449 }
443             }
444 380 100       483 }
445 360         414 else { ### no POD found
446 1140 100       1968 $all_routes->{ $app->name }{has_pod} = 0;
447             }
448             if (@$undocumented_routes) {
449             $all_routes->{ $app->name }{undocumented_routes} =
450 360         456 $undocumented_routes;
451 360         929 }
452 360         533 elsif ( !$all_routes->{ $app->name }{has_pod}
453 360         432 && @{ $all_routes->{ $app->name }{routes} } )
454 360 100       1053 {
455 34         65 ## copy dereferenced array
456 34         58 $all_routes->{ $app->name }{undocumented_routes} =
457             [ @{ $all_routes->{ $app->name }{routes} } ];
458             }
459 10 50       53 }
460 0         0  
461             return $all_routes;
462             }
463              
464             my ($test_name) = @_;
465 0         0  
466             $test_name ||= "is pod covered";
467 2 50 33     19 my $route_pod_coverage = route_pod_coverage();
    50          
468              
469 0         0 my $tb = Test::Builder->new;
470             local $Test::Builder::Level = $Test::Builder::Level + 1;
471              
472 0         0 foreach my $app ( @{ $_dispatcher->apps } ) {
473             my %undocumented_route =
474             ( map { $_ => 1 }
475             @{ $route_pod_coverage->{ $app->name }{undocumented_routes} } );
476 0         0 $tb->subtest(
  0         0  
477             $app->name . $test_name,
478             sub {
479             foreach my $route (
480 2         8 @{ $route_pod_coverage->{ $app->name }{routes} } )
481             {
482             ok( !$undocumented_route{$route}, "$route is documented" );
483             }
484 1     1 1 107 }
485             );
486 1   50     13 }
487 1         4 }
488              
489 1         10 my ( $class, %options ) = @_;
490 1         13  
491             my @applications;
492 1         2 if ( ref $options{apps} eq ref( [] ) ) {
  1         76  
493             @applications = @{ $options{apps} };
494 0         0 }
495 1         19 else {
  1         6  
496             my ( $caller, $script ) = caller;
497              
498             # if no app is passed, assume the caller is one.
499 1     1   1174 @applications = ($caller) if $caller->can('dancer_app');
500 1         7 }
501              
502 5         1249 # register the apps to the test dispatcher
503             $_dispatcher->apps( [ map {
504             $_->dancer_app->finish();
505 1         13 $_->dancer_app;
506             } @applications ] );
507              
508             $class->export_to_level( 1, $class, @EXPORT );
509             }
510 2     2   24  
511             # private
512 2         4  
513 2 100       14 my $req = shift;
514 1         3  
  1         5  
515             return
516             ref $req eq 'Dancer2::Core::Response' ? 'response object'
517 1         3 : ref $req eq 'Dancer2::Core::Request'
518             ? join( ' ', map { $req->$_ } qw/ method path / )
519             : is_arrayref($req) ? join( ' ', @$req )
520 1 50       9 : "GET $req";
521             }
522              
523             my $req = shift;
524             return is_arrayref($req) ? @$req : ( 'GET', $req );
525 2         7 }
  2         16  
526 2         8  
527             # Sort arrayref of headers (turn it into a list of arrayrefs, sort by the header
528             # & value, then turn it back into an arrayref)
529 2         184252 my @originalheaders = @{ shift() }; # take a copy we can modify
530             my @headerpairs;
531             while ( my ( $header, $value ) = splice @originalheaders, 0, 2 ) {
532             push @headerpairs, [ $header, $value ];
533             }
534              
535 20     20   31 # We have an array of arrayrefs holding header => value pairs; sort them by
536             # header then value, and return them flattened back into an arrayref
537             return [
538             map {@$_}
539             sort { $a->[0] cmp $b->[0] || $a->[1] cmp $b->[1] } @headerpairs
540 20 100       93 ];
  10 100       50  
    100          
541             }
542              
543             # make sure the given header sublist is included in the full headers array
544             my ( $full_headers, $expected_subset ) = @_;
545              
546 0     0   0 # walk through all the expected header pairs, make sure
547 0 0       0 # they exist with the same value in the full_headers list
548             # return false as soon as one is not.
549             for ( my $i = 0; $i < scalar(@$expected_subset); $i += 2 ) {
550             my ( $name, $value ) =
551             ( $expected_subset->[$i], $expected_subset->[ $i + 1 ] );
552             return 0
553 0     0   0 unless _check_header( $full_headers, $name, $value );
  0         0  
554 0         0 }
555 0         0  
556 0         0 # we've found all the expected pairs in the $full_headers list
557             return 1;
558             }
559              
560             my ( $headers, $key, $value ) = @_;
561             for ( my $i = 0; $i < scalar(@$headers); $i += 2 ) {
562 0         0 my ( $name, $val ) = ( $headers->[$i], $headers->[ $i + 1 ] );
563 0 0       0 return 1 if $name eq $key && $value eq $val;
  0         0  
564             }
565             return 0;
566             }
567              
568             my $req = shift;
569 4     4   9  
570             # already a response object
571             return $req if ref $req eq 'Dancer2::Core::Response';
572              
573             return dancer_response( is_arrayref($req) ? @$req : ( 'GET', $req ) );
574 4         12 }
575 4         10  
576             # make sure we have at least one app in the dispatcher, and if not,
577 4 50       7 # we must have at this point an app within the caller
578             return if scalar( @{ $_dispatcher->apps } );
579              
580             for ( my $deep = 0; $deep < 5; $deep++ ) {
581             my $caller = caller($deep);
582 4         13 next if !$caller || !$caller->can('dancer_app');
583              
584             return $_dispatcher->apps( [ $caller->dancer_app ] );
585             }
586 4     4   8  
587 4         6 croak "Unable to find a Dancer2 app, did you use Dancer2 in your test?";
588 4         9 }
589 4 50 33     22  
590             1;
591 0         0  
592              
593             =pod
594              
595 0     0   0 =encoding UTF-8
596              
597             =head1 NAME
598 0 0       0  
599             Dancer2::Test - Useful routines for testing Dancer2 apps
600 0 0       0  
601             =head1 VERSION
602              
603             version 0.400000
604              
605             =head1 SYNOPSIS
606 39 50   39   44  
  39         738  
607             use Test::More;
608 0           use Plack::Test;
609 0           use HTTP::Request::Common; # install separately
610 0 0 0        
611             use YourDancerApp;
612 0            
613             my $app = YourDancerApp->to_app;
614             my $test = Plack::Test->create($app);
615 0            
616             my $res = $test->request( GET '/' );
617             is( $res->code, 200, '[GET /] Request successful' );
618             like( $res->content, qr/hello, world/, '[GET /] Correct content' );
619              
620             done_testing;
621              
622             =head1 DESCRIPTION
623              
624             B<DEPRECATED. This module and all the functions listed below are deprecated. Do
625             not use this module.> The routines provided by this module for testing Dancer2
626             apps are buggy and unnecessary. Instead, use the L<Plack::Test> module as shown
627             in the SYNOPSIS above and ignore the functions in this documentation. Consult
628             the L<Plack::Test> documentation for further details.
629              
630             This module will be removed from the Dancer2 distribution in the near future.
631             You should migrate all tests that use it over to the L<Plack::Test> module and
632             remove this module from your system. This module will throw warnings to remind
633             you.
634              
635             For now, you can silence the warnings by setting the C<NO_WARN> option:
636              
637             $Dancer::Test::NO_WARN = 1;
638              
639             In the functions below, $test_name is always optional.
640              
641             =head1 FUNCTIONS
642              
643             =head2 dancer_response ($method, $path, $params, $arg_env);
644              
645             Returns a Dancer2::Core::Response object for the given request.
646              
647             Only $method and $path are required.
648              
649             $params is a hashref with 'body' as a string; 'headers' can be an arrayref or
650             a HTTP::Headers object, 'files' can be arrayref of hashref, containing some
651             files to upload:
652              
653             dancer_response($method, $path,
654             {
655             params => $params,
656             body => $body,
657             headers => $headers,
658             files => [ { filename => '/path/to/file', name => 'my_file' } ],
659             }
660             );
661              
662             A good reason to use this function is for testing POST requests. Since POST
663             requests may not be idempotent, it is necessary to capture the content and
664             status in one shot. Calling the response_status_is and response_content_is
665             functions in succession would make two requests, each of which could alter the
666             state of the application and cause Schrodinger's cat to die.
667              
668             my $response = dancer_response POST => '/widgets';
669             is $response->status, 202, "response for POST /widgets is 202";
670             is $response->content, "Widget #1 has been scheduled for creation",
671             "response content looks good for first POST /widgets";
672              
673             $response = dancer_response POST => '/widgets';
674             is $response->status, 202, "response for POST /widgets is 202";
675             is $response->content, "Widget #2 has been scheduled for creation",
676             "response content looks good for second POST /widgets";
677              
678             It's possible to test file uploads:
679              
680             post '/upload' => sub { return upload('image')->content };
681              
682             $response = dancer_response(POST => '/upload', {files => [{name => 'image', filename => '/path/to/image.jpg'}]});
683              
684             In addition, you can supply the file contents as the C<data> key:
685              
686             my $data = 'A test string that will pretend to be file contents.';
687             $response = dancer_response(POST => '/upload', {
688             files => [{name => 'test', filename => "filename.ext", data => $data}]
689             });
690              
691             You can also supply a hashref of headers:
692              
693             headers => { 'Content-Type' => 'text/plain' }
694              
695             =head2 response_status_is ($request, $expected, $test_name);
696              
697             Asserts that Dancer2's response for the given request has a status equal to the
698             one given.
699              
700             response_status_is [GET => '/'], 200, "response for GET / is 200";
701              
702             =head2 route_exists([$method, $path], $test_name)
703              
704             Asserts that the given request matches a route handler in Dancer2's
705             registry. If the route would have returned a 404, the route still exists
706             and this test will pass.
707              
708             Note that because Dancer2 uses the default route handler
709             L<Dancer2::Handler::File> to match files in the public folder when
710             no other route matches, this test will always pass.
711             You can disable the default route handlers in the configs but you probably
712             want L<Dancer2::Test/response_status_is> or L<Dancer2::Test/dancer_response>
713              
714             route_exists [GET => '/'], "GET / is handled";
715              
716             =head2 route_doesnt_exist([$method, $path], $test_name)
717              
718             Asserts that the given request does not match any route handler
719             in Dancer2's registry.
720              
721             Note that this test is likely to always fail as any route not matched will
722             be handled by the default route handler in L<Dancer2::Handler::File>.
723             This can be disabled in the configs.
724              
725             route_doesnt_exist [GET => '/bogus_path'], "GET /bogus_path is not handled";
726              
727             =head2 response_status_isnt([$method, $path], $status, $test_name)
728              
729             Asserts that the status of Dancer2's response is not equal to the
730             one given.
731              
732             response_status_isnt [GET => '/'], 404, "response for GET / is not a 404";
733              
734             =head2 response_content_is([$method, $path], $expected, $test_name)
735              
736             Asserts that the response content is equal to the C<$expected> string.
737              
738             response_content_is [GET => '/'], "Hello, World",
739             "got expected response content for GET /";
740              
741             =head2 response_content_isnt([$method, $path], $not_expected, $test_name)
742              
743             Asserts that the response content is not equal to the C<$not_expected> string.
744              
745             response_content_isnt [GET => '/'], "Hello, World",
746             "got expected response content for GET /";
747              
748             =head2 response_content_like([$method, $path], $regexp, $test_name)
749              
750             Asserts that the response content for the given request matches the regexp
751             given.
752              
753             response_content_like [GET => '/'], qr/Hello, World/,
754             "response content looks good for GET /";
755              
756             =head2 response_content_unlike([$method, $path], $regexp, $test_name)
757              
758             Asserts that the response content for the given request does not match the regexp
759             given.
760              
761             response_content_unlike [GET => '/'], qr/Page not found/,
762             "response content looks good for GET /";
763              
764             =head2 response_content_is_deeply([$method, $path], $expected_struct, $test_name)
765              
766             Similar to response_content_is(), except that if response content and
767             $expected_struct are references, it does a deep comparison walking each data
768             structure to see if they are equivalent.
769              
770             If the two structures are different, it will display the place where they start
771             differing.
772              
773             response_content_is_deeply [GET => '/complex_struct'],
774             { foo => 42, bar => 24},
775             "got expected response structure for GET /complex_struct";
776              
777             =head2 response_is_file ($request, $test_name);
778              
779             =head2 response_headers_are_deeply([$method, $path], $expected, $test_name)
780              
781             Asserts that the response headers data structure equals the one given.
782              
783             response_headers_are_deeply [GET => '/'], [ 'X-Powered-By' => 'Dancer2 1.150' ];
784              
785             =head2 response_headers_include([$method, $path], $expected, $test_name)
786              
787             Asserts that the response headers data structure includes some of the defined ones.
788              
789             response_headers_include [GET => '/'], [ 'Content-Type' => 'text/plain' ];
790              
791             =head2 route_pod_coverage()
792              
793             Returns a structure describing pod coverage in your apps
794              
795             for one app like this:
796              
797             package t::lib::TestPod;
798             use Dancer2;
799              
800             =head1 NAME
801              
802             TestPod
803              
804             =head2 ROUTES
805              
806             =over
807              
808             =cut
809              
810             =item get "/in_testpod"
811              
812             testpod
813              
814             =cut
815              
816             get '/in_testpod' => sub {
817             return 'get in_testpod';
818             };
819              
820             get '/hello' => sub {
821             return "hello world";
822             };
823              
824             =item post '/in_testpod/*'
825              
826             post in_testpod
827              
828             =cut
829              
830             post '/in_testpod/*' => sub {
831             return 'post in_testpod';
832             };
833              
834             =back
835              
836             =head2 SPECIALS
837              
838             =head3 PUBLIC
839              
840             =over
841              
842             =item get "/me:id"
843              
844             =cut
845              
846             get "/me:id" => sub {
847             return "ME";
848             };
849              
850             =back
851              
852             =head3 PRIVAT
853              
854             =over
855              
856             =item post "/me:id"
857              
858             post /me:id
859              
860             =cut
861              
862             post "/me:id" => sub {
863             return "ME";
864             };
865              
866             =back
867              
868             =cut
869              
870             1;
871              
872             route_pod_coverage;
873              
874             would return something like:
875              
876             {
877             't::lib::TestPod' => {
878             'has_pod' => 1,
879             'routes' => [
880             "post /in_testpod/*",
881             "post /me:id",
882             "get /in_testpod",
883             "get /hello",
884             "get /me:id"
885             ],
886             'undocumented_routes' => [
887             "get /hello"
888             ]
889             }
890             }
891              
892             =head2 is_pod_covered('is pod covered')
893              
894             Asserts that your apps have pods for all routes
895              
896             is_pod_covered 'is pod covered'
897              
898             to avoid test failures, you should document all your routes with one of the following:
899             head1, head2,head3,head4, item.
900              
901             ex:
902              
903             =item get '/login'
904              
905             route to login
906              
907             =cut
908              
909             if you use:
910              
911             any '/myaction' => sub {
912             # code
913             }
914              
915             or
916              
917             any ['get', 'post'] => '/myaction' => sub {
918             # code
919             };
920              
921             you need to create pods for each one of the routes created there.
922              
923             =head2 import
924              
925             When Dancer2::Test is imported, it should be passed all the
926             applications that are supposed to be tested.
927              
928             If none passed, then the caller is supposed to be the sole application
929             to test.
930              
931             # t/sometest.t
932              
933             use t::lib::Foo;
934             use t::lib::Bar;
935              
936             use Dancer2::Test apps => ['t::lib::Foo', 't::lib::Bar'];
937              
938             =head1 AUTHOR
939              
940             Dancer Core Developers
941              
942             =head1 COPYRIGHT AND LICENSE
943              
944             This software is copyright (c) 2022 by Alexis Sukrieh.
945              
946             This is free software; you can redistribute it and/or modify it under
947             the same terms as the Perl 5 programming language system itself.
948              
949             =cut