1 | package LWP::Debug; # legacy
|
---|
2 |
|
---|
3 | require Exporter;
|
---|
4 | @ISA = qw(Exporter);
|
---|
5 | @EXPORT_OK = qw(level trace debug conns);
|
---|
6 |
|
---|
7 | use Carp ();
|
---|
8 |
|
---|
9 | my @levels = qw(trace debug conns);
|
---|
10 | %current_level = ();
|
---|
11 |
|
---|
12 |
|
---|
13 | sub import
|
---|
14 | {
|
---|
15 | my $pack = shift;
|
---|
16 | my $callpkg = caller(0);
|
---|
17 | my @symbols = ();
|
---|
18 | my @levels = ();
|
---|
19 | for (@_) {
|
---|
20 | if (/^[-+]/) {
|
---|
21 | push(@levels, $_);
|
---|
22 | }
|
---|
23 | else {
|
---|
24 | push(@symbols, $_);
|
---|
25 | }
|
---|
26 | }
|
---|
27 | Exporter::export($pack, $callpkg, @symbols);
|
---|
28 | level(@levels);
|
---|
29 | }
|
---|
30 |
|
---|
31 |
|
---|
32 | sub level
|
---|
33 | {
|
---|
34 | for (@_) {
|
---|
35 | if ($_ eq '+') { # all on
|
---|
36 | # switch on all levels
|
---|
37 | %current_level = map { $_ => 1 } @levels;
|
---|
38 | }
|
---|
39 | elsif ($_ eq '-') { # all off
|
---|
40 | %current_level = ();
|
---|
41 | }
|
---|
42 | elsif (/^([-+])(\w+)$/) {
|
---|
43 | $current_level{$2} = $1 eq '+';
|
---|
44 | }
|
---|
45 | else {
|
---|
46 | Carp::croak("Illegal level format $_");
|
---|
47 | }
|
---|
48 | }
|
---|
49 | }
|
---|
50 |
|
---|
51 |
|
---|
52 | sub trace { _log(@_) if $current_level{'trace'}; }
|
---|
53 | sub debug { _log(@_) if $current_level{'debug'}; }
|
---|
54 | sub conns { _log(@_) if $current_level{'conns'}; }
|
---|
55 |
|
---|
56 |
|
---|
57 | sub _log
|
---|
58 | {
|
---|
59 | my $msg = shift;
|
---|
60 | $msg .= "\n" unless $msg =~ /\n$/; # ensure trailing "\n"
|
---|
61 |
|
---|
62 | my($package,$filename,$line,$sub) = caller(2);
|
---|
63 | print STDERR "$sub: $msg";
|
---|
64 | }
|
---|
65 |
|
---|
66 | 1;
|
---|
67 |
|
---|
68 | __END__
|
---|
69 |
|
---|
70 | =head1 NAME
|
---|
71 |
|
---|
72 | LWP::Debug - deprecated
|
---|
73 |
|
---|
74 | =head1 DESCRIPTION
|
---|
75 |
|
---|
76 | LWP::Debug used to provide tracing facilities, but these are not used
|
---|
77 | by LWP any more. The code in this module is kept around
|
---|
78 | (undocumented) so that 3rd party code that happen to use the old
|
---|
79 | interfaces continue to run.
|
---|
80 |
|
---|
81 | One useful feature that LWP::Debug provided (in an imprecise and
|
---|
82 | troublesome way) was network traffic monitoring. The following
|
---|
83 | section provide some hints about recommened replacements.
|
---|
84 |
|
---|
85 | =head2 Network traffic monitoring
|
---|
86 |
|
---|
87 | The best way to monitor the network traffic that LWP generates is to
|
---|
88 | use an external TCP monitoring program. The Wireshark program
|
---|
89 | (L<http://www.wireshark.org/>) is higly recommended for this.
|
---|
90 |
|
---|
91 | Another approach it to use a debugging HTTP proxy server and make
|
---|
92 | LWP direct all its traffic via this one. Call C<< $ua->proxy >> to
|
---|
93 | set it up and then just use LWP as before.
|
---|
94 |
|
---|
95 | For less precise monitoring needs just setting up a few simple
|
---|
96 | handlers might do. The following example sets up handlers to dump the
|
---|
97 | request and response objects that pass through LWP:
|
---|
98 |
|
---|
99 | use LWP::UserAgent;
|
---|
100 | $ua = LWP::UserAgent->new;
|
---|
101 | $ua->default_header('Accept-Encoding' => scalar HTTP::Message::decodable());
|
---|
102 |
|
---|
103 | $ua->add_handler("request_send", sub { shift->dump; return });
|
---|
104 | $ua->add_handler("response_done", sub { shift->dump; return });
|
---|
105 |
|
---|
106 | $ua->get("http://www.example.com");
|
---|
107 |
|
---|
108 | =head1 SEE ALSO
|
---|
109 |
|
---|
110 | L<LWP::UserAgent>
|
---|