File Coverage

blib/lib/Test/Path/Router.pm
Criterion Covered Total %
statement 71 74 95.9
branch 19 20 95.0
condition 13 21 61.9
subroutine 14 14 100.0
pod 7 7 100.0
total 124 136 91.1


line stmt bran cond sub pod time code
1             package Test::Path::Router;
2             our $AUTHORITY = 'cpan:STEVAN';
3             # ABSTRACT: A testing module for testing routes
4             $Test::Path::Router::VERSION = '0.15';
5 11     11   152537 use strict;
  11         16  
  11         258  
6 11     11   34 use warnings;
  11         11  
  11         261  
7              
8 11     11   33 use Test::Builder 1.001013 ();
  11         155  
  11         188  
9 11     11   5379 use Test::Deep 0.113 ();
  11         91155  
  11         307  
10 11     11   5775 use Data::Dumper 2.154 ();
  11         54900  
  11         308  
11 11     11   5080 use Sub::Exporter 0.981;
  11         75017  
  11         40  
12              
13             my @exports = qw/
14             routes_ok
15             path_ok
16             path_not_ok
17             path_is
18             mapping_ok
19             mapping_not_ok
20             mapping_is
21             /;
22              
23             Sub::Exporter::setup_exporter({
24             exports => \@exports,
25             groups => { default => \@exports }
26             });
27              
28             our $Test = Test::Builder->new;
29              
30             sub routes_ok {
31 8     8 1 3142 my ($router, $routes, $message) = @_;
32 8         15 my ($passed, $reason);
33 8         26 foreach my $path (keys %$routes) {
34 52         51694 my $mapping = $routes->{$path};
35              
36 52         45 my $generated_path = $router->uri_for(%{$mapping});
  52         176  
37              
38 52 100       93 $generated_path = '' unless defined $generated_path;
39              
40             # the path generated from the hash
41             # is the same as the path supplied
42 52 100       82 if ($path ne $generated_path) {
43 1         4 $Test->ok(0, $message);
44 1         306 $Test->diag("... paths do not match\n" .
45             " got: '" . $generated_path . "'\n" .
46             " expected: '" . $path . "'");
47 1         43 return;
48             }
49              
50 51         106 my $match = $router->match($path);
51 51   33     197 my $generated_mapping = $match && $match->mapping;
52              
53 51         265 $Test->ok( $match->path eq $path, "matched path (" . $match->path . ") and requested paths ($path) match" );
54              
55             # the path supplied produces the
56             # same match as the hash supplied
57              
58 51 50       12195 unless (Test::Deep::eq_deeply($generated_mapping, $mapping)) {
59 0         0 $Test->ok(0, $message);
60 0         0 $Test->diag("... mappings do not match for '$path'\n" .
61             " got: " . _dump_mapping_info($generated_mapping) . "\n" .
62             " expected: " . _dump_mapping_info($mapping));
63 0         0 return;
64             }
65             }
66 7         3901 $Test->ok(1, $message);
67             }
68              
69             sub path_ok {
70 35     35 1 8749 my ($router, $path, $message) = @_;
71 35 100       88 if ($router->match($path)) {
72 34         88 $Test->ok(1, $message);
73             }
74             else {
75 1         3 $Test->ok(0, $message);
76             }
77             }
78              
79             sub path_not_ok {
80 25     25 1 6428 my ($router, $path, $message) = @_;
81 25 100       61 unless ($router->match($path)) {
82 24         57 $Test->ok(1, $message);
83             }
84             else {
85 1         3 $Test->ok(0, $message);
86             }
87             }
88              
89             sub path_is {
90 6     6 1 2160 my ($router, $path, $expected, $message) = @_;
91              
92 6         16 my $generated_mapping = $router->match($path)->mapping;
93              
94             # the path supplied produces the
95             # same match as the hash supplied
96              
97 6 100       25 unless (Test::Deep::eq_deeply($generated_mapping, $expected)) {
98 1         622 $Test->ok(0, $message);
99 1         315 $Test->diag("... mappings do not match for '$path'\n" .
100             " got: '" . _dump_mapping_info($generated_mapping) . "'\n" .
101             " expected: '" . _dump_mapping_info($expected) . "'");
102             }
103             else {
104 5         16120 $Test->ok(1, $message);
105             }
106             }
107              
108             sub mapping_ok {
109 2     2 1 989 my ($router, $mapping, $message) = @_;
110 2 100       3 if (defined $router->uri_for(%{$mapping})) {
  2         8  
111 1         4 $Test->ok(1, $message);
112             }
113             else {
114 1         3 $Test->ok(0, $message);
115             }
116             }
117              
118             sub mapping_not_ok {
119 2     2 1 743 my ($router, $mapping, $message) = @_;
120 2 100       3 unless (defined $router->uri_for(%{$mapping})) {
  2         8  
121 1         4 $Test->ok(1, $message);
122             }
123             else {
124 1         3 $Test->ok(0, $message);
125             }
126             }
127              
128             sub mapping_is {
129 9     9 1 2693 my ($router, $mapping, $expected, $message) = @_;
130              
131 9         10 my $generated_path = $router->uri_for(%{$mapping});
  9         37  
132              
133             # the path generated from the hash
134             # is the same as the path supplied
135 9 100 66     96 if (
      100        
      33        
      66        
      66        
      66        
136             (defined $generated_path and not defined $expected) or
137             (defined $expected and not defined $generated_path) or
138             (defined $generated_path and defined $expected
139             and $generated_path ne $expected)
140             ) {
141             $_ = defined $_ ? qq{'$_'} : qq{undef}
142 1 100       4 for $generated_path, $expected;
143 1         4 $Test->ok(0, $message);
144 1         338 $Test->diag("... paths do not match\n" .
145             " got: $generated_path\n" .
146             " expected: $expected");
147             }
148             else {
149 8         306 $Test->ok(1, $message);
150             }
151             }
152              
153             ## helper function
154              
155             sub _dump_mapping_info {
156 2     2   2 my ($mapping) = @_;
157 2         3 local $Data::Dumper::Indent = 0;
158 2         5 my $out = Data::Dumper::Dumper($mapping);
159 2         102 $out =~ s/\$VAR\d\s*=\s*//;
160 2         9 return $out;
161             }
162              
163             1;
164              
165             __END__
166              
167             =pod
168              
169             =encoding UTF-8
170              
171             =head1 NAME
172              
173             Test::Path::Router - A testing module for testing routes
174              
175             =head1 VERSION
176              
177             version 0.15
178              
179             =head1 SYNOPSIS
180              
181             use Test::More plan => 1;
182             use Test::Path::Router;
183              
184             my $router = Path::Router->new;
185              
186             # ... define some routes
187              
188             path_ok($router, 'admin/remove_user/56', '... this is a valid path');
189              
190             path_is($router,
191             'admin/edit_user/5',
192             {
193             controller => 'admin',
194             action => 'edit_user',
195             id => 5,
196             },
197             '... the path and mapping match');
198              
199             mapping_ok($router, {
200             controller => 'admin',
201             action => 'edit_user',
202             id => 5,
203             }, '... this maps to a valid path');
204              
205             mapping_is($router,
206             {
207             controller => 'admin',
208             action => 'edit_user',
209             id => 5,
210             },
211             'admin/edit_user/5',
212             '... the mapping and path match');
213              
214             routes_ok($router, {
215             'admin' => {
216             controller => 'admin',
217             action => 'index',
218             },
219             'admin/add_user' => {
220             controller => 'admin',
221             action => 'add_user',
222             },
223             'admin/edit_user/5' => {
224             controller => 'admin',
225             action => 'edit_user',
226             id => 5,
227             }
228             },
229             "... our routes are valid");
230              
231             =head1 DESCRIPTION
232              
233             This module helps in testing out your path routes, to make sure
234             they are valid.
235              
236             =head1 EXPORTED FUNCTIONS
237              
238             =over 4
239              
240             =item B<path_ok ($router, $path, ?$message)>
241              
242             =item B<path_not_ok ($router, $path, ?$message)>
243              
244             =item B<path_is ($router, $path, $mapping, ?$message)>
245              
246             =item B<mapping_ok ($router, $mapping, ?$message)>
247              
248             =item B<mapping_not_ok ($router, $mapping, ?$message)>
249              
250             =item B<mapping_is ($router, $mapping, $path, ?$message)>
251              
252             =item B<routes_ok ($router, \%test_routes, ?$message)>
253              
254             This test function will accept a set of C<%test_routes> which
255             will get checked against your C<$router> instance. This will
256             check to be sure that all paths in C<%test_routes> procude
257             the expected mappings, and that all mappings also produce the
258             expected paths. It basically assures you that your paths
259             are roundtrippable, so that you can be confident in them.
260              
261             =back
262              
263             =head1 BUGS
264              
265             All complex software has bugs lurking in it, and this module is no
266             exception. If you find a bug please either email me, or add the bug
267             to cpan-RT.
268              
269             =head1 AUTHOR
270              
271             Stevan Little E<lt>stevan@cpan.orgE<gt>
272              
273             =head1 COPYRIGHT AND LICENSE
274              
275             Copyright 2008-2011 Infinity Interactive, Inc.
276              
277             L<http://www.iinteractive.com>
278              
279             This library is free software; you can redistribute it and/or modify
280             it under the same terms as Perl itself.
281              
282             =head1 AUTHOR
283              
284             Stevan Little <stevan@cpan.org>
285              
286             =head1 COPYRIGHT AND LICENSE
287              
288             This software is copyright (c) 2016 by Infinity Interactive.
289              
290             This is free software; you can redistribute it and/or modify it under
291             the same terms as the Perl 5 programming language system itself.
292              
293             =cut