File Coverage

blib/lib/HTML/Widgets/NavMenu/Predicate.pm
Criterion Covered Total %
statement 64 64 100.0
branch 24 24 100.0
condition 3 3 100.0
subroutine 12 12 100.0
pod 1 1 100.0
total 104 104 100.0


line stmt bran cond sub pod time code
1             package HTML::Widgets::NavMenu::Predicate;
2             $HTML::Widgets::NavMenu::Predicate::VERSION = '1.0901';
3 12     12   56446 use strict;
  12         27  
  12         307  
4 12     12   52 use warnings;
  12         21  
  12         290  
5              
6 12     12   390 use parent 'HTML::Widgets::NavMenu::Object';
  12         296  
  12         53  
7              
8             __PACKAGE__->mk_acc_ref( [qw(type bool regexp callback _capture)], );
9              
10 12     12   1114 use HTML::Widgets::NavMenu::ExpandVal;
  12         26  
  12         7037  
11              
12             sub _init
13             {
14 62     62   84 my $self = shift;
15              
16 62         128 my %args = (@_);
17              
18 62         94 my $spec = $args{'spec'};
19              
20 62         137 $self->_process_spec($spec);
21              
22 60         125 return 0;
23             }
24              
25             my %true_vals = ( map { $_ => 1 } (qw(1 yes true True)) );
26              
27             sub _is_true_bool
28             {
29 8     8   10 my $self = shift;
30 8         12 my $val = shift;
31 8         20 return exists( $true_vals{$val} );
32             }
33              
34             my %false_vals = ( map { $_ => 1 } (qw(0 no false False)) );
35              
36             sub _is_false_bool
37             {
38 7     7   10 my $self = shift;
39 7         7 my $val = shift;
40 7         16 return exists( $false_vals{$val} );
41             }
42              
43             sub _get_normalized_spec
44             {
45 62     62   85 my $self = shift;
46 62         70 my $spec = shift;
47              
48 62 100       148 if ( ref($spec) eq "HASH" )
49             {
50 53         123 return $spec;
51             }
52 9 100       19 if ( ref($spec) eq "CODE" )
53             {
54 1         3 return +{ 'cb' => $spec };
55             }
56 8 100       11 if ( $self->_is_true_bool($spec) )
57             {
58 1         4 return +{ 'bool' => 1, };
59             }
60 7 100       12 if ( $self->_is_false_bool($spec) )
61             {
62 4         11 return +{ 'bool' => 0, };
63             }
64              
65             # Default to regular expression
66 3 100       8 if ( ref($spec) eq "" )
67             {
68 2         5 return +{ 're' => $spec, };
69             }
70 1         8 die "Unknown spec type!";
71             }
72              
73             sub _process_spec
74             {
75 62     62   81 my $self = shift;
76 62         73 my $spec = shift;
77              
78             # TODO: Replace me with the real logic.
79 62         115 $self->_assign_spec( $self->_get_normalized_spec( $spec, ), );
80             }
81              
82             sub _assign_spec
83             {
84 61     61   79 my $self = shift;
85 61         78 my $spec = shift;
86              
87 61 100       181 if ( exists( $spec->{'cb'} ) )
    100          
    100          
88             {
89 15         37 $self->type("callback");
90 15         24 $self->callback( $spec->{'cb'} );
91             }
92             elsif ( exists( $spec->{'re'} ) )
93             {
94 29         68 $self->type("regexp");
95 29         62 $self->regexp( $spec->{'re'} );
96             }
97             elsif ( exists( $spec->{'bool'} ) )
98             {
99 16         49 $self->type("bool");
100 16         35 $self->bool( $spec->{'bool'} );
101             }
102             else
103             {
104 1         9 die "Neither 'cb' nor 're' nor 'bool' were specified in the spec.";
105             }
106              
107 60 100       154 $self->_capture( ( ( !exists( $spec->{capt} ) ) ? 1 : $spec->{capt} ) );
108             }
109              
110             sub _evaluate_bool
111             {
112 101     101   166 my ( $self, $args ) = @_;
113              
114 101         142 my $path_info = $args->{'path_info'};
115 101         130 my $current_host = $args->{'current_host'};
116              
117 101         176 my $type = $self->type();
118              
119 101 100       222 if ( $type eq "callback" )
    100          
120             {
121 28         107 return $self->callback()->(%$args);
122             }
123             elsif ( $type eq "bool" )
124             {
125 27         60 return $self->bool();
126             }
127             else # $type eq "regexp"
128             {
129 46         75 my $re = $self->regexp();
130 46   100     537 return ( ( $re eq "" ) || ( $path_info =~ /$re/ ) );
131             }
132             }
133              
134             sub evaluate
135             {
136 101     101 1 197 my $self = shift;
137              
138 101         277 my $bool = $self->_evaluate_bool( {@_} );
139              
140 101 100       471 if ( !$bool )
141             {
142 50         147 return $bool;
143             }
144             else
145             {
146 51         169 return HTML::Widgets::NavMenu::ExpandVal->new(
147             {
148             capture => $self->_capture()
149             },
150             );
151             }
152             }
153              
154              
155             1;
156              
157             __END__