File Coverage

blib/lib/Dancer/Plugin/DebugToolbar.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package Dancer::Plugin::DebugToolbar;

=head1 NAME

Dancer::Plugin::DebugToolbar - A debugging toolbar for Dancer web applications

=cut

use strict;

use Dancer ':syntax';
use Dancer::App;
use Dancer::Plugin;
use Dancer::Route::Registry;
use File::ShareDir;
use File::Spec::Functions qw(catfile);
use Module::Loaded;
use Scalar::Util qw(blessed looks_like_number refaddr);
use Tie::Hash::Indexed;
use Time::HiRes qw(time);

our $VERSION = '0.016';

# Distribution-level shared data directory
my $dist_dir = File::ShareDir::dist_dir('Dancer-Plugin-DebugToolbar');

# Information to be displayed to the user
my %time_start;
my $views;
my $dbi_trace;
my $dbi_queries;

my $route_pattern;
my $filter_registered;

my $settings = plugin_setting;

# Are we on?
if (!$settings->{enable}) {
    return 1;
}

# Default settings

if (!defined $settings->{path_prefix}) {
    # Default path prefix
    $settings->{path_prefix} = '/dancer-debug-toolbar';
}

if (!defined $settings->{show}) {
    # By default, we show data and routes
    $settings->{show} = {
        data => 1,
        routes => 1
    };
}

my $path_prefix = $settings->{path_prefix};
# Need leading slash
if ($path_prefix !~ m!^/!) {
    $path_prefix = '/' . $path_prefix;
}

if ($settings->{show}->{database}) {
    require Dancer::Plugin::DebugToolbar::DBI;
}

sub _ordered_hash (%) {
    tie my %hash => 'Tie::Hash::Indexed';
    %hash = @_;
    \%hash
}

sub _wrap_data {
    my ($var, $options, $parent_refs) = @_;
    my $ret = {};

    $parent_refs = {} unless defined $parent_refs;

    if (UNIVERSAL::isa($var, "ARRAY")) {
        if (!$parent_refs->{refaddr($var)}) {
            $parent_refs->{refaddr($var)} = 1;

            $ret->{'type'} = 'list';
            $ret->{'value'} = _ordered_hash();
            my $i = 0;

            # List array members
            foreach my $item (@$var) {
                $ret->{'value'}->{$i++} = _wrap_data($item, $options,
                    $parent_refs);
            }

            delete $parent_refs->{refaddr($var)};
        }
        else {
            # Cyclic reference
            $ret->{type} = 'perl/cyclic-ref';
        }

        $ret->{'short_value'} = 'ARRAY';
    }
    elsif (UNIVERSAL::isa($var, "HASH")) {
        if (!$parent_refs->{refaddr($var)}) {
            $parent_refs->{refaddr($var)} = 1;

            $ret->{'type'} = 'map';
            $ret->{'value'} = _ordered_hash();

            foreach my $name ($options->{sort_keys} ? sort keys %$var :
                keys %$var)
            {
                $ret->{'value'}->{$name} = _wrap_data($var->{$name}, $options,
                    $parent_refs);
            }

            if (my $class = blessed($var)) {
                # Blessed hash
                $ret->{'short_value'} = {
                    html => '' .
                        '
122
                        '">' . $class . ''
                };
            }
            else {
                $ret->{'short_value'} = 'HASH';
            }

            delete $parent_refs->{refaddr($var)};
        }
        else {
            # Cyclic reference
            $ret->{type} = 'perl/cyclic-ref';
        }
    }
    elsif (looks_like_number($var)) {
        # Number
        $ret->{'type'} = 'number';
        $ret->{'value'} = $var;
    }
    elsif (defined $var) {
        # String
        $ret->{'type'} = 'string';
        $ret->{'value'} = '"' . $var . '"';
    }
    elsif (!defined $var) {
        # Undefined
        $ret->{'type'} = 'perl/undefined';
    }
    else {
        $ret->{'type'} = '';
        $ret->{'value'} = $var;
    }

    return $ret;
}

{
    my $original = {};

    no strict 'refs';

    # Override the render method of all loaded Dancer::Template::* modules
    foreach my $module (keys %INC) {
        if ($module =~ m{^Dancer/Template/}) {
            $module =~ s{/}{::}g;
            $module =~ s/\.pm$//;

            # Save the original render method
            $original->{$module . '::render'} = \&{$module . '::render'};

            *{$module . '::render'} = sub {
                my ($self, $template, $tokens) = @_;

                if (ref $template) {
                    # $template is a reference to a string with the template
                    # contents
                    # TODO: Consider getting a substring of template contents
                    $template = 'REF';
                }
                elsif (index($template, setting('views')) == 0) {
                    # If $template is a file under the application's views
                    # directory, strip off the directory
                    $template = substr($template, length(setting('views')));
                    $template =~ s{^/}{};
                }

                # Strip off "Dancer::Template::" to get just the name of the
                # template engine
                (my $engine = blessed($self)) =~ s{.*::}{};

                push(@$views, {
                    'template' => $template,
                    'engine' => $engine,
                    'tokens' => _wrap_data($tokens, { sort_keys => 1 })
                });

                return &{$original->{blessed($self) . '::render'}}(@_);
            };
        }
    }
}

before sub {
    return if request->path_info =~ $route_pattern;

    my $request_id = request->path_info . time;
    request->{_debug}->{id} = $request_id;

    $time_start{$request_id} = time;

    # Clear collected views data
    $views = [];

    if ($settings->{show}->{database}) {
        Dancer::Plugin::DebugToolbar::DBI::reset();
    }
};

my $after_filter = sub {
    my $response = shift;
    my $content = $response->content;
    my $status = $response->status;

    return if $status < 200 || $status == 204 || $status == 304;
    return if $response->content_type !~ m!^(?:text/html|application/xhtml\+xml)!;
    return if request->path_info =~ $route_pattern;

    my $request_id = request->{_debug}->{id};
    return if !$request_id;

	my $time_elapsed = time - $time_start{$request_id};

    #
    # Get routes
    #
    my $routes = Dancer::App->current->registry->routes();

    my $all_routes = {};
    my $matching_routes = {};

    foreach my $method (keys %$routes) {
        $all_routes->{uc $method} = [];
        $matching_routes->{uc $method} = [];

        foreach my $route (@{$routes->{$method}}) {
            # Exclude our own route used to access the toolbar JS/CSS files
            next if ($route->{'pattern'} eq $route_pattern);

            my $route_info = {};
            my $route_data = _ordered_hash(
                'Pattern' => qq{$route->{'pattern'}},
                'Compiled regexp' => qq{$route->{'_compiled_regexp'}}
            );

            # Is this a matching route?
            if (lc request->method eq $method && request->path_info =~
                    $route->{'_compiled_regexp'})
            {
                $route_data->{'Match data'} = $route->match_data;
            }

            $route_info = {
                'pattern' => qq{$route->{'pattern'}},
                'matching' => exists $route_data->{'Match data'},
                'data' => _wrap_data($route_data)
            };

            # Add the route to the list of all routes
            push(@{$all_routes->{uc $method}}, $route_info);

            if ($route_info->{matching}) {
                # Add the route to the list of matching routes
                push(@{$matching_routes->{uc $method}}, $route_info);
            }
        }
    }

    my $config = config;
    my $request = request;
    my $session;
    my $vars = vars;

    # Session must be defined in the configuration, otherwise it doesn't exist
    if (config->{'session'}) {
        $session = session;
    }

    # Remove private members from request object
    for my $name (keys %$request) {
        delete $request->{$name} if ($name =~ /^_/);
    }

    my $show = $settings->{'show'};

    if ($show->{'database'}) {
        # Get the collected DBI trace and queries
        $dbi_trace = Dancer::Plugin::DebugToolbar::DBI::get_dbi_trace();
        $dbi_queries = Dancer::Plugin::DebugToolbar::DBI::get_dbi_queries();
    }

    my $toolbar_cfg = {
        'toolbar' => {
            'logo' => 1,
            'buttons' => _ordered_hash(
                'time' => {
                    'text' => sprintf("%.04fs", $time_elapsed)
                },
                'data' => $show->{'data'} ? {
                    'text' => 'data'
                } : undef,
                'routes' => $show->{'routes'} ? {
                    'text' => 'routes'
                } : undef,
                'templates' => $show->{'templates'} ? {
                    'text' => 'templates'
                } : undef,
                'database' => $show->{'database'} ? {
                    'text' => 'database'
                } : undef,
                'align' => 1,
                'close' => 1
            )
        },
        'screens' => {
            'data' => {
                'title' => 'Data',
                'pages' => _ordered_hash(
                    'config' => {
                        'name' => 'config',
                        'type' => 'data-structure/perl',
                        'data' => _wrap_data($config, { sort_keys => 1 })
                    },
                    'request' => {
                        'name' => 'request',
                        'type' => 'data-structure/perl',
                        'data' => _wrap_data($request, { sort_keys => 1 })
                    },
                    'session' => $session ? {
                        'name' => 'session',
                        'type' => 'data-structure/perl',
                        'data' => _wrap_data($session, { sort_keys => 1 })
                    } : 1,
                    'vars' => {
                        'name' => 'vars',
                        'type' => 'data-structure/perl',
                        'data' => _wrap_data($vars, { sort_keys => 1 })
                    }
                )
            },
            'routes' => {
                'title' => 'Routes',
                'pages' => _ordered_hash(
                    'all' => {
                        'type' => 'routes',
                        'routes' => $all_routes
                    },
                    'matching' => {
                        'type' => 'routes',
                        'routes' => $matching_routes
                    }
                )
            },
            # Templates
            'templates' => {
                'title' => 'Templates',
                'pages' => _ordered_hash(
                    'templates' => {
                        'type' => 'templates',
                        'views' => $views
                    }
                )
            },
            # Database
            'database' => $show->{'database'} ? {
                'title' => 'Database',
                'pages' => _ordered_hash(
                    'trace' => {
                        'type' => 'text',
                        'content' => $dbi_trace
                    },
                    'queries' => {
                        'type' => 'database-queries',
                        'queries' => $dbi_queries
                    }
                )
            } : undef
        }
    };

    my $html;
    open(F, "<", catfile($dist_dir, 'debugtoolbar', 'html',
        'debugtoolbar.html'));
    {
        local $/;
        $html = ;
    }
    close(F);

    # Encode the configuration as JSON
    my $cfg_json = to_json($toolbar_cfg);

    # Do some replacements so that the JSON data can be made into a JS string
    # wrapped in single quotes
    $cfg_json =~ s!\\!\\\\!gm;
    $cfg_json =~ s!\n!\\\n!gm;
    $cfg_json =~ s!'!\\'!gm;

    $html =~ s/%DEBUGTOOLBAR_CFG%/$cfg_json/m;

    my $uri_base = request->uri_base . $path_prefix;
    $html =~ s/%BASE%/$uri_base/mg;

    $content =~ s!(?=\s*\s*$)!$html!msi;

    $response->content($content);
};

after sub {
    # Try to get the $after_filter sub executed as the very last filter (after
    # all the other filters defined in the application)
    return if $filter_registered;
    after $after_filter;
    $filter_registered = 1;
};

$route_pattern = qr(^$path_prefix/.*);

get $route_pattern => sub {
    (my $path = request->path_info) =~ s!^$path_prefix/!!;

    send_file(catfile($dist_dir, 'debugtoolbar', split(m!/!, $path)),
        system_path => 1);
};

register_plugin;

1; # End of Dancer::Plugin::DebugToolbar
__END__