line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Devel::KYTProf::Profiler::DBI; |
2
|
|
|
|
|
|
|
|
3
|
6
|
|
|
6
|
|
2817
|
use strict; |
|
6
|
|
|
|
|
12
|
|
|
6
|
|
|
|
|
149
|
|
4
|
6
|
|
|
6
|
|
26
|
use warnings; |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
135
|
|
5
|
6
|
|
|
6
|
|
2226
|
use DBIx::Tracer; |
|
6
|
|
|
|
|
8859
|
|
|
6
|
|
|
|
|
1740
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
sub apply { |
8
|
|
|
|
|
|
|
Devel::KYTProf->add_prof( |
9
|
|
|
|
|
|
|
'DBI', |
10
|
|
|
|
|
|
|
'connect', |
11
|
|
|
|
|
|
|
sub { |
12
|
1
|
|
|
1
|
|
3
|
my ($orig, $class, $dsn, $user, $pass, $attr) = @_; |
13
|
|
|
|
|
|
|
return [ |
14
|
|
|
|
|
|
|
'%s %s', |
15
|
|
|
|
|
|
|
['dbi_connect_method', 'dsn'], |
16
|
|
|
|
|
|
|
{ |
17
|
1
|
|
50
|
|
|
9
|
dbi_connect_method => $attr->{dbi_connect_method} || 'connect', |
18
|
|
|
|
|
|
|
dsn => $dsn, |
19
|
|
|
|
|
|
|
}, |
20
|
|
|
|
|
|
|
]; |
21
|
|
|
|
|
|
|
} |
22
|
6
|
|
|
6
|
0
|
44
|
); |
23
|
|
|
|
|
|
|
|
24
|
6
|
|
|
|
|
21
|
my $LastSQL; |
25
|
|
|
|
|
|
|
my $LastBinds; |
26
|
6
|
|
|
|
|
0
|
my $LastDBName; |
27
|
6
|
|
|
|
|
0
|
my $IsInProf; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
our $_TRACER = DBIx::Tracer->new(sub { |
30
|
3
|
|
|
3
|
|
22209
|
my %args = @_; |
31
|
3
|
|
|
|
|
25
|
$LastDBName = $args{dbh}->{Name}; |
32
|
3
|
50
|
|
|
|
14
|
$LastDBName = '' unless defined $LastDBName; |
33
|
3
|
|
|
|
|
5
|
$LastSQL = $args{sql}; |
34
|
3
|
|
50
|
|
|
8
|
my $bind_params = $args{bind_params} || []; |
35
|
|
|
|
|
|
|
$LastBinds = scalar(@$bind_params) ? |
36
|
3
|
50
|
|
|
|
21
|
'(bind: '.join(', ', map { defined $_ ? $_ : 'undef' } @$bind_params).')' : |
|
4
|
100
|
|
|
|
21
|
|
37
|
|
|
|
|
|
|
''; |
38
|
6
|
|
|
|
|
25
|
}); |
39
|
|
|
|
|
|
|
Devel::KYTProf->add_prof( |
40
|
|
|
|
|
|
|
'DBI::st', |
41
|
|
|
|
|
|
|
'execute', |
42
|
|
|
|
|
|
|
sub { |
43
|
2
|
|
|
2
|
|
4
|
my (undef, $sth) = @_; |
44
|
|
|
|
|
|
|
return [ |
45
|
2
|
|
|
|
|
20
|
'(db:%s) %s %s (%d rows)', |
46
|
|
|
|
|
|
|
['database', 'sql', 'sql_binds', 'rows'], |
47
|
|
|
|
|
|
|
{ |
48
|
|
|
|
|
|
|
sql => $LastSQL, |
49
|
|
|
|
|
|
|
sql_binds => $LastBinds, |
50
|
|
|
|
|
|
|
rows => $sth->rows, |
51
|
|
|
|
|
|
|
database => $LastDBName, |
52
|
|
|
|
|
|
|
}, |
53
|
|
|
|
|
|
|
]; |
54
|
|
|
|
|
|
|
}, |
55
|
2
|
|
|
2
|
|
5
|
sub { !$IsInProf }, |
56
|
6
|
|
|
|
|
351
|
); |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
Devel::KYTProf->add_profs( |
59
|
|
|
|
|
|
|
'DBI::db', |
60
|
|
|
|
|
|
|
[qw/do selectall_arrayref selectrow_arrayref selectrow_array/], |
61
|
|
|
|
|
|
|
sub { |
62
|
1
|
|
|
1
|
|
2
|
undef $IsInProf; |
63
|
|
|
|
|
|
|
return [ |
64
|
1
|
|
|
|
|
6
|
'(db:%s) %s %s', |
65
|
|
|
|
|
|
|
['database', 'sql', 'sql_binds'], |
66
|
|
|
|
|
|
|
{ |
67
|
|
|
|
|
|
|
sql => $LastSQL, |
68
|
|
|
|
|
|
|
sql_binds => $LastBinds, |
69
|
|
|
|
|
|
|
database => $LastDBName, |
70
|
|
|
|
|
|
|
}, |
71
|
|
|
|
|
|
|
]; |
72
|
|
|
|
|
|
|
}, |
73
|
|
|
|
|
|
|
# Since there is a possibility that these methods call `execute` method |
74
|
|
|
|
|
|
|
# internally (it depends on DBD implementation), we flag here to prevent |
75
|
|
|
|
|
|
|
# duplicate profiling output. |
76
|
|
|
|
|
|
|
# And we drop this flag in the above callback. |
77
|
1
|
|
|
1
|
|
2
|
sub { $IsInProf = 1 }, |
78
|
6
|
|
|
|
|
37
|
); |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
1; |