line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
use strict; |
3
|
6
|
|
|
6
|
|
93494
|
use warnings; |
|
6
|
|
|
|
|
37
|
|
|
6
|
|
|
|
|
144
|
|
4
|
6
|
|
|
6
|
|
25
|
|
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
202
|
|
5
|
|
|
|
|
|
|
our $VERSION = '0.000044'; |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
use HTTP::Request (); |
8
|
6
|
|
|
6
|
|
1444
|
use HTTP::Response (); |
|
6
|
|
|
|
|
58520
|
|
|
6
|
|
|
|
|
92
|
|
9
|
6
|
|
|
6
|
|
1990
|
use LWP::ConsoleLogger (); |
|
6
|
|
|
|
|
29528
|
|
|
6
|
|
|
|
|
101
|
|
10
|
6
|
|
|
6
|
|
2423
|
use Module::Load::Conditional qw( can_load ); |
|
6
|
|
|
|
|
26
|
|
|
6
|
|
|
|
|
211
|
|
11
|
6
|
|
|
6
|
|
2947
|
use Sub::Exporter -setup => { exports => ['debug_ua'] }; |
|
6
|
|
|
|
|
88043
|
|
|
6
|
|
|
|
|
401
|
|
12
|
6
|
|
|
6
|
|
51
|
use String::Trim qw( trim ); |
|
6
|
|
|
|
|
17
|
|
|
6
|
|
|
|
|
100
|
|
13
|
6
|
|
|
6
|
|
5753
|
|
|
6
|
|
|
|
|
3122
|
|
|
6
|
|
|
|
|
2732
|
|
14
|
|
|
|
|
|
|
my %VERBOSITY = ( |
15
|
|
|
|
|
|
|
dump_content => 8, |
16
|
|
|
|
|
|
|
dump_cookies => 6, |
17
|
|
|
|
|
|
|
dump_headers => 5, |
18
|
|
|
|
|
|
|
dump_params => 4, |
19
|
|
|
|
|
|
|
dump_status => 2, |
20
|
|
|
|
|
|
|
dump_text => 7, |
21
|
|
|
|
|
|
|
dump_title => 3, |
22
|
|
|
|
|
|
|
dump_uri => 1, |
23
|
|
|
|
|
|
|
); |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
my $ua = shift; |
26
|
|
|
|
|
|
|
my $level = shift; |
27
|
22
|
|
|
22
|
1
|
455860
|
$level //= 10; |
28
|
22
|
|
|
|
|
45
|
|
29
|
22
|
|
100
|
|
|
175
|
my %args = map { $_ => $VERBOSITY{$_} <= $level } keys %VERBOSITY; |
30
|
|
|
|
|
|
|
my $console_logger = LWP::ConsoleLogger->new(%args); |
31
|
22
|
|
|
|
|
128
|
|
|
176
|
|
|
|
|
407
|
|
32
|
22
|
|
|
|
|
618
|
add_ua_handlers( $ua, $console_logger ); |
33
|
|
|
|
|
|
|
|
34
|
22
|
|
|
|
|
1594
|
if ( can_load( modules => { 'HTML::FormatText::Lynx' => 23 } ) ) { |
35
|
|
|
|
|
|
|
$console_logger->text_pre_filter( |
36
|
22
|
50
|
|
|
|
476
|
sub { |
37
|
|
|
|
|
|
|
my $text = shift; |
38
|
|
|
|
|
|
|
my $content_type = shift; |
39
|
14
|
|
|
14
|
|
6787
|
my $base_url = shift; |
40
|
14
|
|
|
|
|
31
|
|
41
|
14
|
|
|
|
|
41
|
return $text |
42
|
|
|
|
|
|
|
unless $content_type && $content_type =~ m{html}i; |
43
|
14
|
100
|
66
|
|
|
183
|
|
44
|
|
|
|
|
|
|
return ( |
45
|
|
|
|
|
|
|
trim( |
46
|
|
|
|
|
|
|
HTML::FormatText::Lynx->format_string( |
47
|
9
|
|
|
|
|
172
|
$text, |
48
|
|
|
|
|
|
|
base => $base_url, |
49
|
|
|
|
|
|
|
) |
50
|
|
|
|
|
|
|
), |
51
|
|
|
|
|
|
|
'text/plain' |
52
|
|
|
|
|
|
|
); |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
); |
55
|
|
|
|
|
|
|
} |
56
|
22
|
|
|
|
|
213367
|
|
57
|
|
|
|
|
|
|
return $console_logger; |
58
|
|
|
|
|
|
|
} |
59
|
22
|
|
|
|
|
792
|
|
60
|
|
|
|
|
|
|
my $ua = shift; |
61
|
|
|
|
|
|
|
my $console_logger = shift; |
62
|
|
|
|
|
|
|
|
63
|
22
|
|
|
22
|
1
|
62
|
if ( $ua->isa('Test::WWW::Mechanize::Mojo') ) { |
64
|
22
|
|
|
|
|
44
|
$ua = $ua->tester->ua; |
65
|
|
|
|
|
|
|
} |
66
|
22
|
50
|
|
|
|
376
|
if ( $ua->isa('Mojo::UserAgent') ) { |
67
|
0
|
|
|
|
|
0
|
$ua->on( |
68
|
|
|
|
|
|
|
'start', |
69
|
22
|
100
|
|
|
|
186
|
sub { |
70
|
|
|
|
|
|
|
my $the_ua = shift; |
71
|
|
|
|
|
|
|
my $tx = shift; |
72
|
|
|
|
|
|
|
|
73
|
6
|
|
|
6
|
|
70029
|
my $request = HTTP::Request->parse( $tx->req->to_string ); |
74
|
6
|
|
|
|
|
12
|
$console_logger->request_callback( |
75
|
|
|
|
|
|
|
$request, |
76
|
6
|
|
|
|
|
38
|
$the_ua, |
77
|
6
|
|
|
|
|
5977
|
); |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
$tx->on( |
80
|
|
|
|
|
|
|
'finish', |
81
|
|
|
|
|
|
|
sub { |
82
|
|
|
|
|
|
|
my $tx = shift; |
83
|
|
|
|
|
|
|
my $res |
84
|
|
|
|
|
|
|
= HTTP::Response->parse( $tx->res->to_string ); |
85
|
1
|
|
|
|
|
14541
|
$res->request($request); |
86
|
1
|
|
|
|
|
4
|
$console_logger->response_callback( $res, $the_ua ); |
87
|
|
|
|
|
|
|
} |
88
|
1
|
|
|
|
|
642
|
); |
89
|
1
|
|
|
|
|
13
|
} |
90
|
|
|
|
|
|
|
); |
91
|
6
|
|
|
|
|
162
|
return; |
92
|
|
|
|
|
|
|
} |
93
|
7
|
|
|
|
|
108
|
|
94
|
7
|
|
|
|
|
89
|
$ua->add_handler( |
95
|
|
|
|
|
|
|
'response_done', |
96
|
|
|
|
|
|
|
sub { $console_logger->response_callback(@_) } |
97
|
|
|
|
|
|
|
); |
98
|
|
|
|
|
|
|
$ua->add_handler( |
99
|
17
|
|
|
17
|
|
321729
|
'request_send', |
100
|
15
|
|
|
|
|
149
|
sub { $console_logger->request_callback(@_) } |
101
|
|
|
|
|
|
|
); |
102
|
|
|
|
|
|
|
} |
103
|
17
|
|
|
17
|
|
182275
|
|
104
|
15
|
|
|
|
|
482
|
1; |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=pod |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=encoding UTF-8 |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=head1 NAME |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
LWP::ConsoleLogger::Easy - Easy LWP tracing and debugging |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=head1 VERSION |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
version 0.000044 |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=head1 SYNOPSIS |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
use LWP::ConsoleLogger::Easy qw( debug_ua ); |
121
|
|
|
|
|
|
|
use WWW::Mechanize; |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
my $mech = WWW::Mechanize->new; |
124
|
|
|
|
|
|
|
my $logger = debug_ua( $mech ); |
125
|
|
|
|
|
|
|
$mech->get('https://google.com'); |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# now watch the console for debugging output |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
# ... |
130
|
|
|
|
|
|
|
# stop dumping headers |
131
|
|
|
|
|
|
|
$logger->dump_headers( 0 ); |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
# Redact sensitive data |
134
|
|
|
|
|
|
|
$ENV{LWPCL_REDACT_HEADERS} = 'Authorization,Foo,Bar'; |
135
|
|
|
|
|
|
|
$ENV{LWPCL_REDACT_PARAMS} = 'seekrit,password,credit_card'; |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
my $quiet_logger = debug_ua( $mech, 1 ); |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
my $noisy_logger = debug_ua( $mech, 5 ); |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=head1 DESCRIPTION |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
This module gives you the easiest possible introduction to |
144
|
|
|
|
|
|
|
L<LWP::ConsoleLogger>. It offers one wrapper around L<LWP::ConsoleLogger>: |
145
|
|
|
|
|
|
|
C<debug_ua>. This function allows you to get up and running quickly with just |
146
|
|
|
|
|
|
|
a couple of lines of code. It instantiates user-agent logging and also returns |
147
|
|
|
|
|
|
|
a L<LWP::ConsoleLogger> object, which you may then tweak to your heart's |
148
|
|
|
|
|
|
|
desire. |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
If you're able to install L<HTML::FormatText::Lynx> then you'll get highly |
151
|
|
|
|
|
|
|
readable HTML to text conversions. |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=head1 FUNCTIONS |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=head2 debug_ua( $mech, $verbosity ) |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
When called without a verbosity argument, this function turns on all logging. |
158
|
|
|
|
|
|
|
I'd suggest going with this to start with and then turning down the verbosity |
159
|
|
|
|
|
|
|
after that. This method returns an L<LWP::ConsoleLogger> object, which you |
160
|
|
|
|
|
|
|
may tweak to your heart's desire. |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
my $ua_logger = debug_ua( $ua ); |
163
|
|
|
|
|
|
|
$ua_logger->content_pre_filter( sub {...} ); |
164
|
|
|
|
|
|
|
$ua_logger->logger( Log::Dispatch->new(...) ); |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
$ua->get(...); |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
C<$ua> may be one of several user-agents, including C<LWP::UserAgent>, |
169
|
|
|
|
|
|
|
C<Mojo::UserAgent>, and C<WWW::Mechanize>. |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
You can provide a verbosity level of 0 or more. (Currently 0 - 8 supported.) |
172
|
|
|
|
|
|
|
This will turn up the verbosity on your output gradually. A verbosity of 0 |
173
|
|
|
|
|
|
|
will display nothing. 8 will display all available outputs. |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# don't get too verbose |
176
|
|
|
|
|
|
|
my $ua_logger = debug_ua( $ua, 4 ); |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=head2 add_ua_handlers |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
This method sets up response and request handlers on your user agent. This is |
181
|
|
|
|
|
|
|
done for you automatically if you're using C<debug_ua>. |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=head1 ENVIRONMENT VARIABLES |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
=head2 LWPCL_REDACT_HEADERS |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
A comma-separated list of header values to redact from output. |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
$ENV{LWPCL_REDACT_HEADERS} = 'Authorization,Foo,Bar'; |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
Output will be something like: |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
.----------------+------------------. |
194
|
|
|
|
|
|
|
| Request Header | Value | |
195
|
|
|
|
|
|
|
+----------------+------------------+ |
196
|
|
|
|
|
|
|
| Authorization | [REDACTED] | |
197
|
|
|
|
|
|
|
| Content-Length | 0 | |
198
|
|
|
|
|
|
|
| User-Agent | libwww-perl/6.15 | |
199
|
|
|
|
|
|
|
'----------------+------------------' |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
Use at the command line. |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
LWPCL_REDACT_HEADERS='Authorization,Foo,Bar' perl script.pl |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=head2 LWPCL_REDACT_PARAMS |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
A comma-separated list of parameter values to redact from output. |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
$ENV{LWPCL_REDACT_PARAMS} = 'credit_card,foo,bar'; |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
Use at the command line. |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
LWPCL_REDACT_PARAMS='credit_card,foo,bar' perl script.pl |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
.-------------+------------. |
216
|
|
|
|
|
|
|
| Key | Value | |
217
|
|
|
|
|
|
|
+-------------+------------+ |
218
|
|
|
|
|
|
|
| credit_card | [REDACTED] | |
219
|
|
|
|
|
|
|
'-------------+------------' |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=head2 CAVEATS |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
Text formatting now defaults to attempting to use L<HTML::FormatText::Lynx> to |
224
|
|
|
|
|
|
|
format HTML as text. If you do not have this installed, we'll fall back to |
225
|
|
|
|
|
|
|
using HTML::Restrict to remove any HTML tags which you have not specifically |
226
|
|
|
|
|
|
|
whitelisted. |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
If you have L<HTML::FormatText::Lynx> installed, but you don't want to use it, |
229
|
|
|
|
|
|
|
override the default filter: |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
my $logger = debug_ua( $mech ); |
232
|
|
|
|
|
|
|
$logger->text_pre_filter( sub { return shift } ); |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=head2 EXAMPLES |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
Please see the "examples" folder in this distribution for more ideas on how to |
237
|
|
|
|
|
|
|
use this module. |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
=head1 AUTHOR |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
Olaf Alders <olaf@wundercounter.com> |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
This software is Copyright (c) 2014 by MaxMind, Inc. |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
This is free software, licensed under: |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
The Artistic License 2.0 (GPL Compatible) |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
=cut |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
# ABSTRACT: Easy LWP tracing and debugging |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
# ABSTRACT: Start logging your LWP useragent the easy way. |