File Coverage

blib/lib/Dancer/Plugin/TimeRequests.pm

Criterion	Covered	Total	%
statement	21	39	53.8
branch	0	8	0.0
condition			n/a
subroutine	7	8	87.5
pod			n/a
total	28	55	50.9

package Dancer::Plugin::TimeRequests;

use strict;
use Dancer::Plugin;
use Dancer qw(:syntax);
use HTML::Table;
use List::Util;
use List::MoreUtils;
use Time::HiRes;

our $VERSION = '0.06';

=head1 NAME

Dancer::Plugin::TimeRequests - log how long requests take and which routes are slow

=head1 DESCRIPTION

A simple Dancer plugin to log how long each request took to process, and also to
gather stats on the average response time for each route - so you can see at a
glance which routes are taking longer than you'd like, therefore where you ought
to start looking to improve performance.

Provides a statistics page giving you a list of your routes, along with their
response times.


=head1 SYNOPSIS

In your Dancer app, load this module:

    use Dancer::Plugin::TimeRequests;

Then, when your app is logging in debug mode, log messages will be generated
showing how logn each request took:

    Request to /foo completed in 4.0011 seconds in ....

To see which routes are slow, hit the URL C.

=cut

my %request_times;

hook before => sub {
    my $route_handler = shift;
    var current_handler => $route_handler;
    var request_start_time => Time::HiRes::time();
};

hook after => sub {
    Dancer::Logger::debug(sprintf "Request to %s completed in %.4f seconds",
        request->path,
        Time::HiRes::time() - vars->{request_start_time}
    );
    push @{ $request_times{ vars->{current_handler} } },
        Time::HiRes::time() - vars->{request_start_time};
};

get '/plugin-timerequests' => sub {
    # Get the list of routes, and for each one, match up the coderef with our
    # recorded times, and add the timing info, so we can then sort routes by
    # average execution time to produce the output
    my $routes = _get_routes();
    for my $route (@$routes) {
        my $route_times = $request_times{ $route->{route} };
        next unless defined $route_times && scalar @$route_times;

        my ($min, $max) = List::MoreUtils::minmax(@$route_times);
        $route->{times} = {
            avg => List::Util::sum(@$route_times) / @$route_times,
            min => $min,
            max => $max,
        };
    }

    # Now, we can loop through all routes, slowest first, and output the timing
    # info
    my $table = HTML::Table->new;
    $table->addRow('Route pattern', 'Average', 'Best', 'Worst');
    $table->setRowHead(1);
    for my $route (
        sort { $b->{times}{avg} <=> $a->{times}{avg} }
        grep { exists $_->{times} } @$routes
    ) {
        next unless exists $route->{times};
        my $times = $route->{times};
        $table->addRow(
            $route->{pattern},
            map { sprintf '%.3f', $_ || 0 } @$times{qw(avg min max)},
        );
    }
    return $table->getTable;

};

# Fetch all routes defined.  (Loosely based on code lovingly stolen with no
# shame from Dancer::Plugin::SiteMap - cheers James Ronan (JNRONAN)
# Returns an arrayref of hashrefs describing all routes (with keys pattern
# and handler)
sub _get_routes {
    my $version = (exists &dancer_version) ? int( dancer_version() ) : 1;
    my @apps    = ($version == 2) ? @{ runner->server->apps }
                                  : Dancer::App->applications;

    my @routes;
    for my $app ( @apps ) {
        my $app_routes = ($version == 2) ? $app->routes
                                         : $app->{registry}->{routes};

        for my $route_type (keys %$app_routes) {
            for my $route (@{ $app_routes->{$route_type} }) {
                my ($pattern, $handler);
                if ($version == 2) {
                    $pattern = $route->spec_route;
                    $handler = $route->handler;
                } else {
                    $pattern = $route->pattern;
                    $handler = $route->code;
                }
                push @routes, {
                    route   => $route,
                    pattern => $pattern,
                    handler => $handler,
                };
            }
        }
    }
    debug "list of routes being returned:", \@routes;
    return \@routes;
}


=head1 AUTHOR

David Precious, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Dancer::Plugin::TimeRequests


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

Copyright 2011 David Precious.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.


=cut

1; # End of Dancer::Plugin::TimeRequests