File Coverage

lib/Workflow/Condition/Evaluate.pm
Criterion Covered Total %
statement 37 39 94.8
branch 6 8 75.0
condition n/a
subroutine 9 9 100.0
pod 1 1 100.0
total 53 57 92.9


line stmt bran cond sub pod time code
1              
2             use warnings;
3 21     21   641 use strict;
  21         38  
  21         675  
4 21     21   102 use base qw( Workflow::Condition );
  21         37  
  21         611  
5 21     21   102 use Log::Log4perl qw( get_logger );
  21         44  
  21         2313  
6 21     21   147 use Safe;
  21         57  
  21         155  
7 21     21   11567 use Workflow::Exception qw( condition_error configuration_error );
  21         311391  
  21         1464  
8 21     21   203 use English qw( -no_match_vars );
  21         37  
  21         1386  
9 21     21   117  
  21         38  
  21         140  
10             $Workflow::Condition::Evaluate::VERSION = '1.60';
11              
12             my @FIELDS = qw( test );
13             __PACKAGE__->mk_accessors(@FIELDS);
14              
15             # These get put into the safe compartment...
16             $Workflow::Condition::Evaluate::context = undef;
17              
18             my ( $self, $params ) = @_;
19              
20 22     22   171 $self->test( $params->{test} );
21             unless ( $self->test ) {
22 22         93 configuration_error
23 22 50       220 "The evaluate condition must be configured with 'test'";
24 0         0 }
25             $self->log->info("Added evaluation condition with '$params->{test}'");
26             }
27 22         306  
28             my ( $self, $wf ) = @_;
29              
30             my $to_eval = $self->test;
31 59     59 1 158 $self->log->info("Evaluating '$to_eval' to see if it returns true...");
32              
33 59         266 # Assign our local stuff to package variables...
34 59         846 $Workflow::Condition::Evaluate::context = $wf->context->param;
35              
36             # Create the Safe compartment and safely eval the test...
37 59         6584 my $safe = Safe->new();
38              
39             $safe->share('$context');
40 59         461 my $rv = $safe->reval($to_eval);
41             if ($EVAL_ERROR) {
42 59         55349 condition_error
43 59         3421 "Condition expressed in code threw exception: $EVAL_ERROR";
44 59 50       39389 }
45 0         0  
46             $self->log->debug( "Safe eval ran ok, returned: '",
47             ( defined $rv ? $rv : '<undef>' ),
48             "'" );
49 59 100       641 unless ($rv) {
50             condition_error "Condition expressed by test '$to_eval' did not ",
51             "return a true value.";
52 59 100       8780 }
53 37         304 return $rv;
54             }
55              
56 22         110 1;
57              
58              
59             =pod
60              
61             =head1 NAME
62              
63             Workflow::Condition::Evaluate - Inline condition that evaluates perl code for truth
64              
65             =head1 VERSION
66              
67             This documentation describes version 1.60 of this package
68              
69             =head1 SYNOPSIS
70              
71             <state name="foo">
72             <action name="foo action">
73             <condition test="$context->{foo} =~ /^Pita chips$/" />
74              
75             =head1 DESCRIPTION
76              
77             If you've got a simple test you can use Perl code inline instead of
78             specifying a condition class. We differentiate by the 'test' attribute
79             -- if it's present we assume it's Perl code to be evaluated.
80              
81             While it's easy to abuse something like this with:
82              
83             <condition>
84             <test><![CDATA[
85             if ( $context->{foo} =~ /^Pita (chips|snacks|bread)$/" ) {
86             return $context->{bar} eq 'hummus';
87             }
88             else { ... }
89             ]]>
90             </test>
91             </condition>
92              
93             It should provide a good balance.
94              
95             =head1 OBJECT METHODS
96              
97             =head3 new( \%params )
98              
99             One of the C<\%params> should be 'test', which contains the text to
100             evaluate for truth.
101              
102             =head3 evaluate( $wf )
103              
104             Evaluate the text passed into the constructor: if the evaluation
105             returns a true value then the condition passes; if it throws an
106             exception or returns a false value, the condition fails.
107              
108             We use L<Safe> to provide a restricted compartment in which we
109             evaluate the text. This should prevent any sneaky bastards from doing
110             something like:
111              
112             <state...>
113             <action...>
114             <condition test="system( 'rm -rf /' )" />
115              
116             The text has access to one variable, for the moment:
117              
118             =over 4
119              
120             =item B<$context>
121              
122             A hashref of all the parameters in the L<Workflow::Context> object
123              
124             =back
125              
126             =head1 SEE ALSO
127              
128             =over
129              
130             =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.
131              
132             =back
133              
134             =head1 COPYRIGHT
135              
136             Copyright (c) 2004-2022 Chris Winters. All rights reserved.
137              
138             This library is free software; you can redistribute it and/or modify
139             it under the same terms as Perl itself.
140              
141             Please see the F<LICENSE>
142              
143             =head1 AUTHORS
144              
145             Please see L<Workflow>
146              
147             =cut