File Coverage

blib/lib/Labyrinth/Paths.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Labyrinth::Paths;
2              
3 6     6   87120 use warnings;
  6         12  
  6         209  
4 6     6   30 use strict;
  6         9  
  6         268  
5              
6             our $VERSION = '0.02';
7              
8             # -------------------------------------
9             # Library Modules
10              
11 6     6   2298 use IO::File;
  6         38543  
  6         646  
12 6     6   3471 use JSON::XS;
  6         30794  
  6         382  
13 6     6   4780 use Labyrinth;
  0            
  0            
14             use Labyrinth::Variables;
15              
16             # -------------------------------------
17             # The Subs
18              
19             =head1 FUNCTIONS
20              
21             =head2 Constructor
22              
23             =over 4
24              
25             =item new()
26              
27             Create a new path object.
28              
29             =back
30              
31             =cut
32              
33             sub new {
34             my ($class,$pathfile) = @_;
35              
36             # create an attributes hash
37             my $atts = {
38             pathfile => $pathfile || $settings{pathfile} || './pathfile.json'
39             };
40              
41             # create the object
42             bless $atts, $class;
43              
44             $atts->load;
45              
46             return $atts;
47             };
48              
49             =head2 Methods
50              
51             =head3 Handling Actions
52              
53             =over 4
54              
55             =item load( [$file] )
56              
57             Load the given path file, which can be the default, or specified as a parameter.
58              
59             =item parse()
60              
61             Parse the current path and reset cgiparams and settings values as appropriate.
62              
63             =back
64              
65             =cut
66              
67             sub load {
68             my $self = shift;
69             my $file = shift;
70              
71             if($file) {
72             return unless(-f $file);
73             $self->{pathfile} = $file;
74             } else {
75             return unless(-f $self->{pathfile});
76             }
77              
78             my $fh = IO::File->new($self->{pathfile},'r') or return;
79             local $/ = undef;
80             my $json = <$fh>;
81             $fh->close;
82              
83             eval {
84             my $data = decode_json($json);
85             $self->{data} = $data->{paths};
86             };
87              
88             return;
89             }
90              
91             sub parse {
92             my $self = shift;
93              
94             my $path = $ENV{SCRIPT_URL} || $ENV{SCRIPT_NAME};
95             return unless($path);
96              
97             for my $data (@{$self->{data}}) {
98             if($path =~ /$data->{path}/) {
99             my @vars1 = ($1,$2,$3,$4,$5,$6,$7,$8,$9);
100             my @vars2 = @{$data->{variables}};
101              
102             while(@vars1 && @vars2) {
103             my $name = shift @vars2;
104             $cgiparams{$name} = shift @vars1;
105             }
106              
107             $cgiparams{$_} = $data->{cgiparams}{$_} for(keys %{$data->{cgiparams}});
108             $settings{$_} = $data->{settings}{$_} for(keys %{$data->{settings}});
109              
110             return;
111             }
112             }
113             }
114              
115             1;
116              
117             __END__