Workflow::Condition::Evaluate - Inline condition that evaluates perl code for truth

Workflow documentation

Contained in the Workflow distribution.

Index

NAME
VERSION
SYNOPSIS
DESCRIPTION
OBJECT METHODS
SEE ALSO
COPYRIGHT
AUTHORS

Code Index:

package Workflow::Condition::Evaluate
- _init
- evaluate
__END__
EOF

NAME

Workflow::Condition::Evaluate - Inline condition that evaluates perl code for truth

VERSION

This documentation describes version 1.02 of this package

SYNOPSIS

 <state name="foo">
     <action name="foo action">
         <condition test="$context->{foo} =~ /^Pita chips$/" />

DESCRIPTION

If you've got a simple test you can use Perl code inline instead of specifying a condition class. We differentiate by the 'test' attribute -- if it's present we assume it's Perl code to be evaluated.

While it's easy to abuse something like this with:

 <condition>
   <test><![CDATA[
     if ( $context->{foo} =~ /^Pita (chips|snacks|bread)$/" ) {
          return $context->{bar} eq 'hummus';
     }
     else { ... }
     ]]>
   </test>
 </condition>

It should provide a good balance.

OBJECT METHODS

new( \%params )

One of the \%params should be 'test', which contains the text to evaluate for truth.

evaluate( $wf )

Evaluate the text passed into the constructor: if the evaluation returns a true value then the condition passes; if it throws an exception or returns a false value, the condition fails.

We use Safe to provide a restricted compartment in which we evaluate the text. This should prevent any sneaky bastards from doing something like:

 <state...>
     <action...>
         <condition test="system( 'rm -rf /' )" />

The text has access to one variable, for the moment:

$context: A hashref of all the parameters in the Workflow::Context object

SEE ALSO

Safe - From some quick research this module seems to have been packaged with core Perl 5.004+, and that's sufficiently ancient for me to not worry about people having it. If this is a problem for you shoot me an email.

COPYRIGHT

Copyright (c) 2004 Chris Winters. All rights reserved.

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

AUTHORS

Chris Winters <chris@cwinters.com>

Workflow documentation

Contained in the Workflow distribution.

package Workflow::Condition::Evaluate;

# $Id: Evaluate.pm 454 2009-01-12 10:04:02Z jonasbn $

use warnings;
use strict;
use base qw( Workflow::Condition );
use Log::Log4perl qw( get_logger );
use Safe;
use Workflow::Exception qw( condition_error configuration_error );
use English qw( -no_match_vars );

$Workflow::Condition::Evaluate::VERSION = '1.02';

my @FIELDS = qw( test );
__PACKAGE__->mk_accessors(@FIELDS);

# These get put into the safe compartment...
$Workflow::Condition::Evaluate::context = undef;

my ($log);

sub _init {
    my ( $self, $params ) = @_;
    $log ||= get_logger();

    $self->test( $params->{test} );
    unless ( $self->test ) {
        configuration_error
            "The evaluate condition must be configured with 'test'";
    }
    $log->is_info
        && $log->info("Added evaluation condition with '$params->{test}'");
}

sub evaluate {
    my ( $self, $wf ) = @_;
    $log ||= get_logger();

    my $to_eval = $self->test;
    $log->is_info
        && $log->info("Evaluating '$to_eval' to see if it returns true...");

    # Assign our local stuff to package variables...
    $Workflow::Condition::Evaluate::context = $wf->context->param;

    # Create the Safe compartment and safely eval the test...
    my $safe = Safe->new();

    ## no critic (RequireInterpolationOfMetachars)
    $safe->share('$context');
    my $rv = $safe->reval($to_eval);
    if ($EVAL_ERROR) {
        $log->error("Eval code '$to_eval' threw exception: $EVAL_ERROR");
        condition_error
            "Condition expressed in code threw exception: $EVAL_ERROR";
    }

    $log->is_debug && $log->debug("Safe eval ran ok, returned: '$rv'");
    unless ($rv) {
        condition_error "Condition expressed by test '$to_eval' did not ",
            "return a true value.";
    }
    return $rv;
}

1;

__END__