File Coverage

blib/lib/Test/Map/Tube.pm
Criterion Covered Total %
statement 31 164 18.9
branch 1 88 1.1
condition 0 71 0.0
subroutine 9 17 52.9
pod 4 4 100.0
total 45 344 13.0


line stmt bran cond sub pod time code
1             package Test::Map::Tube;
2              
3             $Test::Map::Tube::VERSION = '0.33';
4             $Test::Map::Tube::AUTHORITY = 'cpan:MANWAR';
5              
6             =head1 NAME
7              
8             Test::Map::Tube - Interface to test Map::Tube features.
9              
10             =head1 VERSION
11              
12             Version 0.33
13              
14             =cut
15              
16 4     4   100356 use strict; use warnings;
  4     4   24  
  4         133  
  4         26  
  4         7  
  4         102  
17 4     4   70 use 5.006;
  4         16  
18 4     4   20 use Carp;
  4         8  
  4         269  
19 4     4   1284 use Test::Builder;
  4         136143  
  4         130  
20 4     4   1311 use Data::Compare;
  4         37676  
  4         24  
21 4     4   13533 use Map::Tube::Route;
  4         571917  
  4         415  
22              
23             my $TEST = Test::Builder->new;
24             my $TEST_BOOL = 1;
25             my $PLAN = 0;
26              
27             =head1 DESCRIPTION
28              
29             It's main responsibilty is to validate the map data as used by the package that
30             takes the role of L.You can also unit test map functions as well.
31              
32             =head1 SYNOPSIS
33              
34             =head2 Validate map data ONLY.
35              
36             use strict; use warnings;
37             use Test::More;
38              
39             my $min_ver = 0.17;
40             eval "use Test::Map::Tube $min_ver";
41             plan skip_all => "Test::Map::Tube $min_ver required" if $@;
42              
43             use Map::Tube::London;
44             ok_map(Map::Tube::London->new);
45              
46             =head2 Validate map functions ONLY.
47              
48             use strict; use warnings;
49             use Test::More;
50              
51             my $min_ver = 0.17;
52             eval "use Test::Map::Tube $min_ver";
53             plan skip_all => "Test::Map::Tube $min_ver required" if $@;
54              
55             use Map::Tube::London;
56             ok_map_functions(Map::Tube::London->new);
57              
58             =head2 Validate map data and functions BOTH.
59              
60             use strict; use warnings;
61             use Test::More;
62              
63             my $min_ver = 0.17;
64             eval "use Test::Map::Tube $min_ver tests => 2";
65             plan skip_all => "Test::Map::Tube $min_ver required" if $@;
66              
67             use Map::Tube::London;
68             my $map = Map::Tube::London->new;
69             ok_map($map);
70             ok_map_functions($map);
71              
72             =head2 Validate map data, functions and routes.
73              
74             use strict; use warnings;
75             use Test::More;
76              
77             my $min_ver = 0.17;
78             eval "use Test::Map::Tube $min_ver tests => 3";
79             plan skip_all => "Test::Map::Tube $min_ver required" if $@;
80              
81             use Map::Tube::London;
82             my $map = Map::Tube::London->new;
83             ok_map($map);
84             ok_map_functions($map);
85              
86             my @routes = (
87             "Route 1|Tower Gateway|Aldgate|Tower Gateway,Tower Hill,Aldgate",
88             "Route 2|Liverpool Street|Monument|Liverpool Street,Bank,Monument",
89             );
90             ok_map_routes($map, \@routes);
91              
92             =cut
93              
94             sub import {
95 4     4   95 my ($self, %plan) = @_;
96 4         12 my $caller = caller;
97              
98 4         10 foreach my $function (qw(ok_map not_ok_map ok_map_routes ok_map_functions)) {
99 4     4   36 no strict 'refs';
  4         9  
  4         5446  
100 16         41 *{$caller."::".$function} = \&$function;
  16         76  
101             }
102              
103 4         25 $TEST->exported_to($caller);
104 4         57 $TEST->plan(%plan);
105              
106 4 50       155 $PLAN = 1 if (exists $plan{tests});
107             }
108              
109             =head1 METHODS
110              
111             =head2 ok_map($map_object, $message)
112              
113             Validates the map data. It expects an object of a package that has taken the role
114             of L. You can optionally pass C<$message>.
115              
116             =cut
117              
118             sub ok_map ($;$) {
119 0     0 1   my ($object, $message) = @_;
120              
121 0 0         $TEST->plan(tests => 1) unless $PLAN;
122 0           $TEST->is_num(_ok_map($object), $TEST_BOOL, $message);
123             }
124              
125             =head2 not_ok_map($map_object, $message)
126              
127             Reverse of C.
128              
129             =cut
130              
131             sub not_ok_map ($;$) {
132 0     0 1   my ($object, $message) = @_;
133              
134 0 0         $TEST->plan(tests => 1) unless $PLAN;
135 0           $TEST->is_num(_ok_map($object), !$TEST_BOOL, $message);
136             }
137              
138             =head2 ok_map_functions($map_object, $message)
139              
140             Validates the map functions. It expects an object of a package that has taken the
141             role of L. You can optionally pass C<$message>. For this method, you
142             would require C v0.09 or above.
143              
144             =cut
145              
146             sub ok_map_functions ($;$) {
147 0     0 1   my ($object, $message) = @_;
148              
149 0 0         $TEST->plan(tests => 1) unless $PLAN;
150 0           $TEST->is_num(_ok_map_functions($object), $TEST_BOOL, $message);
151             }
152              
153             =head2 ok_map_routes($map_object, \@routes, $message)
154              
155             Validates the given routes. It expects an object of a package that has taken the
156             role of L and array ref of list of route details in the format below:
157              
158             my @routes = (
159             "Route 1|A1|A3|A1,A2,A3",
160             "Route 2|A1|B1|A1,A2,B1",
161             );
162              
163             You can optionally pass C<$message>. For this method, you would require C
164             v0.15 or above.
165              
166             =cut
167              
168             sub ok_map_routes($$;$) {
169 0     0 1   my ($object, $routes, $message) = @_;
170              
171 0 0         $TEST->plan(tests => 1) unless $PLAN;
172 0           my ($response, $error) = _ok_map_routes($object, $routes);
173 0   0       $TEST->is_num($response, $TEST_BOOL, $message||$error);
174             }
175              
176             #
177             #
178             # PRIVATE METHODS
179              
180             sub _ok_map {
181 0     0     my ($object) = @_;
182              
183 0 0 0       return 0 unless (defined $object && $object->does('Map::Tube'));
184              
185 0           eval { $object->get_map_data };
  0            
186 0 0 0       ($@) and (carp('no map data found') and return 0);
187              
188 0           eval { $object->_validate_map_data; };
  0            
189 0 0         return 1 unless ($@);
190              
191 0 0         carp($@) and return 0;
192             }
193              
194             sub _ok_map_functions {
195 0     0     my ($object) = @_;
196              
197 0 0 0       return 0 unless (defined $object && $object->does('Map::Tube'));
198              
199 0           my $actual;
200 0           eval { $actual = $object->get_map_data };
  0            
201 0 0 0       ($@) and (carp('no map data found') and return 0);
202              
203             # get_shortest_route()
204 0           eval { $object->get_shortest_route };
  0            
205 0 0 0       ($@) or (carp('get_shortest_route() with no param') and return 0);
206 0           eval { $object->get_shortest_route('Foo') };
  0            
207 0 0 0       ($@) or (carp('get_shortest_route() with one param') and return 0);
208 0           eval { $object->get_shortest_route('Foo', 'Bar') };
  0            
209 0 0 0       ($@) or (carp('get_shortest_route() with two invalid params') and return 0);
210 0           my $from_station = $actual->{stations}->{station}->[0]->{name};
211 0           my $to_station = $actual->{stations}->{station}->[1]->{name};
212 0           eval { $object->get_shortest_route($from_station, 'Bar') };
  0            
213 0 0 0       ($@) or (carp('get_shortest_route() with invalid to station') and return 0);
214 0           eval { $object->get_shortest_route('Foo', $to_station) };
  0            
215 0 0 0       ($@) or (carp('get_shortest_route() with invalid from station') and return 0);
216 0           eval { $object->get_shortest_route($from_station, $to_station) };
  0            
217 0 0 0       ($@) and carp($@) and return 0;
218              
219             # get_name()
220             ($object->name eq $actual->{name})
221 0 0 0       or (carp('name() returns incorrect map name') and return 0);
222              
223             # get_lines()
224 0           my $lines_count = scalar(@{$actual->{lines}->{line}});
  0            
225 0 0 0       (scalar(@{$object->get_lines}) == $lines_count)
  0            
226             or (carp('get_lines() returns incorrect line entries') and return 0);
227              
228             # get_stations()
229 0           eval { $object->get_stations };
  0            
230 0 0 0       ($@) or (carp('get_stations() with no param') and return 0);
231 0           eval { $object->get_stations('Not-A-Valid-Line-Name') };
  0            
232 0 0 0       ($@) or (carp('get_stations() with invalid line name') and return 0);
233 0           my $line_name = $actual->{lines}->{line}->[0]->{name};
234 0 0 0       (scalar(@{$object->get_stations($line_name)}) > 0)
  0            
235             or (carp('get_stations() returns incorrect station entries') and return 0);
236              
237             # get_line_by_id()
238 0           eval { $object->get_line_by_id };
  0            
239 0 0 0       ($@) or (carp('get_line_by_id() with no param') and return 0);
240 0           eval { $object->get_line_by_id('Not-A-Valid-Line-ID') };
  0            
241 0 0 0       ($@) or (carp('get_line_by_id() with invalid id') and return 0);
242 0           my $line_id = $actual->{lines}->{line}->[0]->{id};
243 0           eval { $object->get_line_by_id($line_id) };
  0            
244 0 0 0       ($@) and (carp($@) and return 0);
245              
246             # get_line_by_name() - handle in case Map::Tube::Plugin::FuzzyNames is installed.
247 0           eval { $object->get_line_by_name($line_name) };
  0            
248 0 0 0       ($@) and (carp($@) and return 0);
249 0 0         eval { my $l = $object->get_line_by_name('Not-A-Valid-Line-Name'); croak() unless defined $l };
  0            
  0            
250 0 0 0       ($@) or (carp('get_line_by_name() with invalid line name') and return 0);
251 0 0         eval { my $l = $object->get_line_by_name; croak() unless defined $l; };
  0            
  0            
252 0 0 0       ($@) or (carp('get_line_by_name() with no param') and return 0);
253              
254             # get_node_by_id()
255 0           eval { $object->get_node_by_id };
  0            
256 0 0 0       ($@) or (carp('get_node_by_id() with no param') and return 0);
257 0           eval { $object->get_node_by_id('Not-A-Valid-Node-ID') };
  0            
258 0 0 0       ($@) or (carp('get_node_by_id() with invalid node id') and return 0);
259 0           my $station_id = $actual->{stations}->{station}->[0]->{id};
260 0           eval { $object->get_node_by_id($station_id) };
  0            
261 0 0 0       ($@) and (carp($@) and return 0);
262              
263             # add_station()
264 0           eval { $object->get_line_by_id($line_id)->add_station };
  0            
265 0 0 0       ($@) or (carp('add_station() with no param') and return 0);
266 0           eval { $object->get_line_by_id($line_id)->add_station('Not-A-Valid-Station') };
  0            
267 0 0 0       ($@) or (carp('add_station() with invalid node object') and return 0);
268 0           eval { $object->get_line_by_id($line_id)->add_station($object->get_node_by_id($station_id)) };
  0            
269 0 0 0       ($@) and (carp($@) and return 0);
270              
271             # get_node_by_name()
272 0           eval { $object->get_node_by_name };
  0            
273 0 0 0       ($@) or (carp('get_node_by_name() with no param') and return 0);
274 0           eval { $object->get_node_by_name('Not-A-Valid-Node-Name') };
  0            
275 0 0 0       ($@) or (carp('get_node_by_name() with invalid node name') and return 0);
276 0           my $station_name = $actual->{stations}->{station}->[0]->{name};
277 0           eval { $object->get_node_by_name($station_name) };
  0            
278 0 0 0       ($@) and (carp($@) and return 0);
279              
280 0           return 1;
281             }
282              
283             sub _ok_map_routes {
284 0     0     my ($object, $routes) = @_;
285              
286 0 0 0       return 0 unless (defined $object && $object->does('Map::Tube'));
287              
288 0           eval { $object->get_map_data };
  0            
289 0 0 0       ($@) and (carp('no map data found') and return 0);
290              
291 0           foreach (@$routes) {
292 0           chomp;
293 0 0         next if /^\#/;
294 0 0         next if /^\s+$/;
295              
296 0           my ($description, $from, $to, $route) = split /\|/;
297 0           my $got = $object->get_shortest_route($from, $to);
298 0           my $expected = _expected_route($object, $route);
299 0 0         return (0, "Failed: $description") unless Compare($got, $expected);
300             }
301              
302 0           return 1;
303             }
304              
305             sub _expected_route {
306 0     0     my ($object, $route) = @_;
307              
308 0           my $nodes = [];
309 0           foreach my $name (split /\,/,$route) {
310 0           my @_names = $object->get_node_by_name($name);
311 0           push @$nodes, $_names[0];
312             }
313              
314 0           return Map::Tube::Route->new(
315             { from => $nodes->[0],
316             to => $nodes->[-1],
317             nodes => $nodes
318             });
319             }
320              
321             =head1 BUGS
322              
323             None that I am aware of.Of course, if you find a bug, let me know, and I would do
324             my best to fix it. This is still a very early version, so it is always possible
325             that I have just "gotten it wrong" in some places.
326              
327             =head1 SEE ALSO
328              
329             =over 4
330              
331             =item L
332              
333             =back
334              
335             =head1 AUTHOR
336              
337             Mohammad S Anwar, C<< >>
338              
339             =head1 REPOSITORY
340              
341             L
342              
343             =head1 BUGS
344              
345             Please report any bugs / feature requests to C,
346             or through the web interface at L.
347             I will be notified, and then you'll automatically be notified of progress on your
348             bug as I make changes.
349              
350             =head1 SUPPORT
351              
352             You can find documentation for this module with the perldoc command.
353              
354             perldoc Test::Map::Tube
355              
356             You can also look for information at:
357              
358             =over 4
359              
360             =item * RT: CPAN's request tracker (report bugs here)
361              
362             L
363              
364             =item * AnnoCPAN: Annotated CPAN documentation
365              
366             L
367              
368             =item * CPAN Ratings
369              
370             L
371              
372             =item * Search CPAN
373              
374             L
375              
376             =back
377              
378             =head1 LICENSE AND COPYRIGHT
379              
380             Copyright (C) 2015 - 2016 Mohammad S Anwar.
381              
382             This program is free software; you can redistribute it and/or modify it under
383             the terms of the the Artistic License (2.0). You may obtain a copy of the full
384             license at:
385              
386             L
387              
388             Any use, modification, and distribution of the Standard or Modified Versions is
389             governed by this Artistic License.By using, modifying or distributing the Package,
390             you accept this license. Do not use, modify, or distribute the Package, if you do
391             not accept this license.
392              
393             If your Modified Version has been derived from a Modified Version made by someone
394             other than you,you are nevertheless required to ensure that your Modified Version
395             complies with the requirements of this license.
396              
397             This license does not grant you the right to use any trademark, service mark,
398             tradename, or logo of the Copyright Holder.
399              
400             This license includes the non-exclusive, worldwide, free-of-charge patent license
401             to make, have made, use, offer to sell, sell, import and otherwise transfer the
402             Package with respect to any patent claims licensable by the Copyright Holder that
403             are necessarily infringed by the Package. If you institute patent litigation
404             (including a cross-claim or counterclaim) against any party alleging that the
405             Package constitutes direct or contributory patent infringement,then this Artistic
406             License to you shall terminate on the date that such litigation is filed.
407              
408             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND
409             CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
410             WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
411             NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS
412             REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT,
413             INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
414             OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
415              
416             =cut
417              
418             1; # End of Test::Map::Tube