Add debug toolbar middleware.

If debug is enabled, using the CATALYST_DEBUG/FIXMYSTREET_APP_DEBUG
environment variables, add a debug toolbar to the output, including
request/response details and a database query log.

This uses Plack middleware, so works by switching our dev server to
use Starman with plack directly, rather than via the script runner.

We remove the GZip compression as this interferes, and take a local
copy of the QueryLog::AdoptPlack trait as it needs a tweak to work.
Make sure the CSP header is not output in debug mode, as that would
prevent the toolbar JavaScript from running.

5 files changed, 135 insertions, 83 deletions

diff --git a/perllib/Catalyst/Plugin/Compress/Gzip.pm b/perllib/Catalyst/Plugin/Compress/Gzip.pm
deleted file mode 100644
index 06532c84c..000000000
--- a/perllib/Catalyst/Plugin/Compress/Gzip.pm
+++ /dev/null
@@ -1,82 +0,0 @@
-package Catalyst::Plugin::Compress::Gzip;
-use strict;
-use warnings;
-use MRO::Compat;
-
-use Compress::Zlib ();
-
-sub finalize_headers {
-    my $c = shift;
-
-    if ( $c->response->content_encoding ) {
-        return $c->next::method(@_);
-    }
-
-    unless ( $c->response->body ) {
-        return $c->next::method(@_);
-    }
-
-    unless ( $c->response->status == 200 ) {
-        return $c->next::method(@_);
-    }
-
-    unless ( $c->response->content_type =~ /^text|xml$|javascript$/ ) {
-        return $c->next::method(@_);
-    }
-
-    my $accept = $c->request->header('Accept-Encoding') || '';
-
-    unless ( index( $accept, "gzip" ) >= 0 ) {
-        return $c->next::method(@_);
-    }
-
-
-   my $body = $c->response->body;
-   eval { local $/; $body = <$body> } if ref $body;
-   die "Response body is an unsupported kind of reference" if ref $body;
-
-    $c->response->body( Compress::Zlib::memGzip( $body ) );
-    $c->response->content_length( length( $c->response->body ) );
-    $c->response->content_encoding('gzip');
-    $c->response->headers->push_header( 'Vary', 'Accept-Encoding' );
-
-    $c->next::method(@_);
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-Catalyst::Plugin::Compress::Gzip - Gzip response
-
-=head1 SYNOPSIS
-
-    use Catalyst qw[Compress::Gzip];
-
-
-=head1 DESCRIPTION
-
-Gzip compress response if client supports it. Changed from CPAN version to
-overload finalize_headers, rather than finalize.
-
-=head1 METHODS
-
-=head2 finalize_headers
-
-=head1 SEE ALSO
-
-L<Catalyst>.
-
-=head1 AUTHOR
-
-Christian Hansen, C<ch@ngmedia.com>
-Matthew Somerville.
-
-=head1 LICENSE
-
-This library is free software . You can redistribute it and/or modify it under
-the same terms as perl itself.
-
-=cut
diff --git a/perllib/Catalyst/TraitFor/Model/DBIC/Schema/QueryLog/AdoptPlack.pm b/perllib/Catalyst/TraitFor/Model/DBIC/Schema/QueryLog/AdoptPlack.pm
new file mode 100644
index 000000000..22509568e
--- /dev/null
+++ b/perllib/Catalyst/TraitFor/Model/DBIC/Schema/QueryLog/AdoptPlack.pm
@@ -0,0 +1,128 @@
+# Local version to clone schema in enable_dbic_querylogging
+
+package Catalyst::TraitFor::Model::DBIC::Schema::QueryLog::AdoptPlack;
+our $VERSION = "0.07";
+
+use 5.008004;
+use Moose::Role;
+use Plack::Middleware::DBIC::QueryLog;
+use Scalar::Util 'blessed';
+
+with 'Catalyst::Component::InstancePerContext';
+
+requires 'storage';
+
+has show_missing_ql_warning => (is=>'rw', default=>1);
+
+sub get_querylog_from_env {
+  my ($self, $env) = @_;
+  return Plack::Middleware::DBIC::QueryLog->get_querylog_from_env($env);
+}
+
+sub infer_env_from {
+  my ($self, $ctx) = @_;
+  if($ctx->engine->can('env')) {
+    return $ctx->engine->env;
+  } elsif($ctx->request->can('env')) {
+    return $ctx->request->env;
+  } else { return }
+}
+
+sub enable_dbic_querylogging {
+  my ($self, $querylog) = @_;
+  my $clone = $self->clone;
+  $clone->storage->debugobj($querylog);
+  $clone->storage->debug(1);
+}
+
+sub die_missing_querylog {
+  shift->show_missing_ql_warning(0);
+  die <<DEAD;
+You asked me to querylog DBIC, but there is no querylog object in the Plack
+\$env. You probably forgot to enable Plack::Middleware::Debug::DBIC::QueryLog
+in your debugging panel.
+DEAD
+}
+
+sub die_not_plack {
+  die "Not a Plack Engine or compatible interface!"
+}
+
+sub build_per_context_instance {
+  my ( $self, $ctx ) = @_;
+  return $self unless blessed($ctx);
+
+  if(my $env = $self->infer_env_from($ctx)) {
+    if(my $querylog = $self->get_querylog_from_env($env)) {
+      $self->enable_dbic_querylogging($querylog);
+    } else {
+      $self->die_missing_querylog() if
+        $self->show_missing_ql_warning;
+    }
+  } else {
+    die_not_plack();
+  }
+
+  return $self;
+}
+
+1;
+
+=head1 NAME
+
+Catalyst::TraitFor::Model::DBIC::Schema::QueryLog::AdoptPlack - Use a Plack Middleware QueryLog
+
+=head1 SYNOPSIS
+
+    package MyApp::Web::Model::Schema;
+    use parent 'Catalyst::Model::DBIC::Schema';
+
+	__PACKAGE__->config({
+        schema_class => 'MyApp::Schema',
+        traits => ['QueryLog::AdoptPlack'],
+        ## .. rest of configuration
+	});
+
+=head1 DESCRIPTION
+
+This is a trait for L<Catalyst::Model::DBIC::Schema> which adopts a L<Plack>
+created L<DBIx::Class::QueryLog> and logs SQL for a given request cycle.  It is
+intended to be compatible with L<Catalyst::TraitFor::Model::DBIC::Schema::QueryLog>
+which you may already be using.
+
+It picks up the querylog from C<< $env->{'plack.middleware.dbic.querylog'} >>
+or from  C<< $env->{'plack.middleware.debug.dbic.querylog'} >>  which is generally
+provided by the L<Plack> middleware L<Plack::Middleware::Debug::DBIC::QueryLog>
+In fact you will probably use these two modules together.  Please see the documentation
+in L<Plack::Middleware::Debug::DBIC::QueryLog> for an example.
+
+PLEASE NOTE: Starting with the 0.04 version of L<Plack::Middleware::Debug::DBIC::QueryLog>
+we will canonicalize on C<< $env->{'plack.middleware.dbic.querylog'} >>.  For now
+both listed keys will work, but within a release or two the older key will warn and
+prompt you to upgrade your version of L<Plack::Middleware::Debug::DBIC::QueryLog>.
+Sorry for the trouble.
+
+=head1 SEE ALSO
+
+L<Plack::Middleware::Debug::DBIC::QueryLog>,
+L<Catalyst::TraitFor::Model::DBIC::Schema::QueryLog>,
+L<Catalyst::Model::DBIC::Schema>,
+L<Plack::Middleware::Debug>
+
+=head1 ACKNOWLEGEMENTS
+
+This code inspired from L<Catalyst::TraitFor::Model::DBIC::Schema::QueryLog>
+and the author owes a debt of gratitude for the original authors.
+
+=head1 AUTHOR
+
+John Napiorkowski, C<< <jjnapiork@cpan.org> >>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2012, John Napiorkowski
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/perllib/FixMyStreet/App.pm b/perllib/FixMyStreet/App.pm
index 2365118ea..c2d51efc5 100644
--- a/perllib/FixMyStreet/App.pm
+++ b/perllib/FixMyStreet/App.pm
@@ -25,7 +25,6 @@ use Catalyst (
     'Session::State::Cookie',    # FIXME - we're using our own override atm
     'Authentication',
     'SmartURI',
-    'Compress::Gzip',
 );
 
 extends 'Catalyst';
diff --git a/perllib/FixMyStreet/App/Model/DB.pm b/perllib/FixMyStreet/App/Model/DB.pm
index ffd867485..db8e72c27 100644
--- a/perllib/FixMyStreet/App/Model/DB.pm
+++ b/perllib/FixMyStreet/App/Model/DB.pm
@@ -5,6 +5,7 @@ use strict;
 use warnings;
 
 use FixMyStreet;
+use Catalyst::Utils;
 use Moose;
 
 with 'Catalyst::Component::InstancePerContext';
@@ -13,6 +14,10 @@ __PACKAGE__->config(
     schema_class => 'FixMyStreet::DB::Schema',
     connect_info => sub { FixMyStreet::DB->schema->storage->dbh },
 );
+__PACKAGE__->config(
+    traits => ['QueryLog::AdoptPlack'],
+)
+    if Catalyst::Utils::env_value( 'FixMyStreet::App', 'DEBUG' );
 
 sub build_per_context_instance {
     my ( $self, $c ) = @_;
diff --git a/perllib/FixMyStreet/Cobrand/FixMyStreet.pm b/perllib/FixMyStreet/Cobrand/FixMyStreet.pm
index 1052bac0e..c50721334 100644
--- a/perllib/FixMyStreet/Cobrand/FixMyStreet.pm
+++ b/perllib/FixMyStreet/Cobrand/FixMyStreet.pm
@@ -21,6 +21,8 @@ sub path_to_email_templates {
 
 sub add_response_headers {
     my $self = shift;
+    # uncoverable branch true
+    return if $self->{c}->debug;
     my $csp_nonce = $self->{c}->stash->{csp_nonce} = unpack('h*', mySociety::Random::random_bytes(16, 1));
     $self->{c}->res->header('Content-Security-Policy', "script-src 'self' www.google-analytics.com www.googleadservices.com 'unsafe-inline' 'nonce-$csp_nonce'")
 }