File Coverage

blib/lib/CGI/Application/Plugin/DBIProfile.pm
Criterion Covered Total %
statement 23 119 19.3
branch 1 34 2.9
condition 0 12 0.0
subroutine 8 18 44.4
pod n/a
total 32 183 17.4


line stmt bran cond sub pod time code
1             package CGI::Application::Plugin::DBIProfile;
2              
3 1     1   20599 use strict;
  1         3  
  1         59  
4              
5 1     1   673 use CGI::Application::Plugin::DBIProfile::Driver;
  1         3  
  1         62  
6             # DBI::ProfileData doesn't support reading from filehandles.
7             #use DBI::ProfileData;
8 1     1   890 use CGI::Application::Plugin::DBIProfile::Data;
  1         3  
  1         16  
9              
10 1     1   34 use IO::Scalar;
  1         1  
  1         46  
11 1     1   1830 use HTML::Template;
  1         24285  
  1         30  
12 1     1   9468 use Data::JavaScript;
  1         17161  
  1         10  
13              
14              
15 1     1   77 use vars qw($VERSION);
  1         2  
  1         1988  
16              
17             our $VERSION = '0.07';
18              
19             sub import
20             {
21 1     1   15 my $c = scalar caller;
22 1 50       20 if ($ENV{CAP_DBIPROFILE_EXEC})
23             {
24 0           $c->add_callback( 'prerun', \&_start );
25             # use devpopup if installed, or do our own thing.
26 0 0 0       if ($c->can('devpopup') && $ENV{'CAP_DEVPOPUP_EXEC'})
27             {
28 0           $c->add_callback( 'devpopup_report', \&_devpopup_stop);
29             } else {
30 0           $c->add_callback( 'postrun', \&_stop);
31             }
32             }
33             }
34              
35             # _start : clear anything that is currently stored (incase stuff ran without us)
36             sub _start
37             {
38 0     0     my $self = shift;
39              
40 0           _empty_profile();
41             }
42              
43             # _stop : standalone report output, called in postrun hook.
44             sub _stop
45             {
46 0     0     my ($self, $output) = @_;
47              
48             # header handling borrowed from CAP::DevPopup
49 0 0         return unless $self->header_type eq 'header'; # don't operate on redirects or 'none'
50 0           my %props = $self->header_props;
51 0           my ($type) = grep /type/i, keys %props;
52 0 0 0       return if defined $type and # no type defaults to html, so we have work to do.
53             $props{$type} !~ /html/i; # else skip any other types.
54              
55              
56 0           our $TEMPLATE2;
57              
58 0           my $template = HTML::Template->new(scalarref => \$TEMPLATE2 );
59 0           $template->param(page_body => _build_content($self) );
60              
61 0           my $content = $template->output();
62              
63 0           _open_window($self, $content, $output);
64              
65 0           _empty_profile();
66             }
67              
68             # _devpopup_stop : similar to _stop, but compatable with CAP:DevPopup
69             sub _devpopup_stop
70             {
71 0     0     my $self = shift;
72 0           my $output = shift;
73              
74 0           my $content = _build_content($self);
75              
76 0           $self->devpopup->add_report(
77             title => 'DBI Profile',
78             summary => 'DBI statement profiling',
79             report => qq(
80            
83             $content
84             )
85             );
86              
87 0           _empty_profile();
88             }
89              
90             # clear profile if running in per-request (unless running in per-process)
91             sub _empty_profile
92             {
93 0 0   0     unless ($ENV{CAP_DBIPROFILE_PERPROCESS}) {
94 0           CGI::Application::Plugin::DBIProfile::Driver->empty();
95             }
96             }
97              
98             # main content builder. Builds datasets, and pushs to template.
99             sub _build_content
100             {
101 0     0     my $self = shift;
102              
103 0   0       my %opts = (
104             number => $self->param('__DBIProfile_number') || 10,
105             );
106              
107 0           my @pages;
108              
109             # for each sort type, add a graph in a hidden div
110 0           foreach my $sort (qw(total count shortest longest))
111             {
112 0           my $page = {};
113              
114 0           my ($nodes, $data) = _get_nodes($self, (%opts, sort => $sort) );
115              
116 0           my @legends = map { $nodes->[$_][7] } (0 .. $#$nodes);
  0            
117 0           my $count = 1;
118 0           $$page{sort} = $sort;
119 0           $$page{legend_loop} = [ map { { number => $count++, legend => $_ } } @legends];
  0            
120 0           $$page{profile_title} = _page_title($self, (%opts, sort => $sort) );
121 0           $$page{profile_text} = join("\n\n", map { $data->format($nodes->[$_]) } (0 .. $#$nodes));
  0            
122 0           $$page{profile_graph} = _dbiprof_graph($self, (%opts, sort => $sort, nodes => $nodes) );
123              
124 0           push(@pages, $page);
125             }
126              
127 0           our $TEMPLATE;
128              
129 0           my $template = HTML::Template->new(scalarref => \$TEMPLATE,
130             loop_context_vars => 1, );
131 0           $template->param(profile_pages => \@pages);
132              
133             # add full text only dump of all data (well, last 1000 queries)
134 0           my ($nodes, $data) = _get_nodes($self, number => 1000, sort => 'count');
135 0           $template->param('profile_full_text', join("\n\n", map { $data->format($nodes->[$_]) } (0 .. $#$nodes)) );
  0            
136              
137 0           return $template->output();
138             }
139              
140             # wrapper to ease getting data from DBI
141             sub _get_nodes
142             {
143 0     0     my $self = shift;
144 0           my %opts = @_;
145              
146 0           my $sort = $opts{sort};
147 0           my $number = $opts{number};
148              
149 0           my $profile_data = CGI::Application::Plugin::DBIProfile::Driver->get_current_stats();
150              
151 0           my $fh = new IO::Scalar \$profile_data;
152              
153 0           my $data = CGI::Application::Plugin::DBIProfile::Data->new(File => $fh);
154 0           $data->sort(field => $sort);
155 0           $data->exclude(key1 => qr/^\s*$/);
156              
157             # get list trimmed to number
158 0           my $nodes = $data->nodes();
159 0 0         $number = @$nodes if $number > @$nodes;
160 0           $#$nodes = $number - 1;
161              
162 0 0         return wantarray ? ($nodes, $data) : $nodes;
163             }
164              
165             sub _open_window
166             {
167 0     0     my ($self, $content, $output) = @_;
168              
169 0           my $js = qq|
180             END
181              
182 0 0         if ($$output =~ m!!i) {
183 0           $$output =~ s!!$js\n!i;
184             } else {
185 0           $$output .= $js;
186             }
187             }
188              
189             sub _page_title
190             {
191 0     0     my $self = shift;
192 0           my %opts = @_;
193              
194 0 0         my $title = "Top $opts{number} Statements By " .
195             ($opts{sort} eq 'count' ? "Count of Executions" :
196             (ucfirst($opts{sort}) . " Runtime"));
197              
198             }
199              
200             sub _dbiprof_graph
201             {
202 0     0     my $self = shift;
203 0           my %opts = @_;
204              
205 0           my $nodes = $opts{nodes};
206 0           my $number = $opts{number};
207 0           my $sort = $opts{sort};
208              
209 0 0         my $index = $sort eq 'count' ? 0 :
    0          
    0          
    0          
210             $sort eq 'total' ? 1 :
211             $sort eq 'shortest'? 3 :
212             $sort eq 'longest' ? 4 : die "Unknown sort '$sort'";
213              
214 0           my $title = _page_title($self, %opts);
215 0           my $data = [ map { $nodes->[$_][$index] } (0 .. $#$nodes) ];
  0            
216 0           my $tag = 1;
217 0           my $tags = [ map { $tag++ } @$data ];
  0            
218              
219             # load graphing plugin, and run it.
220 0           my $graph_plug = _load_graph_module ($self);
221              
222 0 0         my $graph = $graph_plug->build_graph(
223             self => $self,
224             mode_param => $self->mode_param,
225             title => $title,
226             ylabel => $sort eq 'count' ? 'Count' : 'Seconds',
227             data => $data,
228             tags => $tags,
229             );
230 0 0         warn "Unable to build graph." unless defined $graph;
231              
232 0 0 0       return ref($graph) ? $$graph : $graph || "";
233             }
234              
235             sub _load_graph_module
236             {
237 0     0     my $self = shift;
238              
239 0           my $module = $ENV{CAP_DBIPROFILE_GRAPHMODULE};
240 0   0       $module ||= 'CGI::Application::Plugin::DBIProfile::Graph::HTML';
241              
242 0           eval "require $module";
243              
244 0 0         if ($@)
245             {
246 0           die "CAP::DBIProfile: Unable to load graphing module \"$module\": $@";
247             }
248              
249 0           return $module;
250             }
251              
252             our $TEMPLATE2 = <
253            
254            
255              
256            
257             CGI::Application::Plugin::DBIProfile Profiling Screen
258              
259            
266              
267            
277              
278              
279            
280              
281            
282            
283              
284            
285              
286            
287            
288              
289             END2
290              
291             our $TEMPLATE = <
292              
293            
305              
306            
307              
308            
309            
310              
311            
312              
313            

314              
315            
316            
317              
318            
319              
320            
321            
322             #
323             SQL Statement
324            
325            
326            
327             class="legend_odd_row"class="legend_even_row">
328             class="legend_odd_row"class="legend_even_row">
329            
330            
331            
332              
333            
334            
335            
336            

Full Text Profile Dump
337            
338            
339            
340            
341            
342            
343            
344              
345            
346              
347            
348              
349            
350            

Full Text Dump By Runtime
351            
352            
353            
354            
355              
356            
357              
358            
359              
360             END
361              
362              
363              
364             1;
365              
366             __END__