view release on metacpan or  search on metacpan

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

    our $TEMPLATE2;

    my $template = HTML::Template->new(scalarref        => \$TEMPLATE2 );
    $template->param(page_body => _build_content($self) );

    my $content = $template->output();

    _open_window($self, $content, $output);

    _empty_profile();
}

# _devpopup_stop : similar to _stop, but compatable with CAP:DevPopup
sub _devpopup_stop
{
    my $self = shift;
    my $output = shift;

    my $content = _build_content($self);

    $self->devpopup->add_report(
        title => 'DBI Profile',
        summary => 'DBI statement profiling',
        report => qq(
        <style type="text/css">
        tr.even{background-color:#eee}
        </style>
        <table><tbody> $content </tbody></table>
        )
    );

    _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') || 10,
        );

    my @pages;

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

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

        my @legends = map { $nodes->[$_][7] } (0 .. $#$nodes);
        my $count   = 1;
        $$page{sort}          = $sort;
        $$page{legend_loop}   = [ map { { number => $count++, legend => $_ } } @legends];
        $$page{profile_title} = _page_title($self, (%opts, sort => $sort) );
        $$page{profile_text}  = join("\n\n", map { $data->format($nodes->[$_]) } (0 .. $#$nodes));
        $$page{profile_graph} = _dbiprof_graph($self, (%opts, sort => $sort, nodes => $nodes) );

        push(@pages, $page);
    }

    our $TEMPLATE;

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

    # add full text only dump of all data (well, last 1000 queries)
    my ($nodes, $data) = _get_nodes($self, number => 1000, sort => 'count');
    $template->param('profile_full_text', join("\n\n", map { $data->format($nodes->[$_]) } (0 .. $#$nodes)) );

    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;
}

sub _open_window
{
    my ($self, $content, $output) = @_;

    my $js = qq|<script language="javascript">|;
    my $d = Data::JavaScript::jsdump( 'dbi_prof_data', [ $content ] );
    # an end script tag will mess things up... so we break the string.
    $d =~ s/<\/script>/<\/s"+"cript>/g;
    $js .= $d;
    $js   .= <<END;
  var dbi_prof_window = window.open("", "dbiprof_window_$$", "height=600,width=800,scrollbars=1,toolbars");
  dbi_prof_window.document.write(dbi_prof_data[0]);
  dbi_prof_window.document.close();
  dbi_prof_window.focus(); 
</script>

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

sub _load_graph_module
{
    my $self = shift;

    my $module = $ENV{CAP_DBIPROFILE_GRAPHMODULE};
    $module  ||= 'CGI::Application::Plugin::DBIProfile::Graph::HTML';

    eval "require $module";

    if ($@)
    {
        die "CAP::DBIProfile: Unable to load graphing module \"$module\": $@";
    }

    return $module;
}

our $TEMPLATE2 = <<END2;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
<html>

<head>
  <title>CGI::Application::Plugin::DBIProfile Profiling Screen</title>

    <style type="text/css">
        div.report { border: dotted 1px black; margin: 1em;}
        div.report h2 { color: #000; background-color: #ddd; padding:.2em; margin-top:0;}
        div.report_full, div.report_summary { padding: 0em 1em; }
        a:hover, div.report h2:hover { cursor: pointer; background-color: #eee; }
        a { text-decoration: underline }
    </style>

    <script language="javascript"><!--
        function swap(id1,id2)
        {
            var d1 = document.getElementById(id1);
            var d2 = document.getElementById(id2);
            var s = d1.style.display;
            d1.style.display = d2.style.display;
            d2.style.display = s;
        }
    // --></script>


</head>

<body onload="swap('#DBIPS_count', '#DBIPR_count');">
<div class="report">

<tmpl_var page_body>

</div>
</body></html>

END2

our $TEMPLATE = <<END;

<style type="text/css">
   .legend_header {
     background-color: #7187C7;
     color: #FFF;
   }
   .legend_odd_row {
     background-color: #FFF;
   }
   .legend_even_row {
     background-color: #EEE;
   }
</style>

<table border=0 cellspacing=0 cellpadding=0 width=100%>

<tr>
<td valign="top">

<tmpl_loop profile_pages>

  <h2 onclick="swap('#DBIPS_<tmpl_var sort>', '#DBIPR_<tmpl_var sort>');"><tmpl_var profile_title></h2>

  <div id="#DBIPS_<tmpl_var sort>" class="report_summary"></div>
  <div id="#DBIPR_<tmpl_var sort>" class="report_full" style="display:none">

    <span><tmpl_var profile_graph></span>

    <table border=0 width=100% cellspacing=0 style="margin: 5px">
    <tr>
      <td class="legend_header" align="center">#</td>
      <td class="legend_header" width="90%">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>

    <table border=0 cellspacing=0 cellpadding=0 width=100%>
    <tr>
    <td valign="top">
        <h2 onclick="swap('#DBIPS_t_<tmpl_var sort>', '#DBIPR_t_<tmpl_var sort>');">Full Text Profile Dump</h2>
        <div id="#DBIPS_t_<tmpl_var sort>" class="report_summary"></div>
        <div id="#DBIPR_t_<tmpl_var sort>" class="report_full" style="display:none">
            <span  style="white-space: pre;"><tmpl_var profile_text></span>
        </div>
    </td>
    </tr>
    </table>

  </div>

</tmpl_loop>

<!-- full dump of log -->
<h2 onclick="swap('#DBIPS_full', '#DBIPR_full');">Full Text Dump By Runtime</h2>
<div id="#DBIPS_full" class="report_summary"></div>
<div id="#DBIPR_full" class="report_full" style="display:none">
    <span  style="white-space: pre;"><tmpl_var profile_full_text></span>
</div>

</td>

</tr></table>

END



1;

__END__

=head1 NAME

CGI::Application::Plugin::DBIProfile - DBI profiling plugin

=head1 SYNOPSIS

    # Set env in apache or in perl.
    $ENV{DBI_PROFILE} = '2/CGI::Application::Plugin::DBIProfile::Driver';
    use CGI::Application::Plugin::DevPopup;
    use CGI::Application::Plugin::DBIProfile;

    The rest of your application follows
    ...

=head1 INSTALLATION

To install this module, run the following commands:

    perl Makefile.PL
    make 
    make test