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__ |