LP#1824184: Change potentially slow log statements to subroutines

The OpenSRF code was searched for potentially slow logging statements at
log level info or above. We then changed those logging statements to be
delayed execution subroutines. This is in reaction to LP1823338 where a
slow debug logging statement was slowing down SIP checkins even though
debug logging was not turned on.

Here is some pseudocode that shows what is being done here:

$log->debug("Some text " . $some->slow_method);

would be changed to:

$log->debug(sub{return "Some text " . $some->slow_method });

With this change, an unnamed sub is passed to the OpenSRF logger module
and it will not be executed unless the global logging level is set to
debug or higher (the slow_method will not be called unless it is needed
for that logging level).

********
If/when this is committed, please use delayed execution subroutines for
any logging statements that could be slow in the future. It is recommend
that any logging statements that do not consist entirely of quoted text
and/or already available scalar variables use delayed execution
subroutines.
********

Testing notes
-------------
[1] This patch reduced the duration of open-ils.storage.actor.user.total_owed
    calls on a test system from an average of 0.13 seconds to an overage
    of 0.009 seconds.
[2] It didn't materially affect the duration of calls to
    open-ils.actor.user.opac.vital_stats.
[3] This make sense: open-ils.storage has far more generated methods
    than open-ils.actor.
[4] There are enough instances in Evergreen of using method_lookup to find
    routines in open-ils.storage that the speed improvement may well be
    perceptible to humans, not just SIP sorters.

Signed-off-by: John Merriam <jmerriam@biblio.org>
Signed-off-by: Galen Charlton <gmc@equinoxinitiative.org>

diff --git a/src/perl/lib/OpenSRF/AppSession.pm b/src/perl/lib/OpenSRF/AppSession.pm
index ec5ebb4..1356178 100644 (file)
--- a/src/perl/lib/OpenSRF/AppSession.pm
+++ b/src/perl/lib/OpenSRF/AppSession.pm
@@ -423,7 +423,7 @@ sub kill_me {
        }
 
        $self->disconnect;
-       $logger->transport( "AppSession killing self: " . $self->session_id(), DEBUG );
+       $logger->transport(sub{return "AppSession killing self: " . $self->session_id() }, DEBUG );
        delete $_CACHE{$self->session_id};
        delete($$self{$_}) for (keys %$self);
 }
@@ -546,8 +546,8 @@ sub send {
                push @doc, $msg;
 
        
-               $logger->debug( "AppSession sending ".$msg->type." to ".$self->remote_id.
-                       " with threadTrace [".$msg->threadTrace."]");
+               $logger->debug(sub{return "AppSession sending ".$msg->type." to ".$self->remote_id.
+                       " with threadTrace [".$msg->threadTrace."]" });
 
        }
        
@@ -743,7 +743,7 @@ sub recv {
                }
        }
 
-       #$logger->debug( ref($self). " recv_queue before wait: " . $self->_print_queue(), INTERNAL );
+       #$logger->debug(sub{return ref($self). " recv_queue before wait: " . $self->_print_queue() }, INTERNAL );
 
        if( exists( $args{timeout} ) ) {
                $args{timeout} = int($args{timeout});
@@ -788,7 +788,7 @@ sub recv {
                last if (scalar(@list) >= $args{count});
        }
 
-       $logger->debug( "Number of matched responses: " . @list, DEBUG );
+       $logger->debug(sub{return "Number of matched responses: " . @list }, DEBUG );
        $self->queue_wait(0); # check for statuses
        
        return $list[0] if (!wantarray);
@@ -809,7 +809,7 @@ sub push_resend {
 
 sub flush_resend {
        my $self = shift;
-       $logger->debug( "Resending..." . @_RESEND_QUEUE, INTERNAL );
+       $logger->debug(sub{return "Resending..." . @_RESEND_QUEUE }, INTERNAL );
        while ( my $req = shift @OpenSRF::AppSession::_RESEND_QUEUE ) {
                $req->resend unless $req->complete;
        }
@@ -1028,7 +1028,7 @@ sub payload { return shift()->{payload}; }
 sub resend {
        my $self = shift;
        return unless ($self and $self->session and !$self->complete);
-       OpenSRF::Utils::Logger->debug( "I'm resending the request for threadTrace ". $self->threadTrace, DEBUG);
+       OpenSRF::Utils::Logger->debug(sub{return "I'm resending the request for threadTrace ". $self->threadTrace }, DEBUG);
        return $self->session->send('REQUEST', $self->payload, $self->threadTrace );
 }
 

diff --git a/src/perl/lib/OpenSRF/Application.pm b/src/perl/lib/OpenSRF/Application.pm
index 5995f1c..2ec87ce 100644 (file)
--- a/src/perl/lib/OpenSRF/Application.pm
+++ b/src/perl/lib/OpenSRF/Application.pm
@@ -184,9 +184,9 @@ sub handler {
                        $appreq->max_bundle_count( $coderef->max_bundle_count );
                        $appreq->max_chunk_size( $coderef->max_chunk_size );
 
-                       $log->debug( "in_request = $in_request : [" . $appreq->threadTrace."]", INTERNAL );
+                       $log->debug(sub{return "in_request = $in_request : [" . $appreq->threadTrace."]" }, INTERNAL );
                        if( $in_request ) {
-                               $log->debug( "Pushing onto pending requests: " . $appreq->threadTrace, DEBUG );
+                               $log->debug(sub{return "Pushing onto pending requests: " . $appreq->threadTrace }, DEBUG );
                                push @pending_requests, [ $appreq, \@args, $coderef ]; 
                                return 1;
                        }
@@ -263,7 +263,7 @@ sub handler {
 
                        $in_request--;
 
-                       $log->debug( "Pending Requests: " . scalar(@pending_requests), INTERNAL );
+                       $log->debug(sub{return "Pending Requests: " . scalar(@pending_requests) }, INTERNAL );
 
                        # cycle through queued requests
                        while( my $aref = shift @pending_requests ) {
@@ -303,11 +303,11 @@ sub handler {
                                        my $start = time;
                                        my $response = $aref->[2]->run( $aref->[0], @{$aref->[1]} );
                                        my $time = sprintf '%.3f', time - $start;
-                                       $log->debug( "Method duration for [".$aref->[2]->api_name." -> ".join(', ',@{$aref->[1]}).']:  '.$time, DEBUG );
+                                       $log->debug(sub{return "Method duration for [".$aref->[2]->api_name." -> ".join(', ',@{$aref->[1]}).']:  '.$time }, DEBUG );
 
                                        $appreq = $aref->[0];   
                                        $appreq->respond_complete( $response );
-                                       $log->debug( "Executed: " . $appreq->threadTrace, INTERNAL );
+                                       $log->debug(sub{return "Executed: " . $appreq->threadTrace }, INTERNAL );
 
                                } catch Error with {
                                        my $e = shift;
@@ -545,7 +545,7 @@ sub method_lookup {
        my $class = ref($self) || $self;
 
        $log->debug("Lookup of [$method] by [$class] in api_level [$proto]", DEBUG);
-       $log->debug("Available methods\n\t".join("\n\t", keys %{ $_METHODS[$proto] }), INTERNAL);
+       $log->debug(sub{return "Available methods\n\t".join("\n\t", keys %{ $_METHODS[$proto] }) }, INTERNAL);
 
        my $meth;
        if (__PACKAGE__->thunk) {
@@ -646,11 +646,11 @@ sub run {
                }
 
 
-               $log->debug("Coderef for [$$self{package}::$$self{method}] has been run", DEBUG);
+               $log->debug(sub{return "Coderef for [$$self{package}::$$self{method}] has been run" }, DEBUG);
 
                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);
+                       $log->debug(sub{return "SubRequest object is responding with : " . join(" ",$req->responses) }, DEBUG);
                        return $req->responses;
                } else {
                        $log->debug("A top level Request object is responding $resp", DEBUG) if (defined $resp);
@@ -681,7 +681,7 @@ sub run {
                        $session->finish();
                }
 
-               $log->debug( "Remote Subrequest Responses " . join(" ", $req->responses), INTERNAL );
+               $log->debug(sub{return "Remote Subrequest Responses " . join(" ", $req->responses) }, INTERNAL );
 
                return $req->responses;
        }

diff --git a/src/perl/lib/OpenSRF/DomainObject/oilsMessage.pm b/src/perl/lib/OpenSRF/DomainObject/oilsMessage.pm
index b84c80c..dc381da 100644 (file)
--- a/src/perl/lib/OpenSRF/DomainObject/oilsMessage.pm
+++ b/src/perl/lib/OpenSRF/DomainObject/oilsMessage.pm
@@ -230,8 +230,8 @@ sub handler {
        $session->last_threadTrace($tT);
        $session->session_locale($locale);
 
-       $log->debug(" Received api_level => [$api_level], MType => [$mtype], ".
-                       "from [".$session->remote_id."], threadTrace[".$self->threadTrace."]");
+       $log->debug(sub{return " Received api_level => [$api_level], MType => [$mtype], ".
+                       "from [".$session->remote_id."], threadTrace[".$self->threadTrace."]" });
 
        my $val;
        if ( $session->endpoint == $session->SERVER() ) {
@@ -320,7 +320,7 @@ sub do_client {
 
                if ($self->payload->statusCode == STATUS_OK) {
                        $session->state($session->CONNECTED);
-                       $log->debug("We connected successfully to ".$session->app);
+                       $log->debug(sub{return "We connected successfully to ".$session->app });
                        return 0;
                }
 
@@ -372,7 +372,7 @@ sub do_client {
                }
        }
 
-       $log->debug("oilsMessage passing to Application: " . $self->type." : ".$session->remote_id );
+       $log->debug(sub{return "oilsMessage passing to Application: " . $self->type." : ".$session->remote_id });
 
        return 1;
 

diff --git a/src/perl/lib/OpenSRF/EX.pm b/src/perl/lib/OpenSRF/EX.pm
index bf86bda..c1ae701 100644 (file)
--- a/src/perl/lib/OpenSRF/EX.pm
+++ b/src/perl/lib/OpenSRF/EX.pm
@@ -60,10 +60,10 @@ sub throw() {
                                $self->class->isa( "OpenSRF::EX::NOTICE" ) ||
                                $self->class->isa( "OpenSRF::EX::WARN" ) ) {
 
-               $log->debug( $self->stringify(), $log->DEBUG );
+               $log->debug(sub{return $self->stringify() }, $log->DEBUG );
        }
 
-       else{ $log->debug( $self->stringify(), $log->ERROR ); }
+       else{ $log->debug(sub{return $self->stringify() }, $log->ERROR ); }
        
        $self->SUPER::throw;
 }

diff --git a/src/perl/lib/OpenSRF/MultiSession.pm b/src/perl/lib/OpenSRF/MultiSession.pm
index 4b9a996..995c9cb 100644 (file)
--- a/src/perl/lib/OpenSRF/MultiSession.pm
+++ b/src/perl/lib/OpenSRF/MultiSession.pm
@@ -46,7 +46,7 @@ sub new {
                                1
                        );
                #print "Creating connection ".$self->{sessions}->[-1]->session_id." ...\n";
-               $log->debug("Creating connection ".$self->{sessions}->[-1]->session_id." ...");
+               $log->debug(sub{return "Creating connection ".$self->{sessions}->[-1]->session_id." ..." });
        }
 
        return $self;
@@ -200,7 +200,7 @@ sub request {
                          params => [@params]
                        };
 
-               $log->debug("Making request [$method] ".$self->running."...");
+               $log->debug(sub{return "Making request [$method] ".$self->running."..." });
 
                return $req;
        } elsif (!$self->adaptive) {
@@ -274,7 +274,7 @@ sub _session_reap {
                        push @done, $req;
 
                } else {
-                       #$log->debug("Still running ".$req->{meth}." in session ".$req->{req}->session->session_id);
+                       #$log->debug(sub{return "Still running ".$req->{meth}." in session ".$req->{req}->session->session_id });
                        push @running, $req;
                }
        }

diff --git a/src/perl/lib/OpenSRF/Server.pm b/src/perl/lib/OpenSRF/Server.pm
index 49ede59..52c53d2 100644 (file)
--- a/src/perl/lib/OpenSRF/Server.pm
+++ b/src/perl/lib/OpenSRF/Server.pm
@@ -296,7 +296,7 @@ sub run {
 sub perform_idle_maintenance {
     my $self = shift;
 
-    $chatty and $logger->internal(
+    $chatty and $logger->internal(sub{return
         sprintf(
             "server: %d idle, %d active, %d min_spare, %d max_spare in idle maintenance",
             scalar(@{$self->{idle_list}}), 
@@ -304,7 +304,7 @@ sub perform_idle_maintenance {
             $self->{min_spare_children},
             $self->{max_spare_children}
         )
-    );
+    });
 
     # spawn 1 spare child per maintenance loop if necessary
     if( $self->{min_spare_children} and
@@ -437,7 +437,7 @@ sub check_status {
 
     return unless @pids;
 
-    $chatty and $logger->internal("server: ".scalar(@pids)." children reporting for duty: (@pids)");
+    $chatty and $logger->internal(sub{return "server: ".scalar(@pids)." children reporting for duty: (@pids)" });
 
     my $child;
     my @new_actives;
@@ -453,9 +453,9 @@ sub check_status {
 
     $self->{active_list} = [@new_actives];
 
-    $chatty and $logger->internal(sprintf(
+    $chatty and $logger->internal(sub{return sprintf(
         "server: %d idle and %d active children after status update",
-            scalar(@{$self->{idle_list}}), scalar(@{$self->{active_list}})));
+            scalar(@{$self->{idle_list}}), scalar(@{$self->{active_list}})) });
 
     # some children just went from active to idle. let's see 
     # if any of them need to be killed from a previous sighup.
@@ -509,9 +509,9 @@ sub reap_children {
 
     $self->spawn_children unless $shutdown;
 
-    $chatty and $logger->internal(sprintf(
+    $chatty and $logger->internal(sub{return sprintf(
         "server: %d idle and %d active children after reap_children",
-            scalar(@{$self->{idle_list}}), scalar(@{$self->{active_list}})));
+            scalar(@{$self->{idle_list}}), scalar(@{$self->{active_list}})) });
 }
 
 # ----------------------------------------------------------------
@@ -555,7 +555,7 @@ sub spawn_child {
             push(@{$self->{idle_list}}, $child);
         }
 
-        $chatty and $logger->internal("server: server spawned child $child with ".$self->{num_children}." total children");
+        $chatty and $logger->internal(sub{return "server: server spawned child $child with ".$self->{num_children}." total children" });
 
         return $child;
 
@@ -567,7 +567,7 @@ sub spawn_child {
 
         if($self->{stderr_log}) {
 
-            $chatty and $logger->internal("server: redirecting STDERR to " . $self->{stderr_log});
+            $chatty and $logger->internal(sub{return "server: redirecting STDERR to " . $self->{stderr_log} });
 
             close STDERR;
             unless( open(STDERR, '>>' . $self->{stderr_log}) ) {

diff --git a/src/perl/lib/OpenSRF/Transport.pm b/src/perl/lib/OpenSRF/Transport.pm
index c295acd..5aeff4d 100644 (file)
--- a/src/perl/lib/OpenSRF/Transport.pm
+++ b/src/perl/lib/OpenSRF/Transport.pm
@@ -176,7 +176,7 @@ sub handler {
                } else { 
 
                        if( ! $msg->handler( $app_session ) ) { return 0; } 
-                       $logger->debug(sprintf("Response processing duration: %.3f", (time() - $start_time)));
+                       $logger->debug(sub{return sprintf("Response processing duration: %.3f", (time() - $start_time)) });
 
                }
        }

diff --git a/src/perl/lib/OpenSRF/Transport/SlimJabber/Client.pm b/src/perl/lib/OpenSRF/Transport/SlimJabber/Client.pm
index dc5a1c5..cc19698 100644 (file)
--- a/src/perl/lib/OpenSRF/Transport/SlimJabber/Client.pm
+++ b/src/perl/lib/OpenSRF/Transport/SlimJabber/Client.pm
@@ -163,7 +163,7 @@ sub initialize {
            unless ( $self->reader->connected );
 
     $self->xmpp_id("$username\@$host/$resource");
-    $logger->debug("Created XMPP connection " . $self->xmpp_id);
+    $logger->debug(sub{return "Created XMPP connection " . $self->xmpp_id });
        return $self;
 }