view release on metacpan or  search on metacpan

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

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

use strict;
use Carp qw(carp);
use GD::Graph::bars;
use MIME::Base64 qw(encode_base64);

our $SIZE_WARNING = 1;
our $FORMAT       = 'png';
our $WIDTH        = 600;
our $HEIGHT       = 300;

# 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      => '',
        );

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

    # build the graph image
    my $graph_data;
    {
        our @BARS;
        my $graph = GD::Graph::bars->new($WIDTH, $HEIGHT);
        $graph->set(transparent      => 0,
                    bgclr            => '#FFFFFF',
                    legend_placement => 'BC',
                    x_ticks          => 0,
                    cycle_clrs       => 1,
                    bar_spacing      => 5,
                    shadow_depth     => 2,
                    dclrs            => [ map { "#$_" } @BARS ],
                   );
        $graph->set(title   => $opts{title});
        $graph->set(y_label => $opts{ylabel});
        my $gd = $graph->plot([ $opts{tags}, $opts{data} ]);
        $graph_data = $gd->png  if $FORMAT eq 'png';
        $graph_data = $gd->gif  if $FORMAT eq 'gif';
        $graph_data = $gd->jpeg if $FORMAT eq 'jpeg';
    }

    # return an inline image tag.
    my $base64 = encode_base64($graph_data);
    my $string = 'data:image/'.$FORMAT.';base64,'.$base64;
    my $l = length($string);
    if ($l > 4096 && $SIZE_WARNING) {
        carp "Image is too big (encoded length $l > 4096)";
    }
    my $content = qq(<img src="$string");
    $content .= qq( width="$WIDTH" ) if defined $WIDTH;
    $content .= qq( height="$HEIGHT" ) if defined $HEIGHT;
    $content .= '>';

    return $content;
}

1;

__END__

=head1 NAME

CGI::Application::Plugin::DBIProfile::Graph::GDGraphInline - Inlined GD Graph output for CAP:DBIProfile.

=head1 SYNOPSIS

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


=head1 DESCRIPTION

This module provides a GD::Graph::bars inlined graphing option for CAP:DBIProfile. Please note, inlined images are NOT supported by MSIE as of version 7. Mozilla, Firefox, Opera, Safari, and Konqueror are supported.

The following settings control the output:

=over

=item $CGI::Application::Plugin::DBIProfile::Graph::GDGraphInline::FORMAT

Output format. Defaults to "png". One of "png", "gif", or "jpeg".
Any GD supported output format can be easily added.

=item $CGI::Application::Plugin::DBIProfile::Graph::GDGraphInline::WIDTH