From 9d106aef9ab0a8d5af75977ffb4cc5f8f3fe5c79 Mon Sep 17 00:00:00 2001
From: Mike Rylander <mrylander@gmail.com>
Date: Thu, 25 Aug 2016 17:42:31 -0400
Subject: [PATCH] LP#1631522: Dispatch mode for method_lookup subrequests

There is a pattern in the wild of using OpenSRF's method_lookup() facility
to decide between one of several local methods when delegating to pre-existing
logic.  Often times, we want to simply hand control over to another method,
but the output of a subrequest's run() is an array of results.  The caller has
to know if, and how, to restructure the result for the client.

Instead, we can now call dispatch() instead of run() and have OpenSRF session
control completely passed to the delegate code.  This way, the delegate code
need not know anything about its caller, and vice versa.

Signed-off-by: Mike Rylander <mrylander@gmail.com>
Signed-off-by: Galen Charlton <gmc@esilibrary.com>
---
 src/perl/lib/OpenSRF/AppSession.pm  | 31 ++++++++++++++++++++++++++---
 src/perl/lib/OpenSRF/Application.pm |  9 ++++++++-
 2 files changed, 36 insertions(+), 4 deletions(-)

diff --git a/src/perl/lib/OpenSRF/AppSession.pm b/src/perl/lib/OpenSRF/AppSession.pm
index ba3aa54b..158513bf 100644
--- a/src/perl/lib/OpenSRF/AppSession.pm
+++ b/src/perl/lib/OpenSRF/AppSession.pm
@@ -1135,29 +1135,54 @@ sub gather {
 
 
 package OpenSRF::AppSubrequest;
+use base 'OpenSRF::AppRequest';
 
 sub respond {
 	my $self = shift;
 	return if $self->complete;
 
 	my $resp = shift;
+    return $self->SUPER::respond($resp) if $self->respond_directly;
+
 	push @{$$self{resp}}, $resp if (defined $resp);
 }
 
 sub respond_complete {
 	my $self = shift;
+    return $self->SUPER::respond_complete(@_) if $self->respond_directly;
 	$self->respond(@_);
 	$self->complete(1);
 }
 
 sub new {
-	my $class = shift;
-	$class = ref($class) || $class;
-	return bless({complete => 0, resp => [], @_}, $class);
+    my $class = shift;
+    $class = ref($class) || $class;
+    my $self = bless({
+        complete        => 0,
+        respond_directly=> 0,  # use the passed session directly (RD mode)
+        resp            => [],
+        threadTrace     => 0,  # needed for respond in RD mode
+        max_chunk_count => 0,  # needed for respond in RD mode
+        max_chunk_size  => 0,  # needed for respond in RD mode
+        current_chunk   => [], # needed for respond_complete in RD mode
+        @_
+    }, $class);
+    if ($self->session) {
+        # steal the thread trace from the parent session for RD mode
+        $self->{threadTrace} = $self->session->session_threadTrace || $self->session->last_threadTrace;
+    }
+    return $self;
 }
 
 sub responses { @{$_[0]->{resp}} }
 
+sub respond_directly {
+	my $x = shift;
+	my $s = shift;
+	$x->{respond_directly} = $s if (defined $s);
+	return $x->session && $x->{respond_directly};
+}
+
 sub session {
 	my $x = shift;
 	my $s = shift;
diff --git a/src/perl/lib/OpenSRF/Application.pm b/src/perl/lib/OpenSRF/Application.pm
index 9a958e0b..5d01cb5d 100644
--- a/src/perl/lib/OpenSRF/Application.pm
+++ b/src/perl/lib/OpenSRF/Application.pm
@@ -576,6 +576,13 @@ sub method_lookup {
 	return $meth;
 }
 
+sub dispatch {
+	my $self = shift;
+	$log->debug("Creating a dispatching SubRequest object", DEBUG);
+    my $req = OpenSRF::AppSubrequest->new( session => $self->session, respond_directly => 1 );
+    return $self->run($req,@_);
+}
+
 sub run {
 	my $self = shift;
 	my $req = shift;
@@ -627,7 +634,7 @@ sub run {
 
 		$log->debug("Coderef for [$$self{package}::$$self{method}] has been run", DEBUG);
 
-		if ( ref($req) and UNIVERSAL::isa($req, 'OpenSRF::AppSubrequest') ) {
+		if ( ref($req) and UNIVERSAL::isa($req, 'OpenSRF::AppSubrequest') and !$req->respond_directly ) {
 			$req->respond($resp) if (defined $resp);
 			$log->debug("SubRequest object is responding with : " . join(" ",$req->responses), DEBUG);
 			return $req->responses;
-- 
2.43.2