CGI-Application-Plugin-DBIProfile-0.07/0000755000076400007640000000000011276104343020241 5ustar tandersontandersonCGI-Application-Plugin-DBIProfile-0.07/lib/0000755000076400007640000000000011276104343021007 5ustar tandersontandersonCGI-Application-Plugin-DBIProfile-0.07/lib/CGI/0000755000076400007640000000000011276104343021411 5ustar tandersontandersonCGI-Application-Plugin-DBIProfile-0.07/lib/CGI/Application/0000755000076400007640000000000011276104343023654 5ustar tandersontandersonCGI-Application-Plugin-DBIProfile-0.07/lib/CGI/Application/Plugin/0000755000076400007640000000000011276104343025112 5ustar tandersontandersonCGI-Application-Plugin-DBIProfile-0.07/lib/CGI/Application/Plugin/DBIProfile/0000755000076400007640000000000011276104343027031 5ustar tandersontandersonCGI-Application-Plugin-DBIProfile-0.07/lib/CGI/Application/Plugin/DBIProfile/Graph/0000755000076400007640000000000011276104343030072 5ustar tandersontandersonCGI-Application-Plugin-DBIProfile-0.07/lib/CGI/Application/Plugin/DBIProfile/Graph/HTML/0000755000076400007640000000000011276104343030636 5ustar tandersontanderson././@LongLink0000000000000000000000000000014600000000000011566 Lustar rootrootCGI-Application-Plugin-DBIProfile-0.07/lib/CGI/Application/Plugin/DBIProfile/Graph/HTML/Horizontal.pmCGI-Application-Plugin-DBIProfile-0.07/lib/CGI/Application/Plugin/DBIProfile/Graph/HTML/Horizontal.p0000644000076400007640000000675311276104123033157 0ustar tandersontandersonpackage CGI::Application::Plugin::DBIProfile::Graph::HTML::Horizontal; ############################################################################### # Required inclusions. ############################################################################### use strict; use warnings; use HTML::Template; use List::Util qw(max); ############################################################################### # Set up the colours we use for the bar graphs and the row backgrounds. ############################################################################### my @COLOURS = qw( 2856E0 8DA6F0 C5D1F7 445896 222C4B 687AB0 9FA9C8 FFAB2E FFD596 FFEACB AA854D 554227 BFA071 DFCDB1 ); my @ROW_BGS = qw( FFFFFF EEEEFF ); ############################################################################### # Subroutine: build_graph($self, %opts) # Parameters: $self - CAP::DBIProfile object # %opts - Graphing options ############################################################################### # Builds a horizontal bar graph based on the provided '%opts', and returns the # HTML for that graph back to the caller. ############################################################################### sub build_graph { my ($self, %opts) = @_; my $data = $opts{'data'}; my $tags = $opts{'tags'}; # calculate widths for the bar graphs my $max = max( @{$data} ) || 1; my @widths = map { ($_ / $max) * 300 } @{$data}; # assemble data set for HTML::Template my $cols = [ map { { 'width' => $widths[$_], 'value' => $data->[$_], 'tag' => $tags->[$_], 'colour' => $COLOURS[ $_ % scalar @COLOURS ], 'row_bg' => $ROW_BGS[ $_ % scalar @ROW_BGS ], } } (0 .. $#widths) ]; # template body my $body = q{ ">
; width: px;"> 
}; # generate report using HTML::Template my $tmpl = HTML::Template->new( die_on_bad_params => 1, loop_context_vars => 1, scalarref => \$body, ); $tmpl->param('cols', $cols); return $tmpl->output(); } 1; =head1 NAME CGI::Application::Plugin::DBIProfile::Graph::HTML::Horizontal - Horizontal bar graph for CAP::DBIProfile =head1 SYNOPSIS # In startup.pl, or your CGI::Application class BEGIN { $ENV{'CAP_DBIPROFILE_GRAPHMODULE'} = 'CGI::Application::Plugin::DBIProfile::Graph::HTML::Horizontal'; }; =head1 DESCRIPTION C implements a basic/simple horizontal bar graph for C. =head1 AUTHOR Graham TerMarsch (cpan@howlingfrog.com) =head1 COPYRIGHT Copyright (C) 2007, Graham TerMarsch. All Rights Reserved. This is free software; you can redistribute it and/or modify it under the same license as Perl itself. =head1 SEE ALSO L, L. =cut CGI-Application-Plugin-DBIProfile-0.07/lib/CGI/Application/Plugin/DBIProfile/Graph/HTMLBarGraph.pm0000644000076400007640000000630611276104123032604 0ustar tandersontandersonpackage CGI::Application::Plugin::DBIProfile::Graph::HTMLBarGraph; use strict; use HTML::Template; use HTML::BarGraph; # NOTE: HTML::BarGraph is a little broken on its pure HTML output. # if you have issues, try changing the "bartype" to "pixel", and # setup the pixel directory ("/dbiprofile_images") in your webroot. # NOTE: HTML::BarGraph is also pure broken.. can't call graph more # than once, cause your maxval scaling will stick! sub build_graph { my $proto = shift; my $class = ref($proto) || $proto; my %opts = @_; #my $self = { }; #bless $self, $class; $opts{data} ||= []; 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 = ( direction => 'v', graphminsize => 50, bartype => 'html', # pixel or html pixeldir => '/dbiprofile_images', pixelfmt => 'PNG', barlength => 150, barwidth => 10, #baraspect => 0.5, colors => ["#7187C7"], # this is color per-dataset. data => [ ], tags => $tags, setspacer => 0, #highlighttag => undef, #highlightpos => [], addalt => 1, showaxistags => 1, showvalues => 1, valuesuffix => '', # s valueprefix => '', bordertype => 'flat', # reised or flat bordercolor => 'black', borderwidth => '3', bgcolor => 'white', textcolor => 'black', title => $title, titlecolor => 'black', titlealign => 'center', fontface => 'Verdana,Arial,San-Serif', xlabel => '', ylabel => 'Seconds', xlabelalign => 'center', ylabelalign => 'middle', labeltextcolor => 'black', labelbgcolor => '#aaaaaa', ); %defs = (%defs, %opts); return HTML::BarGraph::graph(%defs); } 1; __END__ =head1 NAME CGI::Application::Plugin::DBIProfile::Graph::HTMLBarGraph - If it weren't for HTML::BarGraph bugs, this would work. =head1 DO NOT USE THIS This is provided because I had it done, and it provides another example, but there are bugs in HTML::BarGraph. If HTML::BarGraph ever gets fixed, this will start to work correctly. The problem is its use of globals to track things like $maxval, which throws off scaling of the graph for subsequent calls to graph(). =head1 BUGS HTML::BarGraph is not mod_perl safe. It has globals that track, for instance, $maxval. That doesn't get reset accross calls to graph(), so whatever your largest value graphed is, that will set the scale of all graphs to come. Actually, it's not even single process safe... you can't make more than one call to graph(). =head1 SEE ALSO L =head1 AUTHOR Joshua I Miller, L =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 CGI-Application-Plugin-DBIProfile-0.07/lib/CGI/Application/Plugin/DBIProfile/Graph/GDGraphInline.pm0000644000076400007640000001070411276104123033041 0ustar tandersontandersonpackage 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( =item L =back =head1 SEE ALSO =over =item L =item L =back =head1 AUTHOR Joshua I Miller, L =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 CGI-Application-Plugin-DBIProfile-0.07/lib/CGI/Application/Plugin/DBIProfile/Graph/SVGTT.pm0000644000076400007640000001123011276104123031330 0ustar tandersontandersonpackage CGI::Application::Plugin::DBIProfile::Graph::SVGTT; use strict; use CGI(); use SVG::TT::Graph::Bar; our $WIDTH = 600; our $HEIGHT = 300; sub import { my $c = scalar caller; $c->add_callback('init', \&_add_runmode); } sub _add_runmode { my $self = shift; $self->run_modes( dbiprof_graph_svgtt => \&graph ); } sub graph { my $self = shift; my $q = $self->query(); my %opts = ( title => $q->param('title'), ylabel => $q->param('ylabel'), data => [ $q->param('data') ], tags => [ $q->param('tags') ], ); $opts{data} ||= []; 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; { # BUG in SVG::TT::Graph... if all values are less than 0.5, # the code to determine the scale ticks does an illegal division by zero # So, we turn on 'scale_integers' if that's the case. my $maxval = 0; foreach (@{$opts{data}}) { $maxval = $_ if $_ > $maxval; } my %extra_opt = ($maxval < 0.5) ? (scale_integers => 1) : (); my $graph = SVG::TT::Graph::Bar->new({ width => $WIDTH, height => $HEIGHT, fields => $opts{tags}, graph_title => $opts{title}, y_title => $opts{ylabel}, show_y_title => 1, show_y_labels => 1, show_graph_title => 1, %extra_opt, }); $graph->add_data({ data => $opts{data}, title => $opts{title}, }); $graph_data = $graph->burn(); } $self->header_add(-type => 'image/svg+xml'); return $graph_data; } sub build_graph { my $proto = shift; my $class = ref($proto) || $proto; my %opts = @_; my $mode_param = $opts{mode_param} || 'rm'; my @url; push(@url, $mode_param.'=dbiprof_graph_svgtt'); push(@url, 'ylabel=' .CGI::escape($opts{ylabel}) ); push(@url, 'title=' .CGI::escape($opts{title}) ); my @data = map { 'data=' .CGI::escape($_) } ref($opts{data}) ? @{$opts{data}} : (); push(@url, @data); my @tags = map { 'tags=' .CGI::escape($_) } ref($opts{tags}) ? @{$opts{tags}} : (); push(@url, @tags); my $url = $opts{self}->query->url(); $url .= '?'.join('&', @url); my $h_title = CGI::escapeHTML($opts{title}); #return qq(\n); # embed/object/iframe... dunno which is best # http://www.spartanicus.utvinternet.ie/embed.htm#svg # return qq( #Requires SVG plugin. #); return qq(); } 1; __END__ =head1 NAME CGI::Application::Plugin::DBIProfile::Graph::SVGTT - SVT::TT::Graph::Bar Graph output for CAP:DBIProfile. =head1 SYNOPSIS # in httpd.conf SetVar CAP_DBIPROFILE_GRAPHMODULE CGI::Application::Plugin::DBIProfile::Graph::SVGTT PerlSetVar CAP_DBIPROFILE_GRAPHMODULE CGI::Application::Plugin::DBIProfile::Graph::SVGTT # in your CGI::Application subclass (needed to install callback) use CGI::Application; use CGI::Application::Plugin::DBIProfile::Graph::SVGTT; =head1 DESCRIPTION This module provides a SVG::TT::Graph::Bars graphing option for CAP:DBIProfile. This also provides an example of non-inline graphs for DBIProfile. The following settings control the output: =over =item $CGI::Application::Plugin::DBIProfile::Graph::SVGTT::WIDTH Width of output image. =item $CGI::Application::Plugin::DBIProfile::Graph::SVGTT::HEIGHT Height of output image. =back =head1 REQUIREMENTS =over =item L =back =head1 SEE ALSO =over =item L =item L =item L =back =head1 AUTHOR Joshua I Miller, L =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 CGI-Application-Plugin-DBIProfile-0.07/lib/CGI/Application/Plugin/DBIProfile/Graph/HTML.pm0000644000076400007640000001432711276104123031177 0ustar tandersontandersonpackage 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 ' 
 ', 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 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 (usefull 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 or 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 scheme. An example of this can be found in L. 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: 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. =head1 REQUIREMENTS L =head1 SEE ALSO L L L =head1 AUTHOR Joshua I Miller, L =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 CGI-Application-Plugin-DBIProfile-0.07/lib/CGI/Application/Plugin/DBIProfile/Driver.pm0000644000076400007640000000611511276104123030621 0ustar tandersontandersonpackage CGI::Application::Plugin::DBIProfile::Driver; use strict; use IO::Scalar; =head1 TODO: POD =cut use vars qw($VERSION $DEBUG @ISA); $DEBUG = 0; $VERSION = "1.1"; @ISA = qw(DBI::ProfileDumper); # TODO: requires DBI 1.49 for class method call interface. # TODO: requires DBI 1.24 for DBI->{Profile} support, period. use Carp qw(carp croak); use DBI; use DBI::ProfileDumper; # Override flush_to_disk() to use IO::Scalar rather than a real file. # Also, change it to return the current formatted dataset, rather # than write anything out. # NOTE: the name doesn't fit. Could change that. sub flush_to_disk { my $self = _get_dbiprofile_obj(shift); return unless defined $self; my $output = $self->get_current_stats(); $self->empty(); return $output; } # This does what flush_to_disk does, without emptying data afterwards. sub get_current_stats { my $self = _get_dbiprofile_obj(shift); return unless defined $self; my $data = $self->{Data}; my $output; my $fh = new IO::Scalar \$output; $self->write_header($fh); $self->write_data($fh, $self->{Data}, 1); close($fh) or croak("Unable to close scalar filehandle: $!"); return $output; } # Override on_destroy() to simply clear the data, and close the IO::Scalar. sub on_destroy { shift->empty(); } # Override empty to it'll behave has a class method. sub empty { my $self = _get_dbiprofile_obj(shift); return unless defined $self; $self->SUPER::empty; } # utility method to get a usable DBI::Profile object. sub _get_dbiprofile_obj { my $self = shift; # if we're called by an instance var, just return it. return $self if ref $self and UNIVERSAL::isa($self, 'DBI::Profile'); # XXX: I couldn't find an instance where I needed to look at more # than one database handle, even with multiple database handles # talking to separate dbs using separate drivers. # I'm not sure how this works out under mod_perl2 using the # multi-threaded apache service (is there a separate perl memory/name # space for each thread, or one per process?) # We may need to loop over handles, fetch data && clear data && merge. # if we're called as a class method, we need to find at least one # db handle to work with, and snag its profile. my $dbh = (_get_all_dbh_handles())[0]; unless (ref $dbh && UNIVERSAL::isa($dbh, 'DBI::db')) { carp "Unable to locate active dbh." if $DEBUG; return; } $self = $dbh->{Profile}; if (! ref $self) { carp "Handle lacks Profile support"; return; } return $self; } # utility methods to enumerate all database handles sub _get_all_dbh_handles { return grep { $_->{Type} eq 'db' } _get_all_dbi_handles(); } sub _get_all_dbi_handles { my @handles; my %drivers = DBI->installed_drivers(); push(@handles, _get_all_dbi_child_handles($_) ) for values %drivers; return @handles; } sub _get_all_dbi_child_handles { my $h = shift; my @h = ($h); push(@h, _get_all_dbi_child_handles($_)) for (grep { defined } @{$h->{ChildHandles}}); return @h; } 1; CGI-Application-Plugin-DBIProfile-0.07/lib/CGI/Application/Plugin/DBIProfile/Data.pm0000644000076400007640000000174511276104123030243 0ustar tandersontandersonpackage CGI::Application::Plugin::DBIProfile::Data; use strict; use base 'DBI::ProfileData'; use vars qw($VERSION); $VERSION = "1.0"; use Symbol; # override _read_files # this is only so that we can add support for filehandles, rather than just files. sub _read_files { my $self = shift; my $files = $self->{Files}; my $read_header = 0; foreach my $filename (@$files) { my $fh; if (!ref($filename) && ref(\$filename) ne 'GLOB') { # Assume $filename is a filename $fh = gensym; open($fh, $filename) or croak("Unable to read profile file '$filename': $!"); } else { $fh = $filename; $filename = ref($fh).' object'; } $self->_read_header($fh, $filename, $read_header ? 0 : 1); $read_header = 1; $self->_read_body($fh, $filename); close($fh); } # discard node_lookup now that all files are read delete $self->{_node_lookup}; } CGI-Application-Plugin-DBIProfile-0.07/lib/CGI/Application/Plugin/DBIProfile.pm0000644000076400007640000003416211276104123027371 0ustar tandersontandersonpackage CGI::Application::Plugin::DBIProfile; use strict; use CGI::Application::Plugin::DBIProfile::Driver; # DBI::ProfileData doesn't support reading from filehandles. #use DBI::ProfileData; use CGI::Application::Plugin::DBIProfile::Data; use IO::Scalar; use HTML::Template; use Data::JavaScript; use vars qw($VERSION); our $VERSION = '0.07'; sub import { my $c = scalar caller; if ($ENV{CAP_DBIPROFILE_EXEC}) { $c->add_callback( 'prerun', \&_start ); # use devpopup if installed, or do our own thing. if ($c->can('devpopup') && $ENV{'CAP_DEVPOPUP_EXEC'}) { $c->add_callback( 'devpopup_report', \&_devpopup_stop); } else { $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. 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( $content
) ); _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| END if ($$output =~ m!!i) { $$output =~ s!!$js\n!i; } else { $$output .= $js; } } sub _page_title { my $self = shift; my %opts = @_; my $title = "Top $opts{number} Statements By " . ($opts{sort} eq 'count' ? "Count of Executions" : (ucfirst($opts{sort}) . " Runtime")); } sub _dbiprof_graph { my $self = shift; my %opts = @_; my $nodes = $opts{nodes}; my $number = $opts{number}; my $sort = $opts{sort}; my $index = $sort eq 'count' ? 0 : $sort eq 'total' ? 1 : $sort eq 'shortest'? 3 : $sort eq 'longest' ? 4 : die "Unknown sort '$sort'"; my $title = _page_title($self, %opts); my $data = [ map { $nodes->[$_][$index] } (0 .. $#$nodes) ]; my $tag = 1; my $tags = [ map { $tag++ } @$data ]; # load graphing plugin, and run it. my $graph_plug = _load_graph_module ($self); my $graph = $graph_plug->build_graph( self => $self, mode_param => $self->mode_param, title => $title, ylabel => $sort eq 'count' ? 'Count' : 'Seconds', data => $data, tags => $tags, ); warn "Unable to build graph." unless defined $graph; return ref($graph) ? $$graph : $graph || ""; } 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 = < CGI::Application::Plugin::DBIProfile Profiling Screen
END2 our $TEMPLATE = < .legend_header { background-color: #7187C7; color: #FFF; } .legend_odd_row { background-color: #FFF; } .legend_even_row { background-color: #EEE; }

Full Text Dump By Runtime
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 make install =head1 DESCRIPTION CGI::Application::Plugin::DBIProfile provides popup (using CAP::DevPopup if available) holding DBI Profile information (see L, L). It will output both graphed output and a DBI::ProfileDumper report. =head1 CONFIGURATION To enable, set the DBI_PROFILE environment variables. For example =over =item in apache config for cgi SetVar DBI_PROFILE 2/CGI::Application::Plugin::DBIProfile::Driver SetVar CAP_DBIPROFILE_EXEC 1 =item in apache config for mod_perl PerlSetVar DBI_PROFILE 2/CGI::Application::Plugin::DBIProfile::Driver PerlSetVar CAP_DBIPROFILE_EXEC 1 =item in your CAP module BEGIN { $ENV{DBI_PROFILE} = '2/CGI::Application::Plugin::DBIProfile::Driver'; $ENV{CAP_DBIPROFILE_EXEC} = 1; } =back If you disable it, be sure to unset the DBI_PROFILE env var, as it will continue to accumulate stats regardless of the setting of CAP_DBIPROFILE_EXEC, you just won't see them. =head2 MODES OF OPERATION It has two modes of opperation; per-request or per-process. In a CGI environment, there is no difference. =over =item per-request - this is the default. =item per-process - set the following env var to a true value. CAP_DBIPROFILE_PERPROCESS 1 =back Under mod_perl, the per-request setup will show the DBI Profile specific to each page hit. The per-process setup will show the DBI Profile that has accumulated for the life of the apache process you are hitting. Please note, running under the per-process setting can cause your memory usage to grow significantly, as the profile data is never cleared. =head2 GRAPHING PLUGINS The default graphing module is L, which generates a minimal inline HTML graph. To change which graphing plugin is used, it's just another environment variable (no need to set this if you like the default). CAP_DBIPROFILE_GRAPHMODULE Your::Graph::Module::Name Please see L for information on writing new graph modules. =head1 TODO Tests. None exist at this time. Other graphing plugins (Plotr, Open Flash Chart, GraphML using Graph::Easy). Add checks to be sure $dbh->{Profile} isn't disabled (probably better in ::Driver). =head1 REQUIREMENTS =over =item L =item L =item L =back Optional: =over =item * L For CGI::Application::Plugin::DBIProfile::Graph::GDGraphInline support. =item * L For CGI::Application::Plugin::DBIProfile::Graph::SVGTT support. =item * L For CGI::Application::Plugin::DBIProfile::Graph::HTMLBarGraph support. =back =head1 SEE ALSO =over =item L =item L =item L =item L =item L =item L =item L =item L =item L =back =head1 SPECIAL THANKS To Sam Tregar, for the original codebase on which this was based, and DBI::ProfileDumper itself. =head1 AUTHOR Sam Tregar, C<< >> Joshua I Miller, C<< >> =head1 BUGS Please report any bugs or feature requests to L, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =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 CGI-Application-Plugin-DBIProfile-0.07/Changes0000644000076400007640000000236011276104123021531 0ustar tandersontandersonRevision history for CGI-Application-Plugin-DBIProfile 0.07 2009-11-09 Restructured module layout so that Build.PL stops failing. No code changes made. 0.06 2008-12-15 BUGFIX: Build.PL had a syntax error in add_to_cleanup. 0.05 2007-09-27 Added Graph::HTML::Horizontal plugin. BUGFIX: rt 29670 : Duplicate titles in reports. BUGFIX: rt 29669 : Add summary to DevPopup report. BUGFIX: rt 29668 : Unable to set ENV vars via PerlSetVar. BUGFIX: rt 29667 : DBI profile environment var should be UPPER CASE. BUGFIX: rt 29666 : Typo in callback for CAP::DevPopup report. 0.04 2007-09-27 Added Graph::SVGTT plugin. Added Graph::GDGraphInline plugin. Added catch for non-html docs, so we don't run then. BUGFIX: for devpopup support (typo in sub reference name). 0.03 2007-09-26 Made graphing a plugin, and wrote custom (simple) HTML graph plugin. First CPAN release. 0.02 2007-09-26 Alpha of rewrite by Joshua Miller. Uses new DBI::Profile driver that uses IO::Scalar for storage. Graphs are inline html (using HTML::BarGraph, which is broken). 0.01 2005-06-06 First version by Sam Tregar. CGI-Application-Plugin-DBIProfile-0.07/MANIFEST0000644000076400007640000000102311276104123021362 0ustar tandersontandersonBuild.PL Changes MANIFEST META.yml # Will be created by "make dist" Makefile.PL README lib/CGI/Application/Plugin/DBIProfile.pm lib/CGI/Application/Plugin/DBIProfile/Data.pm lib/CGI/Application/Plugin/DBIProfile/Driver.pm lib/CGI/Application/Plugin/DBIProfile/Graph/HTML.pm lib/CGI/Application/Plugin/DBIProfile/Graph/HTML/Horizontal.pm lib/CGI/Application/Plugin/DBIProfile/Graph/HTMLBarGraph.pm lib/CGI/Application/Plugin/DBIProfile/Graph/GDGraphInline.pm lib/CGI/Application/Plugin/DBIProfile/Graph/SVGTT.pm t/00-load.t t/pod.t CGI-Application-Plugin-DBIProfile-0.07/META.yml0000644000076400007640000000130711276104343021513 0ustar tandersontanderson--- #YAML:1.0 name: CGI-Application-Plugin-DBIProfile version: 0.07 abstract: DBI profiling plugin license: ~ author: - Sam Tregar generated_by: ExtUtils::MakeMaker version 6.42 distribution_type: module requires: CGI::Application: 4 Data::JavaScript: 0 DBI: 1.49 HTML::Template: 2.6 IO::Scalar: 0 Symbol: 0 Test::More: 0 Time::HiRes: 0 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 CGI-Application-Plugin-DBIProfile-0.07/t/0000755000076400007640000000000011276104343020504 5ustar tandersontandersonCGI-Application-Plugin-DBIProfile-0.07/t/00-load.t0000644000076400007640000000062510700046504022023 0ustar tandersontandersonuse Test::More tests => 4; BEGIN { use_ok( 'CGI::Application::Plugin::DBIProfile' ); use_ok( 'CGI::Application::Plugin::DBIProfile::Driver' ); use_ok( 'CGI::Application::Plugin::DBIProfile::Data' ); use_ok( 'CGI::Application::Plugin::DBIProfile::Graph::HTML' ); } diag( "Testing CGI::Application::Plugin::DBIProfile $CGI::Application::Plugin::DBIProfile::VERSION, Perl 5.008006, /usr/local/bin/perl" ); CGI-Application-Plugin-DBIProfile-0.07/t/pod.t0000644000076400007640000000021410700046504021443 0ustar tandersontanderson#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); CGI-Application-Plugin-DBIProfile-0.07/README0000644000076400007640000000167410700046504021124 0ustar tandersontandersonCGI-Application-Plugin-DBIProfile The README is used to introduce the module and provide instructions on how to install the module, any machine dependencies it may have (for example C compilers and installed libraries) and any other information that should be provided before the module is installed. A README file is required for CPAN modules since CPAN extracts the README file from a module distribution so that people browsing the archive can use it get an idea of the modules uses. It is usually a good idea to provide version information here so that people can decide whether fixes for the module are worth downloading. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install COPYRIGHT AND LICENCE Copyright (C) 2005 Sam Tregar Copyright (C) 2007 Joshua Miller This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. CGI-Application-Plugin-DBIProfile-0.07/Makefile.PL0000644000076400007640000000147111276104123022212 0ustar tandersontandersonuse 5.006; use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'CGI::Application::Plugin::DBIProfile', AUTHOR => 'Sam Tregar ', VERSION_FROM => 'lib/CGI/Application/Plugin/DBIProfile.pm', ABSTRACT_FROM => 'lib/CGI/Application/Plugin/DBIProfile.pm', PL_FILES => {}, PREREQ_PM => { 'IO::Scalar' => 0, 'Data::JavaScript' => 0, 'Symbol' => 0, 'Test::More' => 0, 'CGI::Application' => 4, 'DBI' => 1.49, 'Time::HiRes' => 0, 'HTML::Template' => 2.6, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'CGI-Application-Plugin-DBIProfile-*' }, ); CGI-Application-Plugin-DBIProfile-0.07/Build.PL0000644000076400007640000000152511276104123021534 0ustar tandersontandersonuse strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'CGI::Application::Plugin::DBIProfile', license => 'perl', dist_author => 'Joshua I Miller ', dist_version_from => 'lib/CGI/Application/Plugin/DBIProfile.pm', requires => { 'IO::Scalar' => 0, 'Data::JavaScript' => 0, 'Symbol' => 0, 'Test::More' => 0, 'CGI::Application' => 4, 'DBI' => 1.49, 'Time::HiRes' => 0, 'HTML::Template' => 2.6, }, recommends => { 'GD::Graph' => 0, 'SVG::TT::Graph' => 0, }, add_to_cleanup => [ 'CGI-Application-Plugin-DBIProfile-*' ], create_makefile_pl => 'traditional', ); $builder->create_build_script();