sugar-trail/lib/SugarTrail/Template/Condition.pm

package SugarTrail::Template::Condition;
# condition
# new()
# parse(string)
# match(data)

use strict;
use warnings;

sub _equals {
    my $a = shift or return;
    my $b = $_[0]->[0];
    return $a eq $b;
}

sub _regex {
    my $a = shift or return;
    my $b = $_[0]->[0];
    return $a =~ m/$b/;
}

sub _in {
    my $a = shift or return;
    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;