File Coverage

blib/lib/Plack/Debugger/Panel/DBIProfile.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1 1     1   20649 use strict;
  1         3  
  1         25  
2 1     1   5 use warnings;
  1         2  
  1         55  
3             package Plack::Debugger::Panel::DBIProfile;
4             $Plack::Debugger::Panel::DBIProfile::VERSION = '0.01';
5              
6 1     1   712 use parent 'Plack::Debugger::Panel';
  1         334  
  1         6  
7             use DBI::Profile;
8             use Time::HiRes qw(gettimeofday tv_interval);
9              
10             my $DBI_PROFILE_FORMAT = '%1$s XXX %11$fs / %10$d = %2$fs avg (first %12$fs, min %13$fs, max %14$fs)';
11              
12             sub new {
13             my $class = shift;
14             my %args = @_ == 1 && ref $_[0] eq 'HASH' ? %{ $_[0] } : @_;
15              
16             $args{'title'} ||= 'DBI Profile';
17              
18             my $dbi_profile = delete $args{dbi_profile} || 6;
19             my $dbi_profile_format = delete $args{dbi_profile_format} || $DBI_PROFILE_FORMAT;
20              
21             # This is the JS formatter function that places the data in the panel.
22             # https://metacpan.org/source/STEVAN/Plack-Debugger-0.03/example/app.psgi has some examples of formatters
23             # The JS source is at $app/debugger/static/js/plack-debugger.js - search for 'formatters'
24             # Options available are: pass_through, generic_data_formatter, ordered_key_value_pairs,
25             # simple_data_table, simple_data_table_w_headers, multiple_data_table, multiple_data_table_w_headers,
26             # ordered_keys_with_nested_data, nested_data, subrequest_formatter
27             $args{'formatter'} ||= 'simple_data_table';
28              
29              
30             $args{'before'} = sub {
31             my ($self, $env) = @_;
32             my $profile_obj = _set_profile_on_all_dbi_handles($dbi_profile);
33             $self->stash({ start => [ gettimeofday ], profile_obj => $profile_obj});
34             };
35              
36             $args{'after'} = sub {
37             my ($self, $env, $resp) = @_;
38              
39             my $start = $self->stash->{start};
40             my $end = [ gettimeofday ];
41             my $elapsed = tv_interval( $start, $end );
42              
43             $self->set_subtitle( $elapsed );
44              
45             if (my $profile_obj = $self->stash->{profile_obj}) {
46             #my $duration = gettimeofday() - $start_time;
47             my $time_in_dbi = dbi_profile_merge_nodes(my $totals=[], $profile_obj->{Data});
48              
49             # 'Profile Path: %1$s XXX Profile Data: %11$fs / %10$d = %2$fs avg (first %12$fs, min %13$fs, max %14$fs)'
50             my @items = $profile_obj->as_text({
51             format => $dbi_profile_format,
52             sortsub => sub {
53             my $ary = shift;
54             @$ary = sort { $b->[0][1] <=> $a->[0][1] } @$ary;
55             },
56             });
57              
58             my $i = 1; my $n;
59             my @rows = map {[$i++ %2 ? do {$n = $i * 0.5; "$n. $_"} : ' ' x 6 . $_]}
60             map {split /XXX/} @items;
61              
62             $self->set_result( [ @rows ] );
63              
64             my $subtitle = sprintf "%.3f s (%d%%)",
65             $time_in_dbi, ($elapsed) ? $time_in_dbi/$elapsed*100 : "-";
66             # only show item count if >1 because they'll always be one
67             # for profile==1, the default, so it's only noise, and for other
68             # profile levels they'll always be an extra 'empty' item for
69             # calls that can't be associated with a particular statement etc.
70             $subtitle .= " #".@items if @items > 1;
71             $self->set_subtitle($subtitle);
72              
73             # disable profiling and silently discard profile data
74             local $DBI::Profile::ON_DESTROY_DUMP = sub { };
75             _set_profile_on_all_dbi_handles(undef);
76             }
77             };
78              
79             $class->SUPER::new( \%args );
80             }
81              
82             sub _set_profile_on_all_dbi_handles {
83             my ($profile_spec) = @_;
84              
85             # for drivers we've not loaded yet
86             $DBI::shared_profile = ($profile_spec)
87             ? DBI::Profile->_auto_new($profile_spec) # XXX not documented
88             : undef;
89              
90             # for any existing handles
91             DBI->visit_handles(sub {
92             shift->{Profile} = $DBI::shared_profile;
93             return 1; # keep going to visit all
94             });
95              
96             return $DBI::shared_profile;
97             }
98              
99              
100              
101             1;
102              
103             __END__