File Coverage

blib/lib/App/ZofCMS/Config.pm
Criterion Covered Total %
statement 41 63 65.0
branch 10 36 27.7
condition 3 12 25.0
subroutine 9 11 81.8
pod 3 5 60.0
total 66 127 51.9


line stmt bran cond sub pod time code
1             package App::ZofCMS::Config;
2              
3 2     2   711 use warnings;
  2         2  
  2         53  
4 2     2   7 use strict;
  2         2  
  2         82  
5              
6             our $VERSION = '1.001007'; # VERSION
7              
8 2     2   714 use CGI qw/:standard Vars/;
  2         21148  
  2         11  
9 2     2   3813 use Carp;
  2         3  
  2         1109  
10              
11             require File::Spec;
12              
13             sub new {
14 1     1 0 1 my $class = shift;
15 1         2 my $self = bless {}, $class;
16              
17 1         4 $self->cgi( CGI->new );
18 1         3 $self->query( $self->_prepare_query );
19              
20 1         2 return $self;
21             }
22              
23             sub load {
24 0     0 0 0 my ( $self, $conf_file, $no_page_check ) = @_;
25              
26              
27 0 0       0 my $conf = do $conf_file
28             or croak "Failed to load config file ($!) ($@)";
29              
30             defined $conf->{zcms_template_extension}
31 0 0       0 or $conf->{zcms_template_extension} = '.tmpl';
32              
33 0 0       0 unless ( $no_page_check ) {
34 0         0 my $query = $self->query;
35 0         0 my $is_valid_page = $self->_is_valid_page(
36             $query,
37             $conf,
38             );
39              
40 0 0       0 unless ( $is_valid_page ) {
41 0         0 @$query{ qw/page dir/ } = qw|404 /|;
42             }
43             }
44              
45 0         0 return $self->conf( $conf );
46             }
47              
48             sub _is_valid_page {
49 0     0   0 my ( $self, $query, $conf ) = @_;
50              
51             my ( $ext, $templates_dir, $valid_pages )
52 0         0 = @$conf{ qw/zcms_template_extension templates valid_pages/ };
53              
54 0 0       0 unless ( ref $valid_pages eq 'HASH' ) {
55 0         0 croak "Config file error: valid_pages must be a hashref";
56             }
57              
58 0 0       0 for ( @{ $valid_pages->{pages} || [] } ) {
  0         0  
59             return 1
60 0 0       0 if $_ eq $query->{dir} . $query->{page};
61             }
62              
63 0 0       0 for ( @{ $valid_pages->{dirs} || [] } ) {
  0         0  
64             return 1
65             if $_ eq $query->{dir}
66 0 0 0     0 and -e File::Spec->catfile( $templates_dir, $query->{dir}, $query->{page} . $ext);
67             }
68              
69 0         0 return 0;
70             }
71              
72             sub _prepare_query {
73 1     1   1 my $self = shift;
74              
75 1         2 my %query = Vars();
76              
77 1 50 33     163 unless ( defined $query{page} and length $query{page} ) {
78 1         2 $query{page} = 'index';
79             }
80              
81 1 50       2 if ( $query{page} =~ m|/| ) {
82 0         0 ( $query{dir}, $query{page} ) = $query{page} =~ m|(.*/)([^/]*)$|;
83             }
84              
85 1 50 33     6 unless ( defined $query{page} and length $query{page} ) {
86 0         0 $query{page} = 'index';
87             }
88              
89 1 50 33     2 unless ( defined $query{dir} and length $query{dir} ) {
90 1         2 $query{dir} = '/';
91             }
92              
93 1         1 $query{dir} =~ s/\Q..//g;
94              
95             $query{dir} = "/$query{dir}"
96 1 50       3 unless substr($query{dir}, 0, 1) eq '/';
97              
98             $query{dir} .= '/'
99 1 50       2 unless substr($query{dir}, -1) eq '/';
100              
101 1         2 return \%query;
102             }
103              
104             sub cgi {
105 1     1 1 152 my $self = shift;
106 1 50       3 if ( @_ ) {
107 1         3 $self->{ cgi } = shift;
108             }
109 1         2 return $self->{ cgi };
110             }
111              
112              
113             sub query {
114 1     1 1 1 my $self = shift;
115 1 50       2 if ( @_ ) {
116 1         1 $self->{ query } = shift;
117             }
118 1         2 return $self->{ query };
119             }
120              
121              
122             sub conf {
123 2     2 1 2 my $self = shift;
124 2 100       3 if ( @_ ) {
125 1         1 $self->{ conf } = shift;
126             }
127 2         3 return $self->{ conf };
128             }
129              
130              
131              
132             1;
133             __END__