libcgi-application-plugin-dbiprofile-perl 0.07-1 / usr / share / perl5 / CGI / Application / Plugin / DBIProfile / Graph / HTML.pm

package CGI::Application::Plugin::DBIProfile::Graph::HTML;

use strict;
use HTML::Template;
use List::Util qw(max);

# setup colors, generated by
# http://wellstyled.com/tools/colorscheme/index-en.html
our @BARS = qw(  2856E0 8DA6F0  C5D1F7  445896  222C4B  687AB0  9FA9C8
                 FFAB2E FFD596  FFEACB  AA854D  554227  BFA071  DFCDB1 );

sub build_graph
{
    my $proto = shift;
    my $class = ref($proto) || $proto;

    my %opts = @_;

    #my $self = { };
    #bless $self, $class;


    $opts{data} ||= [];

    our @BARS;
    my @bars = map { "#$_" } @BARS;

    my $stmt_count = @{$opts{data}};
    my $title = "Top $stmt_count statements"; # by total runtime
    my $tag = 1;
    my $tags = [ map { $tag++ } @{$opts{data}} ];

    my %defs = (
        tags        => $tags,
        data        => [],
        title       => $title,
        ylabel      => '',
        barlength   => 150,
        barwidth    => 10,
        barcolors   => \@bars,
        );

    # merge options with defaults.
    %opts = (%defs, map { $_ => $opts{$_} }
                    grep { defined $opts{$_} }
                    keys %opts );

    # rotate ylabel
    $opts{ylabel} = join '&nbsp;<br>&nbsp;', split(//, $opts{ylabel});

    # get max value from dataset (XXX doesn't support negative values)
    my $maxval = max(@{$opts{data}}) || 1;
    # ratio of barlenth to values
    my $ratio = $opts{barlength} / $maxval;
    # all bar lengths
    my @barlength = map { $_ || 1 }
                    map { sprintf('%0.0f', ($_ * $ratio)) }
                    @{$opts{data}};

    # build data for HTML::Template
    my $cols = [];
    for (my $i=0; $i<@barlength; $i++) {
        push(@$cols, {
            tag         => $opts{tags}->[$i],
            value       => $opts{data}->[$i],
            barlength   => $barlength[$i],
            barwidth    => $opts{barwidth},
            barcolor    => $opts{barcolors}[ $i % scalar @{$opts{barcolors}} ],
            });
    }


    my $TEMPLATE = <<TMPL;
<table cellpadding="3">
<tr>
<td bgcolor="black">
<table cellspacing="0" cellpadding="2" border="0" bgcolor="white" width="100%" width="100%">
<tr><td><span class="htg_title"><tmpl_var title></span></td></tr>
</table>
<table cellspacing="0" cellpadding="2" border="0" bgcolor="white" width="100%">
<tr>
    <td valign="middle" align="center"><tmpl_var ylabel></td>
    <tmpl_loop cols>
        <td valign="bottom" align="center">
        <font size="-2"><tmpl_var value></font><br>
        <table cellspacing="0" cellpadding="0" border="0" bgcolor="<tmpl_var barcolor>">
        <tr><td width="<tmpl_var barwidth>" height="<tmpl_var barlength>" align="center" valign="bottom"></td></tr>
        </table>
        </td>
    </tmpl_loop>
</tr>
<tr>
    <td></td>
    <tmpl_loop cols>
        <td valign="bottom" align="center">
        <font size="-2"><tmpl_var tag></font>
        </td>
    </tmpl_loop>
</tr>
</table>
</td>
</table>
TMPL

    my $t = HTML::Template->new(scalarref         => \$TEMPLATE,
                                loop_context_vars => 1,
                                die_on_bad_params => 0, );
    $t->param('title'   => $opts{title});
    $t->param('ylabel'  => $opts{ylabel});
    $t->param('cols'    => $cols);

    return $t->output;
}

1;

__END__

=head1 NAME

CGI::Application::Plugin::DBIProfile::Graph::HTML - VERY basic pure html vertical bar graphing for CAP:DBIProfile.

=head1 SYNOPSIS

    # in httpd.conf
    SetVar CAP_DBIPROFILE_GRAPHMODULE CGI::Application::Plugin::DBIProfile::Graph::HTML
    PerlSetVar CAP_DBIPROFILE_GRAPHMODULE CGI::Application::Plugin::DBIProfile::Graph::HTML


=head1 DESCRIPTION

This module is provided as a basic implementation of graphing for CAP:DBIProfile. It can be used as an example to develop other, more sophisticated, graphing solutions.

=head1 GRAPH PLUGIN DEVELOPMENT

The graphing plugin must have a method called "build_graph", which must accept options as a hash.

It should return a scalar or scalar ref holding the HTML output needed to generate your graph.

The following options will be passed to the "build_graph" method:

=over

=item self

The cgiapp object.

=item mode_param

$self->mode_param - the runmode variable used to determine runmode (useful for creating links back to ourselves).

=item title

A textual title for your graph. You don't have to use this, but is there if you want it.

=item ylabel

Label for values we're graphing. Either "Count" or "Seconds".

=item data

An array of the datapoints to graph.

=item tags

Labels for each datapoint which match the labels that will be used on the sql statement list (1 to however many items there are).

=back

The easiest graphs to implement are fully inline - ie. it doesn't need to make any external calls (no <image> or <embed> tags and such). CGI::Application::Plugin::DBIProfile::Graph::HTML is an example of this. Other possible candidates are Plotr and Open Flash Chart (using js interface to populate data).

Another inline solution is to use the <img src="data:uri"> scheme. An example of this can be found in L<CGI::Application::Plugin::DBIProfile::Graph::GDGraphInline>. Please note, this isn't supported under MSIE.

In order to generate a graph that isn't inline, you'll need to pass the data to be graphed with your call to the external object. For example, if you want to use GDGraph, you could create a separate cgi script that returns graphs based on params passed to it, and return an approapriate image tag to from your graphing module. For example:

    <img src="/cgi-bin/graph.pl?data=20,14,42&tags=1,2,3">

Another way, would be to add a runmode in a CGI::Application "init" hook, and pass that runmode in a link back to the same script, and include your graph module in our script with a use statement. An example of this can be found in L<CGI::Application::Plugin::DBIProfile::Graph::SVGTT>.


=head1 REQUIREMENTS

    L<HTML::Template>

=head1 SEE ALSO

    L<CGI::Application::Plugin::DBIProfile>
    L<CGI::Application::Plugin::DBIProfile::Graph::GDGraphInline>
    L<CGI::Application::Plugin::DBIProfile::Graph::SVGTT>

=head1 AUTHOR

    Joshua I Miller, L<unrtst@cpan.org>

=head1 COPYRIGHT & LICENSE

Copyright 2007 Joshua Miller, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.


=cut