From 5c14727fd1896c48f0f646e1e2944a08841cc7e5 Mon Sep 17 00:00:00 2001
From: Pragmatic Software <pragma78@gmail.com>
Date: Tue, 20 May 2014 10:17:01 +0000
Subject: [PATCH] Add SQLite logger and profiler functionality

---
 PBot/MessageHistory_SQLite.pm | 14 ++++++++-
 PBot/SQLiteLogger.pm          | 55 +++++++++++++++++++++++++++++++++++
 PBot/SQLiteLoggerLayer.pm     | 38 ++++++++++++++++++++++++
 PBot/VERSION.pm               |  4 +--
 4 files changed, 108 insertions(+), 3 deletions(-)
 create mode 100644 PBot/SQLiteLogger.pm
 create mode 100644 PBot/SQLiteLoggerLayer.pm

diff --git a/PBot/MessageHistory_SQLite.pm b/PBot/MessageHistory_SQLite.pm
index f262e3ce..508adebb 100644
--- a/PBot/MessageHistory_SQLite.pm
+++ b/PBot/MessageHistory_SQLite.pm
@@ -31,8 +31,10 @@ sub initialize {
   $self->{new_entries} = 0;
 
   $self->{pbot}->{registry}->add_default('text', 'messagehistory', 'sqlite_commit_interval', 30);
+  $self->{pbot}->{registry}->add_default('text', 'messagehistory', 'sqlite_debug',           $conf{sqlite_debug} // 0);
 
   $self->{pbot}->{registry}->add_trigger('messagehistory', 'sqlite_commit_interval', sub { $self->sqlite_commit_interval_trigger(@_) });
+  $self->{pbot}->{registry}->add_trigger('messagehistory', 'sqlite_debug',           sub { $self->sqlite_debug_trigger(@_) });
 
   $self->{pbot}->{timer}->register(
     sub { $self->commit_message_history },
@@ -46,6 +48,12 @@ sub sqlite_commit_interval_trigger {
   $self->{pbot}->{timer}->update_interval('messagehistory_sqlite_commit_interval', $newvalue);
 }
 
+sub sqlite_debug_trigger {
+  my ($self, $section, $item, $newvalue) = @_;
+  $self->{dbh}->trace($self->{dbh}->parse_trace_flags("SQL|$newvalue")) if defined $self->{dbh};
+  
+}
+
 sub begin {
   my $self = shift;
 
@@ -54,7 +62,11 @@ sub begin {
   $self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", { RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1 }) or die $DBI::errstr; 
 
   eval {
-    #$self->{dbh}->trace($self->{dbh}->parse_trace_flags('SQL|1|test'));
+    my $sqlite_debug = $self->{pbot}->{registry}->get_value('messagehistory', 'sqlite_debug');
+    use PBot::SQLiteLoggerLayer;
+    use PBot::SQLiteLogger;
+    open $self->{trace_layer}, '>:via(PBot::SQLiteLoggerLayer)', PBot::SQLiteLogger->new(pbot => $self->{pbot});
+    $self->{dbh}->trace($self->{dbh}->parse_trace_flags("SQL|$sqlite_debug"), $self->{trace_layer});
 
     $self->{dbh}->do(<<SQL);
 CREATE TABLE IF NOT EXISTS Hostmasks (
diff --git a/PBot/SQLiteLogger.pm b/PBot/SQLiteLogger.pm
new file mode 100644
index 00000000..0376a0d2
--- /dev/null
+++ b/PBot/SQLiteLogger.pm
@@ -0,0 +1,55 @@
+# File: SQLiteLogger
+# Author: pragma_
+#
+# Purpose: Logs SQLite trace messages to Logger.pm with profiling of elapsed
+# time between messages.
+
+package PBot::SQLiteLogger;
+
+use strict;
+use warnings;
+
+use Carp;
+use Time::HiRes qw(gettimeofday);
+
+sub new
+{
+  my ($class, %conf) = @_;
+  my $self = {};
+  $self->{buf} = '';
+  $self->{timestamp} = gettimeofday;
+  $self->{pbot} = $conf{pbot} // Carp::croak("Missing pbot reference in " . __FILE__);
+  return bless $self, $class;
+}
+
+sub log
+{
+  my $self = shift;
+  $self->{buf} .= shift;
+
+  # DBI feeds us pieces at a time, so accumulate a complete line
+  # before outputing
+  if($self->{buf} =~ tr/\n//) {
+    $self->log_message;
+    $self->{buf} = '';
+  }
+}
+
+sub log_message {
+  my $self = shift;
+  my $now = gettimeofday;
+  my $elapsed = $now - $self->{timestamp};
+  $elapsed = sprintf '%10.4f', $elapsed;
+  $self->{pbot}->{logger}->log("$elapsed : $self->{buf}");
+  $self->{timestamp} = $now;
+}
+
+sub close {
+  my $self = shift;
+  if($self->{buf}) {
+    $self->log_message;
+    $self->{buf} = '';
+  }
+}
+
+1;
diff --git a/PBot/SQLiteLoggerLayer.pm b/PBot/SQLiteLoggerLayer.pm
new file mode 100644
index 00000000..d15aff88
--- /dev/null
+++ b/PBot/SQLiteLoggerLayer.pm
@@ -0,0 +1,38 @@
+# File: SQLiteLoggerLayer
+# Author: pragma_
+#
+# Purpose: PerlIO::via layer to log DBI trace messages
+
+package PBot::SQLiteLoggerLayer;
+
+use strict;
+use warnings;
+
+sub PUSHED
+{
+  my ($class, $mode, $fh) = @_;
+  my $logger;
+  return bless \$logger, $class;
+}
+
+sub OPEN {
+  my ($self, $path, $mode, $fh) = @_;
+  # $path is actually our logger object
+  $$self = $path;
+  return 1;
+}
+
+sub WRITE
+{
+  my ($self, $buf, $fh) = @_;
+  $$self->log($buf);
+  return length($buf);
+}
+
+sub CLOSE {
+  my $self = shift;
+  $$self->close();
+  return 0;
+}
+
+1;
diff --git a/PBot/VERSION.pm b/PBot/VERSION.pm
index 9ec8492b..cabbb704 100644
--- a/PBot/VERSION.pm
+++ b/PBot/VERSION.pm
@@ -13,8 +13,8 @@ use warnings;
 # These are set automatically by the build/commit script
 use constant {
   BUILD_NAME     => "PBot",
-  BUILD_REVISION => 594,
-  BUILD_DATE     => "2014-05-19",
+  BUILD_REVISION => 596,
+  BUILD_DATE     => "2014-05-20",
 };
 
 1;