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