File | /project/perl/lib/LWP/Debug.pm |
Statements Executed | 2322 |
Statement Execution Time | 35.3ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1384 | 4 | 2 | 16.6ms | 16.6ms | trace | LWP::Debug::
929 | 3 | 2 | 11.4ms | 11.4ms | debug | LWP::Debug::
0 | 0 | 0 | 0s | 0s | BEGIN | LWP::Debug::
0 | 0 | 0 | 0s | 0s | _log | LWP::Debug::
0 | 0 | 0 | 0s | 0s | conns | LWP::Debug::
0 | 0 | 0 | 0s | 0s | import | LWP::Debug::
0 | 0 | 0 | 0s | 0s | level | LWP::Debug::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package LWP::Debug; | ||||
2 | |||||
3 | # $Id: Debug.pm,v 1.15 2004/04/09 15:07:04 gisle Exp $ | ||||
4 | |||||
5 | 1 | 6µs | require Exporter; | ||
6 | 1 | 11µs | @ISA = qw(Exporter); | ||
7 | 1 | 7µs | @EXPORT_OK = qw(level trace debug conns); | ||
8 | |||||
9 | 3 | 838µs | use Carp (); | ||
10 | |||||
11 | 1 | 6µs | my @levels = qw(trace debug conns); | ||
12 | 1 | 5µs | %current_level = (); | ||
13 | |||||
14 | |||||
15 | sub import | ||||
16 | { | ||||
17 | my $pack = shift; | ||||
18 | my $callpkg = caller(0); | ||||
19 | my @symbols = (); | ||||
20 | my @levels = (); | ||||
21 | for (@_) { | ||||
22 | if (/^[-+]/) { | ||||
23 | push(@levels, $_); | ||||
24 | } | ||||
25 | else { | ||||
26 | push(@symbols, $_); | ||||
27 | } | ||||
28 | } | ||||
29 | Exporter::export($pack, $callpkg, @symbols); | ||||
30 | level(@levels); | ||||
31 | } | ||||
32 | |||||
33 | |||||
34 | sub level | ||||
35 | { | ||||
36 | for (@_) { | ||||
37 | if ($_ eq '+') { # all on | ||||
38 | # switch on all levels | ||||
39 | %current_level = map { $_ => 1 } @levels; | ||||
40 | } | ||||
41 | elsif ($_ eq '-') { # all off | ||||
42 | %current_level = (); | ||||
43 | } | ||||
44 | elsif (/^([-+])(\w+)$/) { | ||||
45 | $current_level{$2} = $1 eq '+'; | ||||
46 | } | ||||
47 | else { | ||||
48 | Carp::croak("Illegal level format $_"); | ||||
49 | } | ||||
50 | } | ||||
51 | } | ||||
52 | |||||
53 | |||||
54 | 1384 | 21.2ms | # spent 16.6ms within LWP::Debug::trace which was called 1384 times, avg 12µs/call:
# 461 times (5.85ms+0s) by LWP::UserAgent::request at line 280 of LWP/UserAgent.pm, avg 13µs/call
# 461 times (5.62ms+0s) by LWP::UserAgent::send_request at line 149 of LWP/UserAgent.pm, avg 12µs/call
# 461 times (5.17ms+0s) by LWP::Protocol::http::request at line 122 of LWP/Protocol/http.pm, avg 11µs/call
# once (13µs+0s) by LWP::UserAgent::new at line 36 of LWP/UserAgent.pm | ||
55 | 929 | 13.2ms | # spent 11.4ms within LWP::Debug::debug which was called 929 times, avg 12µs/call:
# 461 times (5.85ms+0s) by LWP::UserAgent::request at line 287 of LWP/UserAgent.pm, avg 13µs/call
# 461 times (5.47ms+0s) by LWP::UserAgent::_need_proxy at line 792 of LWP/UserAgent.pm, avg 12µs/call
# 7 times (94µs+0s) by LWP::Protocol::collect at line 116 of LWP/Protocol.pm, avg 13µs/call | ||
56 | sub conns { _log(@_) if $current_level{'conns'}; } | ||||
57 | |||||
58 | |||||
59 | sub _log | ||||
60 | { | ||||
61 | my $msg = shift; | ||||
62 | $msg .= "\n" unless $msg =~ /\n$/; # ensure trailing "\n" | ||||
63 | |||||
64 | my($package,$filename,$line,$sub) = caller(2); | ||||
65 | print STDERR "$sub: $msg"; | ||||
66 | } | ||||
67 | |||||
68 | 1 | 18µs | 1; | ||
69 | |||||
70 | |||||
71 | __END__ | ||||
72 | |||||
73 | =head1 NAME | ||||
74 | |||||
75 | LWP::Debug - debug routines for the libwww-perl library | ||||
76 | |||||
77 | =head1 SYNOPSIS | ||||
78 | |||||
79 | use LWP::Debug qw(+ -conns); | ||||
80 | |||||
81 | # Used internally in the library | ||||
82 | LWP::Debug::trace('send()'); | ||||
83 | LWP::Debug::debug('url ok'); | ||||
84 | LWP::Debug::conns("read $n bytes: $data"); | ||||
85 | |||||
86 | =head1 DESCRIPTION | ||||
87 | |||||
88 | LWP::Debug provides tracing facilities. The trace(), debug() and | ||||
89 | conns() function are called within the library and they log | ||||
90 | information at increasing levels of detail. Which level of detail is | ||||
91 | actually printed is controlled with the C<level()> function. | ||||
92 | |||||
93 | The following functions are available: | ||||
94 | |||||
95 | =over 4 | ||||
96 | |||||
97 | =item level(...) | ||||
98 | |||||
99 | The C<level()> function controls the level of detail being | ||||
100 | logged. Passing '+' or '-' indicates full and no logging | ||||
101 | respectively. Individual levels can switched on and of by passing the | ||||
102 | name of the level with a '+' or '-' prepended. The levels are: | ||||
103 | |||||
104 | trace : trace function calls | ||||
105 | debug : print debug messages | ||||
106 | conns : show all data transfered over the connections | ||||
107 | |||||
108 | The LWP::Debug module provide a special import() method that allows | ||||
109 | you to pass the level() arguments with initial use statement. If a | ||||
110 | use argument start with '+' or '-' then it is passed to the level | ||||
111 | function, else the name is exported as usual. The following two | ||||
112 | statements are thus equivalent (if you ignore that the second pollutes | ||||
113 | your namespace): | ||||
114 | |||||
115 | use LWP::Debug qw(+); | ||||
116 | use LWP::Debug qw(level); level('+'); | ||||
117 | |||||
118 | =item trace($msg) | ||||
119 | |||||
120 | The C<trace()> function is used for tracing function | ||||
121 | calls. The package and calling subroutine name is | ||||
122 | printed along with the passed argument. This should | ||||
123 | be called at the start of every major function. | ||||
124 | |||||
125 | =item debug($msg) | ||||
126 | |||||
127 | The C<debug()> function is used for high-granularity | ||||
128 | reporting of state in functions. | ||||
129 | |||||
130 | =item conns($msg) | ||||
131 | |||||
132 | The C<conns()> function is used to show data being | ||||
133 | transferred over the connections. This may generate | ||||
134 | considerable output. | ||||
135 | |||||
136 | =back |