From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

JONASBN / Workflow-2.04 / lib / Workflow / Condition / Evaluate.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
—
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147

              
package Workflow::Condition::Evaluate;
use warnings;
use strict;
use v5.14.0;
use parent qw( Workflow::Condition );
use Safe;
use Workflow::Exception qw( configuration_error );
$Workflow::Condition::Evaluate::VERSION = '2.04';
my @FIELDS = qw( test );
__PACKAGE__->mk_accessors(@FIELDS);
# These get put into the safe compartment...
$Workflow::Condition::Evaluate::context = undef;
sub init {
    my ( $self, $params ) = @_;
    $self->SUPER::init( $params );
    $self->test( $params->{test} );
    unless ( $self->test ) {
        configuration_error
            "The evaluate condition must be configured with 'test'";
    }
    $self->log->info("Added evaluation condition with '$params->{test}'");
}
sub evaluate {
    my ( $self, $wf ) = @_;
    my $to_eval = $self->test;
    $self->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');
    local $@;
    my $rv = $safe->reval($to_eval);
    $self->log->debug( "Safe eval ran ok, returned: '",
                       ( defined $rv ? $rv : '<undef>' ),
                       "'" );
    return $rv ?
        Workflow::Condition::IsTrue->new() :
        Workflow::Condition::IsFalse->new();
}
1;
__END__
=pod
=head1 NAME
Workflow::Condition::Evaluate - Inline condition that evaluates perl code for truth
=head1 VERSION
This documentation describes version 2.04 of this package
=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
=over
=item * 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.
=back
=head1 COPYRIGHT
Copyright (c) 2004-2021 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.
Please see the F<LICENSE>
=head1 AUTHORS
Please see L<Workflow>
=cut