| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
# vim: ts=8 sw=2 sts=0 noexpandtab: |
|
2
|
|
|
|
|
|
|
########################################################## |
|
3
|
|
|
|
|
|
|
## This script is part of the Devel::NYTProf distribution |
|
4
|
|
|
|
|
|
|
## |
|
5
|
|
|
|
|
|
|
## Copyright, contact and other information can be found |
|
6
|
|
|
|
|
|
|
## at the bottom of this file, or by going to: |
|
7
|
|
|
|
|
|
|
## http://metacpan.org/release/Devel-NYTProf/ |
|
8
|
|
|
|
|
|
|
## |
|
9
|
|
|
|
|
|
|
########################################################### |
|
10
|
|
|
|
|
|
|
package Devel::NYTProf; |
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = '6.13_001'; # also change in Devel::NYTProf::Core |
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
package # hide the package from the PAUSE indexer |
|
15
|
|
|
|
|
|
|
DB; |
|
16
|
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
# Enable specific perl debugger flags (others may be set later). |
|
18
|
|
|
|
|
|
|
# Set the flags that influence compilation ASAP so we get full details |
|
19
|
|
|
|
|
|
|
# (sub line ranges etc) of modules loaded as a side effect of loading |
|
20
|
|
|
|
|
|
|
# Devel::NYTProf::Core (ie XSLoader, strict, Exporter etc.) |
|
21
|
|
|
|
|
|
|
# See "perldoc perlvar" for details of the $^P ($PERLDB) flags |
|
22
|
|
|
|
|
|
|
$^P = 0x010 # record line range of sub definition |
|
23
|
|
|
|
|
|
|
| 0x100 # informative "file" names for evals |
|
24
|
|
|
|
|
|
|
| 0x200; # informative names for anonymous subroutines |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
require Devel::NYTProf::Core; # loads XS and sets options |
|
27
|
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# XXX hack, need better option handling e.g., add DB::get_option('use_db_sub') |
|
29
|
|
|
|
|
|
|
my $use_db_sub = ($ENV{NYTPROF} && $ENV{NYTPROF} =~ m/\buse_db_sub=1\b/); |
|
30
|
|
|
|
|
|
|
if ($use_db_sub) { # install DB::DB sub |
|
31
|
|
|
|
|
|
|
*DB = ($] < 5.008008) |
|
32
|
|
|
|
|
|
|
? sub { goto &DB_profiler } # workaround bug in old perl versions (slow) |
|
33
|
|
|
|
|
|
|
: \&DB_profiler; |
|
34
|
|
|
|
|
|
|
} |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# DB::sub shouldn't be called, but needs to exist for perl <5.8.7 (
|
|
37
|
|
|
|
|
|
|
# Could be called in obscure cases, e.g. if "perl -d" (not -d:NYTProf) |
|
38
|
|
|
|
|
|
|
# was used with Devel::NYTProf loaded some other way |
|
39
|
|
|
|
|
|
|
*sub = sub { warn "DB::sub called unexpectedly (@{[ caller(0) ]})" } |
|
40
|
|
|
|
|
|
|
if $] < 5.008008; |
|
41
|
|
|
|
|
|
|
|
|
42
|
0
|
|
|
0
|
|
|
sub CLONE { DB::disable_profiler } |
|
43
|
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
init_profiler(); # provides true return value for module |
|
45
|
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# put nothing here! |
|
47
|
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
__END__ |