package Workflow::Condition::Evaluate;

# $Id: Evaluate.pm 285 2007-06-18 19:57:58Z jonasbn $

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

$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();
    $safe->share( '$context' );
    my $rv = $safe->reval( $to_eval );
    if ( $@ ) {
        $log->error( "Eval code '$to_eval' threw exception: $@" );
        condition_error "Condition expressed in code threw exception: $@";
    }

    $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__

=head1 NAME

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

=head1 SYNOPSIS

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

=head1 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.

=head1 OBJECT METHODS

=head3 new( \%params )

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

=head3 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 L<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:

=over 4

=item B<$context>

A hashref of all the parameters in the L<Workflow::Context> object

=back

=head1 SEE ALSO

L<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.

=head1 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.

=head1 AUTHORS

Chris Winters E<lt>chris@cwinters.comE<gt>