simplify logging and move inline debug into plack middleware

lib/Plack/Middleware/Debug/Logger.pm

@@ -0,0 +1,45 @@
+package Plack::Middleware::Debug::Logger;
+use 5.008;
+use strict;
+use warnings;
+use parent qw(Plack::Middleware::Debug::Base);
+use Sub::Uplevel ();
+our $VERSION = '0.07';
+
+sub run {
+    my ($self, $env, $panel) = @_;
+
+    my $wrap_logger = $env->{'psgix.logger'};
+    my %output;
+    $env->{'psgix.logger'} = sub {
+        my ($args) = @_;
+        my $caller = (caller(1))[3] . '[' . (caller(0))[2] . '] ';
+        my $message = $args->{message};
+        $message =~ s/\n\s*/\n        /msxg;
+        $message =~ s/\n?\z/\n/msx;
+        $output{lc $args->{level}} ||= '';
+        $output{lc $args->{level}} .= $caller . $message;
+        if ($wrap_logger) {
+            Sub::Uplevel::uplevel 1, $wrap_logger, @_;
+        }
+    };
+
+    return sub {
+        my $res = shift;
+
+        if ($wrap_logger) {
+            $env->{'psgix.logger'} = $wrap_logger;
+        }
+        my $content = '';
+        for my $level ( qw(info debug warn error fatal) ) {
+            if ($output{$level}) {
+                $content .= "<h1 style=\"font-size: 125%\">\u$level</h1>";
+                $content .= '<div style="white-space: pre">' . $self->render_lines($output{$level}) . '</div>';
+            }
+        }
+        $panel->content($content);
+    };
+}
+
+1;
+

lib/Plack/Middleware/Debug/MySQLTrace.pm

@@ -0,0 +1,103 @@
+package Plack::Middleware::Debug::MySQLTrace;
+use 5.008;
+use strict;
+use warnings;
+use parent qw(Plack::Middleware::Debug::Base);
+use Plack::Util::Accessor qw(skip_packages);
+use Sub::Uplevel ();
+our $VERSION = '0.07';
+
+sub run {
+    my($self, $env, $panel) = @_;
+
+    my $old_trace;
+    my @output;
+    my $queries = 0;
+    if (defined &DBI::trace) {
+        $old_trace = DBI->trace;
+        open my $trace_handle, '>:via(Plack::Middleware::Debug::MySQLTrace::IO)', {
+            skip_packages => $self->skip_packages,
+            logger => sub {
+                my $sql = shift;
+                $sql =~ s/\s+\z//;
+                $sql =~ s/\A\s+//;
+                $queries++;
+                push @output, sprintf('%s - %s[%s]', $queries, (caller 1)[3], (caller 0)[2]), $sql;
+            },
+        };
+        DBI->trace('2,SQL', $trace_handle);
+    }
+    else {
+        return $panel->disable;
+    }
+
+    return sub {
+        my $res = shift;
+
+        if (defined $old_trace) {
+            DBI->trace($old_trace);
+            $panel->title('MySQL Trace');
+            $panel->nav_title('MySQL Trace');
+            $panel->nav_subtitle($queries . ' Queries');
+            $panel->content('<div style="white-space: pre; font-family: monospace">' . $self->render_list_pairs(\@output) . '</div>');
+        }
+    };
+}
+
+package Plack::Middleware::Debug::MySQLTrace::IO;
+use strict;
+use 5.008;
+
+our $VERSION = '0.01';
+
+sub PUSHED {
+    my ($class, $mode, $fh) = @_;
+    return bless {}, $class;
+}
+
+sub OPEN {
+    my ($self, $logger, $mode, $fh) = @_;
+    %$self = %$logger;
+    return 1;
+}
+
+sub WRITE {
+    my ($self, $buf, $fh) = @_;
+    if ($buf =~ /\ABinding parameters: /) {
+        my $sql = $buf;
+        $sql =~ s/\ABinding parameters: //;
+        my $depth;
+        for ( $depth = 1; caller($depth); $depth++) {
+            my $package = caller($depth);
+            next
+                if $package =~ /\ADB[ID](?:\z|::)/;
+            next
+                if $package =~ /::(?:st|db)\z/;
+            next
+                if $self->{skip_packages} && $package =~ $self->{skip_packages};
+            last;
+        }
+
+        Sub::Uplevel::uplevel $depth + 1, $self->{logger}, $sql;
+    }
+    return length($buf);
+}
+
+sub CLOSE {
+    my $self = shift;
+    return 0;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Plack::Middleware::Debug::MySQLTrace - DBI MySQL trace panel
+
+=head1 SEE ALSO
+
+L<Plack::Middleware::Debug>
+
+=cut