Condition.pm 2.5KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121
  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 _in {
  19. my $a = shift;
  20. my %b = map { $_ => 1 } @_;
  21. return exists $b{$a};
  22. }
  23. sub new {
  24. my $class = shift;
  25. my $self = {};
  26. $self->{string} = shift;
  27. $self->{handlers} = {
  28. '==' => \&_equals,
  29. '>=' => \&_greater_or_eq,
  30. '<=' => \&_less_or_eq,
  31. '=@' => \&_in,
  32. '=~' => \&_regex,
  33. };
  34. $self->{parsed} = 0;
  35. $self->{warnings} = [];
  36. return bless $self, $class;
  37. }
  38. # parse condition from its string version
  39. sub parse {
  40. my $self = shift;
  41. my $string = $self->{string};
  42. return if $self->{parsed};
  43. # cut spaces
  44. $string =~ s/^\s+//;
  45. $string =~ s/\s+$//;
  46. # get name, operator, value(s)
  47. my ($n, $o, $v) = $string =~ m/([a-zA-Z0-9_ ]+)([<>=~+\-*@]*)(.*)/;
  48. return unless $n;
  49. # cut inner spaces
  50. $n =~ s/\s+$//;
  51. $o =~ s/\s+$//;
  52. $o =~ s/^\s+//;
  53. $v =~ s/\s+$//;
  54. # split vlues
  55. my @v = split m/\s*,\s*/, $v;
  56. # assign
  57. $self->{n} = $n;
  58. $self->{o} = $o;
  59. $self->{v} = \@v;
  60. $self->{parsed}++;
  61. }
  62. # match the cond against params
  63. sub __match {
  64. my $self = shift;
  65. my $params = shift;
  66. my $name = $self->{n}; # what is the topic
  67. my $op = $self->{o}; # what op to use
  68. my $have = $self->{v}; # what we have in this step
  69. my $want = $params->{$name}; # what they want
  70. # warn if condition cannot be decided due to missing param
  71. unless ($want) {
  72. $self->warn( sprintf (
  73. "undecided condition: %s; did you forget to specify %s?",
  74. $self->{string},
  75. $name
  76. ));
  77. }
  78. # execute the right handler or warn it does not exist
  79. if (exists $self->{handlers}->{$op}) {
  80. return &{ $self->{handlers}->{$op} }($want, $have);
  81. } else {
  82. $self->warn( sprintf (
  83. "unknown operator: '%s' in '%s'",
  84. $op,
  85. $self->{string}
  86. ));
  87. }
  88. }
  89. # wrapper to __match(); adds warning list
  90. sub match {
  91. my $self = shift;
  92. my $params = shift;
  93. $self->parse();
  94. $self->{result} = $self->__match($params);
  95. return $self->{result}, $self->{warnings};
  96. }
  97. sub warn {
  98. my $self = shift;
  99. my $text = shift;
  100. push @{$self->{warnings}}, $text;
  101. }
  102. 1;