Condition.pm 1.7KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889
  1. package SugarTrail::Template::Condition;
  2. # condition
  3. # new()
  4. # parse(string)
  5. # match(data)
  6. use strict;
  7. use warnings;
  8. sub _equals {
  9. my $a = shift;
  10. my $b = $_[0]->[0];
  11. return $a eq $b;
  12. }
  13. sub _regex {
  14. my $a = shift;
  15. my $b = $_[0]->[0];
  16. return $a =~ m/$b/;
  17. }
  18. sub new {
  19. my $class = shift;
  20. my $self = {};
  21. $self->{string} = shift;
  22. $self->{handlers} = {
  23. '==' => \&_equals,
  24. '>=' => \&_greater_or_eq,
  25. '<=' => \&_less_or_eq,
  26. '=@' => \&_in,
  27. '=~' => \&_regex,
  28. };
  29. $self->{parsed} = 0;
  30. return bless $self, $class;
  31. }
  32. # parse condition from its string version
  33. sub parse {
  34. my $self = shift;
  35. my $string = $self->{string};
  36. return if $self->{parsed};
  37. # cut spaces
  38. $string =~ s/^\s+//;
  39. $string =~ s/\s+$//;
  40. # get name, operator, value(s)
  41. my ($n, $o, $v) = $string =~ m/([a-zA-Z0-9_ ]+)([<>=~+\-*@]*)(.*)/;
  42. return unless $n;
  43. # cut inner spaces
  44. $n =~ s/\s+$//;
  45. $o =~ s/\s+$//;
  46. $o =~ s/^\s+//;
  47. $v =~ s/\s+$//;
  48. # split vlues
  49. my @v = split m/\s*,\s*/, $v;
  50. # assign
  51. $self->{n} = $n;
  52. $self->{o} = $o;
  53. $self->{v} = \@v;
  54. $self->{parsed}++;
  55. }
  56. # match the cond against params
  57. sub match {
  58. my $self = shift;
  59. my $params = shift;
  60. $self->parse();
  61. my $name = $self->{n}; # what is the topic
  62. my $op = $self->{o}; # what op to use
  63. my $have = $self->{v}; # what we have in this step
  64. my $want = $params->{$name}; # what they want
  65. # execute the right handler
  66. if (exists $self->{handlers}->{$op}) {
  67. return &{ $self->{handlers}->{$op} }($want, $have);
  68. } else {
  69. helper::dmupp(bad_op=>$self);
  70. warn "unknown operator: $op\n";
  71. }
  72. }
  73. 1;