File Coverage

blib/lib/Router/Dumb/Helper/RouteFile.pm
Criterion Covered Total %
statement 39 39 100.0
branch 8 12 66.6
condition 6 8 75.0
subroutine 6 6 100.0
pod 0 1 0.0
total 59 66 89.3


line stmt bran cond sub pod time code
1 1     1   417 use 5.14.0;
  1         3  
2             package Router::Dumb::Helper::RouteFile 0.006;
3 1     1   7 use Moose;
  1         2  
  1         5  
4             # ABSTRACT: something to read routes out of a dumb text file
5              
6             #pod =head1 OVERVIEW
7             #pod
8             #pod my $r = Router::Dumb->new;
9             #pod
10             #pod Router::Dumb::Helper::RouteFile->new({ filename => 'routes.txt' })
11             #pod ->add_routes_to( $r );
12             #pod
13             #pod ...and F<routes.txt> looks like...
14             #pod
15             #pod # These are some great routes!
16             #pod
17             #pod /citizen/:num/dob => /citizen/dob
18             #pod num isa Int
19             #pod
20             #pod /blog/* => /blog
21             #pod
22             #pod Then routes are added, doing just what you'd expect. This helper is pretty
23             #pod dumb, but the whole Router::Dumb system is, too.
24             #pod
25             #pod =cut
26              
27 1     1   5384 use Router::Dumb::Route;
  1         2  
  1         31  
28              
29 1     1   6 use Moose::Util::TypeConstraints qw(find_type_constraint);
  1         1  
  1         6  
30              
31 1     1   346 use namespace::autoclean;
  1         2  
  1         5  
32              
33             has filename => (is => 'ro', isa => 'Str', required => 1);
34              
35             sub add_routes_to {
36 1     1 0 550 my ($self, $router, $arg) = @_;
37 1   50     6 $arg ||= {};
38              
39 1         27 my $file = $self->filename;
40              
41 1         2 my @lines;
42             {
43 1 50       2 open my $fh, '<', $file or die "can't open $file for reading: $!";
  1         41  
44              
45             # ignore comments, blanks
46 6         22 @lines = grep { /\S/ }
47 1         41 map { chomp; s/#.*\z//r } <$fh>
  6         9  
  6         16  
48             }
49              
50             my $add_method = $arg->{ignore_conflicts}
51 1 50       6 ? 'add_route_unless_exists'
52             : 'add_route';
53              
54 1         2 my $curr;
55 1         4 for my $i (0 .. $#lines) {
56 3         4 my $line = $lines[$i];
57              
58 3 100       9 if ($line =~ /^\s/) {
59 1 50       3 confess "indented line found out of context of a route" unless $curr;
60 1 50       8 confess "couldn't understand line <$line>"
61             unless my ($name, $type) = $line =~ /\A\s+(\S+)\s+isa\s+(\S+)\s*\z/;
62              
63 1         6 $curr->{constraints}->{$name} = find_type_constraint($type);
64             } else {
65 2         11 my ($path, $target) = split /\s*=>\s*/, $line;
66 2         11 s{^/}{} for $path, $target;
67 2         7 my @parts = split m{/}, $path;
68              
69 2         7 $curr = {
70             parts => \@parts,
71             target => $target,
72             };
73             }
74              
75 3 100 100     132 if ($curr and ($i == $#lines or $lines[ $i + 1 ] =~ /^\S/)) {
      66        
76 2         10 $router->$add_method( Router::Dumb::Route->new($curr) );
77 2         8 undef $curr;
78             }
79             }
80             }
81              
82             1;
83              
84             __END__
85              
86             =pod
87              
88             =encoding UTF-8
89              
90             =head1 NAME
91              
92             Router::Dumb::Helper::RouteFile - something to read routes out of a dumb text file
93              
94             =head1 VERSION
95              
96             version 0.006
97              
98             =head1 OVERVIEW
99              
100             my $r = Router::Dumb->new;
101            
102             Router::Dumb::Helper::RouteFile->new({ filename => 'routes.txt' })
103             ->add_routes_to( $r );
104              
105             ...and F<routes.txt> looks like...
106              
107             # These are some great routes!
108              
109             /citizen/:num/dob => /citizen/dob
110             num isa Int
111              
112             /blog/* => /blog
113              
114             Then routes are added, doing just what you'd expect. This helper is pretty
115             dumb, but the whole Router::Dumb system is, too.
116              
117             =head1 PERL VERSION
118              
119             This library should run on perls released even a long time ago. It should work
120             on any version of perl released in the last five years.
121              
122             Although it may work on older versions of perl, no guarantee is made that the
123             minimum required version will not be increased. The version may be increased
124             for any reason, and there is no promise that patches will be accepted to lower
125             the minimum required perl.
126              
127             =head1 AUTHOR
128              
129             Ricardo Signes <cpan@semiotic.systems>
130              
131             =head1 COPYRIGHT AND LICENSE
132              
133             This software is copyright (c) 2022 by Ricardo Signes.
134              
135             This is free software; you can redistribute it and/or modify it under
136             the same terms as the Perl 5 programming language system itself.
137              
138             =cut