package DBLog;

sub new {
    my $self = {
        queries => [],
        req_count => pop
    };

    return bless $self, shift;
}

    sub log {
        my $self = shift;
        my $string = shift;

        $self->{_buf} .= $string unless $string =~ /mysql.xs/;

        #return if $self->{_buf} =~ /mysql.xs/;

    #
    # DBI feeds us pieces at a time, so accumulate a complete line
    # before outputing
    #
        push(@{$self->{queries}},"Request [$$self{req_count}] At " . scalar localtime(). ':'. $self->{_buf}. "\n<br/>")  and
        $self->{_buf} = ''
            if $self->{_buf}=~tr/\n//;
    }

    sub close {
        my $self = shift;
    }

    1;

Request At Sun Jun 28 06:46:15 2015: <- trace('SQL', GLOB(0x7fc9d4896a30))= ( 1 ) [1 items] at dblog.pl line 21 
Request At Sun Jun 28 06:46:15 2015: <- do('INSERT INTO test (name) VALUES ('one')')= ( 1 ) [1 items] at dblog.pl line 40 
Request At Sun Jun 28 06:46:15 2015: <- do('INSERT INTO test (name) VALUES ('another_one')')= ( 1 ) [1 items] at dblog.pl line 46 
Request At Sun Jun 28 06:46:20 2015: <- do('INSERT INTO test (name) VALUES ('last_one')')= ( 1 ) [1 items] at dblog.pl line 53 

# Automatically enables "strict", "warnings", "utf8" and Perl 5.10 features

use Mojolicious::Lite;
use DBI;
use PerlIO::via::DBLog;
use DBLog;

helper db => sub {
    my $self = shift;
    
    return $self->{dbh} if $self->{dbh};
    
    my $dsn = "dbi:SQLite:dbname=joy";
    
    $self->stash("dblog") // $self->stash("dblog", DBLog->new($self->req_count));


    open(my $fh, '>:via(DBLog)', $self->stash("dblog")) or die;
    
    my $dbh = DBI->connect($dsn);
    
    $dbh->trace('SQL', $fh);
    
    $self->stash("fh", $fh);
    
    return $self->{dbh} = $dbh;
};

# Route with placeholder
get '/' => sub {
    my $c   = shift;
    
    $c->db->do("INSERT INTO test (name) VALUES ('one')");
    
    $c->render(text => $c->print_log);
};

get '/delay/:waittime' => sub {
    my $c = shift->render_later;
    
    $c->db->do("INSERT INTO test (name) VALUES ('one')");

    $c->delay(
      sub {
        my ($delay) = @_;
    
        $c->db->do("INSERT INTO test (name) VALUES ('another_one')");
    
        Mojo::IOLoop->timer($c->param('waittime') => $delay->begin);
      },
      sub {
        my ($delay, $err, $res) = @_;
    
        $c->db->do("INSERT INTO test (name) VALUES ('last_one')");
    
        $c->render(text => $c->print_log);
      }
    );
};

helper req_count => sub {
    state $count = 0;

    ++$count;
};

helper print_log => sub {
  my $self = shift;

  my $text = '';

  my $dblog = $self->stash("dblog");

  foreach my $log(@{$dblog->{queries}}) {
    $text = $text . "$log\n";
  }

  return $text;
};

# app->db->do("CREATE TABLE test (name VARCHAR NOT NULL, quantity INTEGER NOT NULL DEFAULT 0)");

# Start the Mojolicious command system
app->start;

[bpm@Orfgum] c:~/playground>DBI_TRACE=1 /opt/perl dblog.pl daemon
    DBI 1.633-nothread default trace level set to 0x0/1 (pid 44635 pi 0) at DBI.pm line 294 via dblog.pl line 4
[Sun Jun 28 06:45:40 2015] [info] Listening at "http://*:3000"
Server available at http://127.0.0.1:3000
[Sun Jun 28 06:45:47 2015] [debug] Your secret passphrase needs to be changed
[Sun Jun 28 06:45:47 2015] [debug] GET "/delay/5"
[Sun Jun 28 06:45:47 2015] [debug] Routing to a callback
    -> DBI->connect(dbi:SQLite:dbname=joy, , ****)
    -> DBI->install_driver(SQLite) for darwin perl=5.020002 pid=44635 ruid=503 euid=503
       install_driver: DBD::SQLite version 1.48 loaded from /opt/perl-5.20.2/lib/site_perl/5.20.2/darwin-2level/DBD/SQLite.pm
    <- install_driver= DBI::dr=HASH(0x7fc9d6c597e0)
    <- default_user(undef, undef, ...)= ( undef undef ) [2 items] at DBI.pm line 669
    <- connect('dbname=joy', undef, ...)= ( DBI::db=HASH(0x7fc9d6c59e70) ) [1 items] at DBI.pm line 681
    <- STORE('PrintError', 1)= ( 1 ) [1 items] at DBI.pm line 733
    <- STORE('AutoCommit', 1)= ( 1 ) [1 items] at DBI.pm line 733
    <- STORE('Username', undef)= ( 1 ) [1 items] at DBI.pm line 736
    <- connected('dbi:SQLite:dbname=joy')= ( undef ) [1 items] at DBI.pm line 743
    <- connect= DBI::db=HASH(0x7fc9d6c59e70)
    <- STORE('dbi_connect_closure', CODE(0x7fc9d6c59678))= ( 1 ) [1 items] at DBI.pm line 752
[Sun Jun 28 06:45:47 2015] [debug] Nothing has been rendered, expecting delayed response
[Sun Jun 28 06:45:52 2015] [debug] 200 OK (5.014261s, 0.199/s)
[Sun Jun 28 06:45:57 2015] [debug] GET "/delay/5"
[Sun Jun 28 06:45:57 2015] [debug] Routing to a callback
[Sun Jun 28 06:45:57 2015] [debug] Nothing has been rendered, expecting delayed response
[Sun Jun 28 06:46:02 2015] [debug] 200 OK (5.007930s, 0.200/s)
[Sun Jun 28 06:46:10 2015] [debug] GET "/"
[Sun Jun 28 06:46:10 2015] [debug] Routing to a callback
[Sun Jun 28 06:46:10 2015] [debug] 200 OK (0.002080s, 480.769/s)
[Sun Jun 28 06:46:15 2015] [debug] GET "/delay/5"
[Sun Jun 28 06:46:15 2015] [debug] Routing to a callback
[Sun Jun 28 06:46:15 2015] [debug] Nothing has been rendered, expecting delayed response
[Sun Jun 28 06:46:20 2015] [debug] 200 OK (5.009508s, 0.200/s)