RSS Git Download  Clone
Raw Blame History
package LIMS::Local::DBIProfile;

# ripped guts out of CAP::DBIProfile to load underneath footer instead of pop-up

use strict;

use CGI::Application::Plugin::DBIProfile::Driver;
use CGI::Application::Plugin::DBIProfile::Data;

use IO::Scalar;
use HTML::Template;

use vars qw($VERSION);

our $VERSION = '0.05';

sub import {
    my $c = scalar caller;

    if ($ENV{CAP_DBIPROFILE_EXEC}) {
        $c->add_callback( 'prerun', \&_start );
        $c->add_callback( 'postrun', \&_stop );
    }
}

# _start : clear anything that is currently stored (incase stuff ran without us)
sub _start {
    my $self = shift;

    _empty_profile();
}

# _stop : standalone report output, called in postrun hook.
sub _stop {
    my ($self, $output) = @_;

    # header handling borrowed from CAP::DevPopup
    return unless $self->header_type eq 'header';       # don't operate on redirects or 'none'

    my %props = $self->header_props;

    my ($type) = grep /type/i, keys %props;

    return if defined $type and                         # no type defaults to html, so we have work to do.
      $props{$type} !~ /html/i;                         # else skip any other types.


    $$output =~ s/<\/html>//; # or get errors about content after end of html

	# output is LIMS output to template!!
	$$output .= _build_content($self) . '</html>';

    _empty_profile();
}

# clear profile if running in per-request (unless running in per-process)
sub _empty_profile {
    unless ($ENV{CAP_DBIPROFILE_PERPROCESS}) {
        CGI::Application::Plugin::DBIProfile::Driver->empty();
    }
}

# main content builder. Builds datasets, and pushs to template.
sub _build_content {
    my $self = shift;

    my %opts = (
        number  => $self->param('__DBIProfile_number') || 100,
        );

    my @pages;

    # for each sort type, add a graph in a hidden div
    foreach my $sort (qw(total)) # shortest longest count
    {
        my $page = {};

        my ($nodes, $data) = _get_nodes($self, (%opts, sort => $sort) );

        my @legends = map { $nodes->[$_][7] } (0 .. $#$nodes);
        my $count   = 1;
        $$page{legend_loop}   = [ map { { number => $count++, legend => $_ } } @legends];

        push(@pages, $page);
    }

    our $TEMPLATE;

    my $template = HTML::Template->new(scalarref => \$TEMPLATE, loop_context_vars => 1, );
    $template->param(profile_pages => \@pages);

    return $template->output();
}

# wrapper to ease getting data from DBI
sub _get_nodes {
    my $self = shift;
    my %opts = @_;

    my $sort   = $opts{sort};
    my $number = $opts{number};

    my $profile_data = CGI::Application::Plugin::DBIProfile::Driver->get_current_stats();

    my $fh = new IO::Scalar \$profile_data;

    my $data = CGI::Application::Plugin::DBIProfile::Data->new(File => $fh);
    $data->sort(field => $sort);
    $data->exclude(key1 => qr/^\s*$/);

    # get list trimmed to number
    my $nodes  = $data->nodes();
    $number    = @$nodes if $number > @$nodes;
    $#$nodes   = $number - 1;

    return wantarray ? ($nodes, $data) : $nodes;
}

our $TEMPLATE = qq!
<div class="report">
	<tmpl_loop profile_pages>

	<h2>QueryLog</h2>

	<table border=0 cellspacing=0 style="margin: 5px">
		<tr>
			<td class="legend_header" align="right">#</td>
			<td class="legend_header">SQL Statement</td>
		</tr>

		<tmpl_loop legend_loop>

		<tr>
			<td <tmpl_if __odd__>class="legend_odd_row"<tmpl_else>class="legend_even_row"</tmpl_if>><tmpl_var number></td>
			<td <tmpl_if __odd__>class="legend_odd_row"<tmpl_else>class="legend_even_row"</tmpl_if>><tmpl_var legend></td>
		 </tr>

		</tmpl_loop>
	</table>

	</tmpl_loop>
</div>
!;

1;