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