File Coverage

blib/lib/Test/Path/Router.pm
Criterion Covered Total %
statement 19 72 26.3
branch 0 18 0.0
condition 0 21 0.0
subroutine 7 15 46.6
pod 7 7 100.0
total 33 133 24.8


line stmt bran cond sub pod time code
1             package Test::Path::Router;
2             BEGIN {
3 10     10   207303 $Test::Path::Router::AUTHORITY = 'cpan:STEVAN';
4             }
5             # ABSTRACT: A testing module for testing routes
6             $Test::Path::Router::VERSION = '0.14';
7 10     10   87 use strict;
  10         14  
  10         359  
8 10     10   44 use warnings;
  10         17  
  10         313  
9              
10 10     10   48 use Test::Builder ();
  10         12  
  10         176  
11 10     10   6623 use Test::Deep ();
  10         102824  
  10         325  
12 10     10   7264 use Data::Dumper ();
  10         66759  
  10         312  
13 10     10   962701 use Sub::Exporter;
  10         103562  
  10         63  
14              
15             my @exports = qw/
16             routes_ok
17             path_ok
18             path_not_ok
19             path_is
20             mapping_ok
21             mapping_not_ok
22             mapping_is
23             /;
24              
25             Sub::Exporter::setup_exporter({
26             exports => \@exports,
27             groups => { default => \@exports }
28             });
29              
30             our $Test = Test::Builder->new;
31              
32             sub routes_ok {
33 0     0 1   my ($router, $routes, $message) = @_;
34 0           my ($passed, $reason);
35 0           foreach my $path (keys %$routes) {
36 0           my $mapping = $routes->{$path};
37              
38 0           my $generated_path = $router->uri_for(%{$mapping});
  0            
39              
40             # the path generated from the hash
41             # is the same as the path supplied
42 0 0         if ($path ne $generated_path) {
43 0           $Test->ok(0, $message);
44 0           $Test->diag("... paths do not match\n" .
45             " got: '" . $generated_path . "'\n" .
46             " expected: '" . $path . "'");
47 0           return;
48             }
49              
50 0           my $match = $router->match($path);
51 0   0       my $generated_mapping = $match && $match->mapping;
52              
53 0           $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 0 0         unless (Test::Deep::eq_deeply($generated_mapping, $mapping)) {
59 0           $Test->ok(0, $message);
60 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           return;
64             }
65             }
66 0           $Test->ok(1, $message);
67             }
68              
69             sub path_ok {
70 0     0 1   my ($router, $path, $message) = @_;
71 0 0         if ($router->match($path)) {
72 0           $Test->ok(1, $message);
73             }
74             else {
75 0           $Test->ok(0, $message);
76             }
77             }
78              
79             sub path_not_ok {
80 0     0 1   my ($router, $path, $message) = @_;
81 0 0         unless ($router->match($path)) {
82 0           $Test->ok(1, $message);
83             }
84             else {
85 0           $Test->ok(0, $message);
86             }
87             }
88              
89             sub path_is {
90 0     0 1   my ($router, $path, $expected, $message) = @_;
91              
92 0           my $generated_mapping = $router->match($path)->mapping;
93              
94             # the path supplied produces the
95             # same match as the hash supplied
96              
97 0 0         unless (Test::Deep::eq_deeply($generated_mapping, $expected)) {
98 0           $Test->ok(0, $message);
99 0           $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 0           $Test->ok(1, $message);
105             }
106             }
107              
108             sub mapping_ok {
109 0     0 1   my ($router, $mapping, $message) = @_;
110 0 0         if (defined $router->uri_for($mapping)) {
111 0           $Test->ok(1, $message);
112             }
113             else {
114 0           $Test->ok(0, $message);
115             }
116             }
117              
118             sub mapping_not_ok {
119 0     0 1   my ($router, $mapping, $message) = @_;
120 0 0         unless (defined $router->uri_for($mapping)) {
121 0           $Test->ok(1, $message);
122             }
123             else {
124 0           $Test->ok(0, $message);
125             }
126             }
127              
128             sub mapping_is {
129 0     0 1   my ($router, $mapping, $expected, $message) = @_;
130              
131 0           my $generated_path = $router->uri_for(%{$mapping});
  0            
132              
133             # the path generated from the hash
134             # is the same as the path supplied
135 0 0 0       if (
      0        
      0        
      0        
      0        
      0        
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 0 0         for $generated_path, $expected;
143 0           $Test->ok(0, $message);
144 0           $Test->diag("... paths do not match\n" .
145             " got: $generated_path\n" .
146             " expected: $expected");
147             }
148             else {
149 0           $Test->ok(1, $message);
150             }
151             }
152              
153             ## helper function
154              
155             sub _dump_mapping_info {
156 0     0     my ($mapping) = @_;
157 0           local $Data::Dumper::Indent = 0;
158 0           my $out = Data::Dumper::Dumper($mapping);
159 0           $out =~ s/\$VAR\d\s*=\s*//;
160 0           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.14
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.little@iinteractive.comE<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@iinteractive.com>
285              
286             =head1 COPYRIGHT AND LICENSE
287              
288             This software is copyright (c) 2015 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