package SugarTrail::Template::Condition; # condition # new() # parse(string) # match(data) use strict; use warnings; sub _equals { my $a = shift; my $b = $_[0]->[0]; return $a eq $b; } sub _regex { my $a = shift; my $b = $_[0]->[0]; return $a =~ m/$b/; } sub _in { my $a = shift; my %b = map { $_ => 1 } @_; return exists $b{$a}; } sub new { my $class = shift; my $self = {}; $self->{string} = shift; $self->{handlers} = { '==' => \&_equals, '>=' => \&_greater_or_eq, '<=' => \&_less_or_eq, '=@' => \&_in, '=~' => \&_regex, }; $self->{parsed} = 0; $self->{warnings} = []; return bless $self, $class; } # parse condition from its string version sub parse { my $self = shift; my $string = $self->{string}; return if $self->{parsed}; # cut spaces $string =~ s/^\s+//; $string =~ s/\s+$//; # get name, operator, value(s) my ($n, $o, $v) = $string =~ m/([a-zA-Z0-9_ ]+)([<>=~+\-*@]*)(.*)/; return unless $n; # cut inner spaces $n =~ s/\s+$//; $o =~ s/\s+$//; $o =~ s/^\s+//; $v =~ s/\s+$//; # split vlues my @v = split m/\s*,\s*/, $v; # assign $self->{n} = $n; $self->{o} = $o; $self->{v} = \@v; $self->{parsed}++; } # match the cond against params sub __match { my $self = shift; my $params = shift; my $name = $self->{n}; # what is the topic my $op = $self->{o}; # what op to use my $have = $self->{v}; # what we have in this step my $want = $params->{$name}; # what they want # warn if condition cannot be decided due to missing param unless ($want) { $self->warn( sprintf ( "undecided condition: %s; did you forget to specify %s?", $self->{string}, $name )); } # execute the right handler or warn it does not exist if (exists $self->{handlers}->{$op}) { return &{ $self->{handlers}->{$op} }($want, $have); } else { $self->warn( sprintf ( "unknown operator: '%s' in '%s'", $op, $self->{string} )); } } # wrapper to __match(); adds warning list sub match { my $self = shift; my $params = shift; $self->parse(); $self->{result} = $self->__match($params); return $self->{result}, $self->{warnings}; } sub warn { my $self = shift; my $text = shift; push @{$self->{warnings}}, $text; } 1;