File Coverage

lib/Workflow/Condition/CheckReturn.pm
Criterion Covered Total %
statement 36 44 81.8
branch 7 14 50.0
condition n/a
subroutine 7 7 100.0
pod 1 1 100.0
total 51 66 77.2


line stmt bran cond sub pod time code
1             package Workflow::Condition::CheckReturn;
2              
3 1     1   7 use strict;
  1         3  
  1         31  
4 1     1   10 use warnings;
  1         10  
  1         42  
5              
6             our $VERSION = '1.62';
7              
8 1     1   5 use base qw( Workflow::Condition::Nested );
  1         4  
  1         114  
9 1     1   14 use Workflow::Exception qw( condition_error configuration_error );
  1         2  
  1         70  
10 1     1   7 use English qw( -no_match_vars );
  1         2  
  1         9  
11              
12             __PACKAGE__->mk_accessors( 'condition', 'operator', 'argument' );
13              
14             my %supported_ops = (
15             eq => '==',
16             lt => '<',
17             gt => '>',
18             le => '<=',
19             ge => '>=',
20             ne => '!=',
21             );
22              
23             sub _init {
24 3     3   7 my ( $self, $params ) = @_;
25              
26 3 50       8 unless ( defined $params->{condition} ) {
27 0         0 configuration_error
28             "You must specify the name of the nested condition in the parameter 'condition' for ",
29             $self->name;
30             }
31 3         8 $self->condition( $params->{condition} );
32              
33 3 50       30 unless ( defined $params->{operator} ) {
34 0         0 configuration_error "You must define the value for 'operator' in ",
35             "declaration of condition ", $self->name;
36             }
37 3         10 $self->operator( $params->{operator} );
38              
39 3 50       28 unless ( defined $params->{argument} ) {
40 0         0 configuration_error "You must define the value for 'argument' in ",
41             "declaration of condition ", $self->name;
42             }
43 3         10 $self->argument( $params->{argument} );
44             }
45              
46             sub evaluate {
47 6     6 1 12 my ( $self, $wf ) = @_;
48 6         25 my $cond = $self->condition;
49 6         87 my $op = $self->operator;
50 6         63 my $arg = $self->argument;
51              
52             # warn "DEBUG: evaluating operator '$op'";
53              
54 6         77 my $numop = $supported_ops{$op};
55 6 50       18 if ( not $numop ) {
56 0         0 configuration_error "Unsupported operator '$op'";
57             }
58              
59             # Fetch argument from context or eval, if necessary
60 6         8 my $argval;
61 6 50       36 if ( $arg =~ /^[-]?\d+$/ ) { # numeric
    0          
62 6         13 $argval = $arg;
63             } elsif ( $arg =~ /^[a-zA-Z0-9_]+$/ ) { # alpha-numeric, plus '_'
64 0         0 $argval = $wf->context->param($arg);
65             } else {
66 0         0 local $EVAL_ERROR = undef;
67 0         0 $argval = eval $arg;
68             }
69              
70 6         25 my $condval = $self->evaluate_condition( $wf, $cond );
71              
72 6         59 local $EVAL_ERROR = undef;
73 6 100       357 if ( eval "\$condval $op \$argval" ) {
74 2         11 return 1;
75             } else {
76 4         27 condition_error "Condition failed: '$condval' $op '$argval'";
77             }
78              
79 0           configuration_error
80             "Unknown error in CheckReturn.pm: cond=$cond, op=$op, arg=$arg";
81             }
82              
83             1;
84              
85             __END__
86              
87             =pod
88              
89             =head1 NAME
90              
91             Workflow::Condition::CheckReturn
92              
93             =head1 VERSION
94              
95             This documentation describes version 1.62 of this package
96              
97             =head1 DESCRIPTION
98              
99             Using nested conditions (See Workflow::Condition::Nested), this evaluates
100             a given condition and compares the value returned with a given argument.
101              
102             =head1 SYNOPSIS
103              
104             In condition.xml:
105              
106             <condition name="check_approvals" class="Workflow::Condition::CheckReturn">
107             <param name="condition" value="count_approvals" />
108             <!-- operator "ge" means: greater than or equal to -->
109             <param name="operator" value="ge" />
110             <param name="argument" value="$context->{approvals_needed}" />
111             </condition>
112              
113             In workflow.xml:
114              
115             <state name="CHECK_APPROVALS" autorun="yes">
116             <action name="null_1" resulting_state="APPROVED">
117             <condition name="check_approvals" />
118             </action>
119             <action name="null_2" resulting_state="REJECTED">
120             <condition name="!check_approvals" />
121             </action>
122             </state>
123              
124             =cut
125              
126             =head1 PARAMETERS
127              
128             The following parameters may be configured in the C<param> entity of the
129             condition in the XML configuration:
130              
131             =head2 condition
132              
133             The name of the condition to be evaluated.
134              
135             =head2 argument
136              
137             The value to compare with the given condition. This can be one of the following:
138              
139             =over
140              
141             =item Integer
142              
143             The integer value is compared with the return value of the condition.
144              
145             =item String [a-zA-Z0-9_]
146              
147             The string is interpreted as the name of a workflow context parameter. The current
148             value of that parmeter is used in the comparison.
149              
150             =item String
151              
152             Any other string is evaluated in an C<eval> block. The result should be numeric.
153              
154             =back
155              
156             =head2 operator
157              
158             The name of the comparison operator to use. Supported values are:
159              
160             'eq', 'lt', 'gt', 'le', 'ge', 'ne'
161              
162             The string names are used to simplify the notation in the XML files. The
163             above strings map to the following numeric operators internally:
164              
165             '==', '<', '>', '<=', '>=', !=
166              
167             =head1 COPYRIGHT
168              
169             Copyright (c) 2004-2023 Chris Winters. All rights reserved.
170              
171             This library is free software; you can redistribute it and/or modify
172             it under the same terms as Perl itself.
173              
174             Please see the F<LICENSE>
175              
176             =head1 AUTHORS
177              
178             Please see L<Workflow>
179              
180             =cut