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