view release on metacpan or  search on metacpan

lib/CGI/Application/Plugin/DevPopup/Timing.pm  view on Meta::CPAN

package CGI::Application::Plugin::DevPopup::Timing;
{
  $CGI::Application::Plugin::DevPopup::Timing::VERSION = '1.08';
}

use strict;
use base qw/Exporter/;
use Time::HiRes qw/gettimeofday tv_interval/;
my $start = [gettimeofday];

sub import
{
    my $c = scalar caller;
    $c->add_callback( 'devpopup_report', \&_timer_report );
    $c->new_hook('devpopup_addtiming');
    $c->add_callback( 'devpopup_addtiming', \&_add_time );
    foreach my $stage (qw/ init prerun load_tmpl /)
    {
        $c->add_callback( $stage, sub { _add_time( shift(), $stage, @_ ) } );
    }
    goto &Exporter::import;
}

sub _timer_report
{
    my $app = shift;

    my $self = _new_or_self($app);
    unshift @$self, { dec => 'start', tod => $start };
    _add_time( $app, 'postrun' );
    $app->devpopup->add_report(
        title   => 'Timings',
        summary => 'Total runtime: ' . tv_interval( $self->[1]{tod}, $self->[-1]{tod} ) . ' sec.',
        report  => '<style>
            th { text-align:left; border-bottom:solid 1px black; }
            </style>' .
            'Application started at: ' . scalar( gmtime( $start->[0] ) ) . ' GMT<br/>' .
            '<table width="100%"><tr><th>From</th><th>To</th><th>Time taken</th></tr>' .
            join(
              $/,
              map {
                my $time = tv_interval( $self->[$_]{tod}, $self->[ $_ + 1 ]{tod} );
                "<tr><td>$self->[$_]{desc}</td><td>$self->[ $_ + 1 ]{desc}</td><td>$time sec.</td></tr>"
              } ( 1 .. $#$self - 1 )
            )
            . '</table>'
    );
}

sub _add_time
{
    my $app   = shift;
    my $stage = shift;
    $stage .= '(' . $_[-1] . ')' if $stage =~ /load_tmpl/;

    my $self = _new_or_self($app);
    push @$self, { desc => $stage, tod => [gettimeofday] };
}

sub _new_or_self
{
    my $app  = shift;
    my $self = $app->param('__CAP_DEVPOPUP_TIMER');
    unless ($self)
    {
        $self = bless [], __PACKAGE__;
        $app->param( '__CAP_DEVPOPUP_TIMER' => $self );
    }
    return $self;
}

1;    # End of CGI::Application::Plugin::DevPopup::Timing

__END__

=head1 NAME

CGI::Application::Plugin::DevPopup::Timing - show timing information about cgiapp stages

=head1 VERSION

version 1.08

=head1 SYNOPSIS