From 7d54768cf46a7055032525695fa3da6bfa5c7631 Mon Sep 17 00:00:00 2001
From: Arne Georg Gleditsch <argggh@lxr.linpro.no>
Date: Fri, 8 Feb 2008 10:35:27 +0100
Subject: Add profiling and cache id notes to mod_perl request for logging
 purposes.

---
 lib/LXRng/ModPerl.pm | 11 +++++++++--
 lib/LXRng/Web.pm     |  8 +++++++-
 2 files changed, 16 insertions(+), 3 deletions(-)

(limited to 'lib')

diff --git a/lib/LXRng/ModPerl.pm b/lib/LXRng/ModPerl.pm
index e5e6f63..1249cb0 100644
--- a/lib/LXRng/ModPerl.pm
+++ b/lib/LXRng/ModPerl.pm
@@ -31,8 +31,15 @@ use Data::Dumper;
 sub handler {
     my ($req) = @_;
 
-    my $query = CGI->new();
-    LXRng::Web->handle($query);
+    my @tstart = times();
+    my $query  = CGI->new();
+    my $qident = LXRng::Web->handle($query);
+    my @tstop  = times();
+
+    $req->notes->add("lxr_prof" =>
+		     sprintf("u:%d, s:%d, cu:%d, cs:%d",
+			     map { 1000*($tstop[$_]-$tstart[$_]) } (0 .. 3)));
+    $req->notes->add("lxr_ident" => $qident);
 
     return Apache2::Const::OK;
 }
diff --git a/lib/LXRng/Web.pm b/lib/LXRng/Web.pm
index 59e0790..4334981 100644
--- a/lib/LXRng/Web.pm
+++ b/lib/LXRng/Web.pm
@@ -74,6 +74,7 @@ sub print_markedup_file {
 			   {'context' => $context,
 			    'dir_listing' => $markup->listing})
 	    or die $template->error();
+	return;
     }
     else {
 	# Grmble.  We assume the identifiers to markup are identical
@@ -132,6 +133,7 @@ sub print_markedup_file {
 	    }
 	    print("</span></ol></pre>\n");
 	}
+	return $shaid;
     }
 }
 
@@ -257,6 +259,7 @@ sub source {
 			    'dir_listing' => $markup->listing,
 			    'is_dir' => 1})
 	    or die $template->error();
+	return;
     }
     else {
 	my $html = '';
@@ -271,8 +274,10 @@ sub source {
 	# can't do progressive rendering of its templates, so we cheat...
 	my ($pre, $post) = split('<!--FILE_CONTENT-->', $html);
 	print($pre);
-	print_markedup_file($context, $template, $node);
+	my $id = print_markedup_file($context, $template, $node);
 	print($post);
+
+	return $id;
     }
 
     # TODO: This is potentially useful, in that it resets the stream
@@ -280,6 +285,7 @@ sub source {
     # 0.18, this seems to truncate the stream.  Not strictly needed
     # for CGI, reexamine when adapting to mod_perl.
     ## binmode(\*STDOUT, ":pop") if $gzip;
+    
 }
 
 #sub ident {
-- 
cgit v1.2.3