package HTML::Widgets::NavMenu::Predicate; use strict; use warnings; use base 'HTML::Widgets::NavMenu::Object'; use base 'Class::Accessor'; __PACKAGE__->mk_accessors( qw(type bool regexp callback capture), ); use HTML::Widgets::NavMenu::ExpandVal; sub _init { my $self = shift; my %args = (@_); my $spec = $args{'spec'}; $self->_process_spec($spec); return 0; } my %true_vals = (map { $_ => 1 } (qw(1 yes true True))); sub _is_true_bool { my $self = shift; my $val = shift; return exists($true_vals{$val}); } my %false_vals = (map { $_ => 1 } (qw(0 no false False))); sub _is_false_bool { my $self = shift; my $val = shift; return exists($false_vals{$val}); } sub _get_normalized_spec { my $self = shift; my $spec = shift; if (ref($spec) eq "HASH") { return $spec; } if (ref($spec) eq "CODE") { return +{ 'cb' => $spec }; } if ($self->_is_true_bool($spec)) { return +{ 'bool' => 1, }; } if ($self->_is_false_bool($spec)) { return +{ 'bool' => 0, }; } # Default to regular expression if (ref($spec) eq "") { return +{ 're' => $spec, }; } die "Unknown spec type!"; } sub _process_spec { my $self = shift; my $spec = shift; # TODO: Replace me with the real logic. $self->_assign_spec( $self->_get_normalized_spec( $spec, ), ); } sub _assign_spec { my $self = shift; my $spec = shift; if (exists($spec->{'cb'})) { $self->type("callback"); $self->callback($spec->{'cb'}); } elsif (exists($spec->{'re'})) { $self->type("regexp"); $self->regexp($spec->{'re'}); } elsif (exists($spec->{'bool'})) { $self->type("bool"); $self->bool($spec->{'bool'}); } else { die "Neither 'cb' nor 're' nor 'bool' were specified in the spec."; } $self->capture( ( (!exists($spec->{capt})) ? 1 : $spec->{capt} ) ); } sub _evaluate_bool { my $self = shift; my (%args) = (@_); my $path_info = $args{'path_info'}; my $current_host = $args{'current_host'}; my $type = $self->type(); if ($type eq "callback") { return $self->callback()->( %args ); } elsif ($type eq "bool") { return $self->bool(); } else # $type eq "regexp" { my $re = $self->regexp(); return (($re eq "") || ($path_info =~ /$re/)); } } sub evaluate { my $self = shift; my $bool = $self->_evaluate_bool(@_); if (!$bool) { return $bool; } else { return HTML::Widgets::NavMenu::ExpandVal->new( capture => $self->capture() ); } } =head1 NAME HTML::Widgets::NavMenu::Predicate - a predicate object for HTML::Widgets::NavMenu =head1 SYNOPSIS my $pred = HTML::Widgets::NavMenu::Predicate->new('spec' => $spec); =head1 FUNCTIONS =head2 my $pred = HTML::Widgets::NavMenu::Predicate->new('spec' => $spec) Creates a new object. =head2 $pred->evaluate( 'path_info' => $path_info, 'current_host' => $current_host ) Evaluates the predicate in the context of C<$path_info> and C<$current_host> and returns the result. =head1 COPYRIGHT & LICENSE Copyright 2006 Shlomi Fish, all rights reserved. This program is released under the following license: MIT X11. =cut 1;