Rework condition caching to support nested evaluation

lib/Workflow/Condition.pm

@@ -4,10 +4,14 @@ use warnings;
 use strict;
 use base qw( Workflow::Base );
 use Carp qw(croak);
+use English qw( -no_match_vars );
+use Log::Log4perl qw( get_logger );
+use Workflow::Exception qw( workflow_error condition_error );
 
 $Workflow::Condition::CACHE_RESULTS = 1;
 $Workflow::Condition::VERSION = '1.52';
 
+my $log;
 my @FIELDS = qw( name class );
 __PACKAGE__->mk_accessors(@FIELDS);
 
@@ -25,6 +29,140 @@ sub evaluate {
     croak "Class ", ref($self), " must implement 'evaluate()'!\n";
 }
 
+
+sub evaluate_condition {
+    my ( $class, $wf, $condition_name) = @_;
+    $log ||= get_logger();
+    $wf->type;
+
+    my $factory = $wf->_factory();
+    my $orig_condition = $condition_name;
+    my $opposite       = 0;
+    my $condition;
+
+    $log->is_debug
+        && $log->debug("Checking condition $condition_name");
+
+    if ( $condition_name =~ m{ \A ! }xms ) {
+
+        # this condition starts with a '!' and is thus supposed
+        # to return the opposite of an original condition, whose
+        # name is the same except for the '!'
+        $orig_condition =~ s{ \A ! }{}xms;
+        $opposite = 1;
+        $log->is_debug
+            && $log->debug(
+            "Condition starts with a !: '$condition_name'");
+    }
+
+    local $wf->{'_condition_result_cache'} =
+        $wf->{'_condition_result_cache'} || {};
+    if ( $Workflow::Condition::CACHE_RESULTS
+         && exists $wf->{'_condition_result_cache'}->{$orig_condition} ) {
+
+        # The condition has already been evaluated and the result
+        # has been cached
+        $log->is_debug
+            && $log->debug(
+            "Condition has been cached: '$orig_condition', cached result: ",
+            $wf->{'_condition_result_cache'}->{$orig_condition}
+            );
+        if ( !$opposite ) {
+            $log->is_debug
+                && $log->debug("Opposite is false.");
+            if ( !$wf->{'_condition_result_cache'}->{$orig_condition} )
+            {
+                $log->is_debug
+                    && $log->debug("Cached condition result is false.");
+            }
+            return $wf->{'_condition_result_cache'}->{$orig_condition};
+        } else {
+
+            # we have to return an error if the original cached
+            # condition did NOT fail
+            $log->is_debug
+                && $log->debug("Opposite is true.");
+            if ( $wf->{'_condition_result_cache'}->{$orig_condition} ) {
+                $log->is_debug
+                    && $log->debug("Cached condition is true.");
+                return 0;
+            }
+            return 1;
+        }
+    } else {
+
+        # we did not evaluate the condition yet, we have to do
+        # it now
+        $condition = $wf->_factory()
+            ->get_condition( $orig_condition, $wf->type );
+        $log->is_debug
+            && $log->debug( q{Evaluating condition '},
+                            $condition->name, q{'} );
+        my $return_value;
+        eval { $return_value = $condition->evaluate($wf) };
+        if ($EVAL_ERROR) {
+
+            # Check if this is a Workflow::Exception::Condition
+            if (Exception::Class->caught('Workflow::Exception::Condition')) {
+                $wf->{'_condition_result_cache'}->{$orig_condition} = 0;
+                if ( !$opposite ) {
+                    $log->is_debug
+                        && $log->debug("condition '$orig_condition' failed due to: $EVAL_ERROR");
+                    return 0;
+                } else {
+                    $log->is_debug
+                        && $log->debug("opposite condition '$orig_condition' failed due to ' . $EVAL_ERROR");
+                    return 1;
+                }
+                # unreachable
+
+            } else {
+                $log->is_debug
+                    && $log->debug("Got uncatchable exception in condition $condition_name ");
+
+                # if EVAL_ERROR is an execption object rethrow it
+                $EVAL_ERROR->rethrow() if (ref $EVAL_ERROR ne '');
+
+                # if it is a string (bubbled up from die/croak), make an Exception Object
+                # For briefness, we just send back the first line of EVAL
+                my @t = split /\n/, $EVAL_ERROR;
+                my $ee = shift @t;
+
+                Exception::Class::Base->throw( error
+                                               => "Got unknown exception while handling condition '$condition_name' / " . $ee );
+                # unreachable
+
+            }
+            # unreachable
+
+        } else {
+            $wf->{'_condition_result_cache'}->{$orig_condition} = $return_value;
+            if ($opposite) {
+
+                $log->is_debug
+                    && $log->debug(
+                    "condition '$orig_condition' ".
+                    "did NOT fail but opposite requested");
+
+                return 0;
+            } else {
+
+                $log->is_debug &&
+                    $log->debug(
+                        "condition '$orig_condition' succeeded");
+                return $return_value;
+            }
+            # unreachable
+
+        }
+        # unreachable
+
+    }
+    # unreachable
+}
+
+
+
 1;
 
 __END__
@@ -215,6 +353,27 @@ All versions before 1.49 used a mechanism that effectively caused global
 state. To address the problems that resulted (see GitHub issues #9 and #7),
 1.49 switched to a new mechanism with a cache per workflow instance.
 
+
+=head3 $class->evaluate_condition( $WORKFLOW, $CONDITION_NAME )
+
+Users call this method to evaluate a condition; subclasses call this
+method to evaluate a nested condition.
+
+If the condition name starts with an '!', the result of the condition
+is negated. Note that a side-effect of this is that the return
+value of the condition is ignored. Only the negated boolean-ness
+is preserved.
+
+This does implement a trick that is not a convention in the underlying
+Workflow library: by default, workflow conditions throw an error when
+the condition is false and just return when the condition is true. To
+allow for counting the true conditions, we also look at the return
+value here. If a condition returns zero or an undefined value, but
+did not throw an exception, we consider it to be '1'. Otherwise, we
+consider it to be the value returned.
+
+
+
 =head1 COPYRIGHT
 
 Copyright (c) 2003-2021 Chris Winters. All rights reserved.

lib/Workflow/Condition/Nested.pm

@@ -6,84 +6,6 @@ use warnings;
 our $VERSION = '1.52';
 
 use base qw( Workflow::Condition );
-use Workflow::Factory qw( FACTORY );
-use English qw( -no_match_vars );
-use Log::Log4perl qw( get_logger );
-use Exception::Class;
-
-
-sub evaluate_condition {
-    my ( $self, $wf, $condition_name ) = @_;
-
-    my $factory;
-    if ( $wf->can('_factory') ) {
-        $factory = $wf->_factory();
-    } else {
-        $factory = FACTORY;
-    }
-
-    my $condition;
-
-    my $orig_condition = $condition_name;
-    my $opposite       = 0;
-
-    $self->log->is_debug
-        && $self->log->debug("Checking condition $condition_name");
-
-    if ( $condition_name =~ m{ \A ! }xms ) {
-
-        $orig_condition =~ s{ \A ! }{}xms;
-        $opposite = 1;
-        $self->log->is_debug
-            && $self->log->debug("Condition starts with a !: '$condition_name'");
-    }
-
-    # NOTE: CACHING IS NOT IMPLEMENTED/TESTED YET
-
-    $condition = $factory->get_condition( $orig_condition, $wf->type() );
-
-    my $result;
-    $self->log->is_debug
-        && $self->log->debug( q{Evaluating condition '}, $condition->name, q{'} );
-    eval { $result = $condition->evaluate($wf) };
-    if ($EVAL_ERROR) {
-
-        # Only stop on workflow_condition errors and bubble up anything else
-        if (!Exception::Class->caught('Workflow::Exception::Condition')) {
-            # We can use die here as it will be caught by the outer condition
-            (ref $EVAL_ERROR ne '') ? $EVAL_ERROR->rethrow() : die $EVAL_ERROR;
-        }
-
-        # TODO: We may just want to pass the error up without wrapping it...
-        $factory->{'_condition_result_cache'}->{$orig_condition} = 0;
-        if ( !$opposite ) {
-            $self->log->is_debug
-                && $self->log->debug("Condition '$condition_name' failed");
-            return 0;
-        } else {
-            $self->log->is_debug
-                && $self->log->debug(
-                "Condition '$condition_name' failed, but result is negated");
-            return 1;
-        }
-    } else {
-        $factory->{'_condition_result_cache'}->{$orig_condition} = $result
-            || 1;
-        if ($opposite) {
-            $self->log->is_debug
-                && $self->log->debug(
-                "Condition '$condition_name' OK, but result is negated");
-            return 0;
-        } else {
-            $self->log->is_debug
-                && $self->log->debug(
-                " Condition '$condition_name' OK and not negated");
-
-            # If the condition returned nothing, bump it to 1
-            return $result || 1;
-        }
-    }
-}
 
 1;
 
@@ -117,7 +39,8 @@ return the total number of successes. The result is then checked against
 the number needed, returning the boolean value needed by Workflow::State.
 
 B<Note:> This class is not used directly, but subclassed by your class
-that implements the C<evaluate()> method and calls methods declared here.
+that implements the C<evaluate()> method and calls the C<evaluate_condition>
+method to evaluate its nested conditions.
 
 =head1 SYNOPSIS
 
@@ -157,28 +80,9 @@ In workflow.xml:
 
 =cut
 
-=head1 IMPLEMENTATION DETAILS
-
-This wicked hack runs the condition half-outside of the Workflow framework.
-If the Workflow internals change, this may break.
-
-=head2 $self->evaluate_condition( $WORKFLOW, $CONDITION_NAME )
-
-The child object class that subclasses this object calls
-this method to evaluate a nested condition.
-
-If the condition name starts with an '!', the result of the condition
-is negated. Note that a side-effect of this is that the return
-value of the nested condition is ignored. Only the negated boolean-ness
-is preserved.
+=head1 AUTHORS
 
-This does implement a trick that is not a convention in the underlying
-Workflow library. By default, workflow conditions throw an error when
-the condition is false and just return when the condition is true. To
-allow for counting the true conditions, we also look at the return
-value here. If a condition returns zero or an undefined value, but
-did not throw an exception, we consider it to be '1'. Otherwise, we
-consider it to be the value returned.
+See L<Workflow>
 
 =head1 COPYRIGHT