1
package LWP::DebugFile;
3
# $Id: DebugFile.pm,v 1.3 2003/10/23 18:56:01 uid39246 Exp $
8
use vars qw($outname $outpath @ISA $last_message_time);
11
_init() unless $^C or !caller;
12
$LWP::Debug::current_level{'conns'} = 1;
17
$outpath = $ENV{'LWPDEBUGPATH'} || ''
18
unless defined $outpath;
19
$outname = $ENV{'LWPDEBUGFILE'} ||
20
sprintf "%slwp_%x_%x.log", $outpath, $^T,
21
defined( &Win32::GetTickCount )
22
? (Win32::GetTickCount() & 0xFFFF)
24
# Using $$ under Win32 isn't nice, because the OS usually
25
# reuses the $$ value almost immediately!! So the lower
26
# 16 bits of the uptime tick count is a great substitute.
27
unless defined $outname;
29
open LWPERR, ">>$outname" or die "Can't write-open $outname: $!";
33
my $x = select(LWPERR);
38
$last_message_time = time();
39
die "Can't print to LWPERR"
40
unless print LWPERR "\n# ", __PACKAGE__, " logging to $outname\n";
41
# check at least the first print, just for sanity's sake!
43
print LWPERR "# Time now: \{$last_message_time\} = ",
44
scalar(localtime($last_message_time)), "\n";
46
LWP::Debug::level($ENV{'LWPDEBUGLEVEL'} || '+');
51
BEGIN { # So we don't get redefinition warnings...
52
undef &LWP::Debug::conns;
53
undef &LWP::Debug::_log;
57
sub LWP::Debug::conns {
58
if($LWP::Debug::current_level{'conns'}) {
62
while($msg =~ m/([^\n\r]*[\n\r]*)/g) {
63
next unless length($line = $1);
65
$line =~ s/([^\x20\x21\x23-\x7a\x7c\x7e])/
66
(ord($1)<256) ? sprintf('\x%02X',ord($1))
67
: sprintf('\x{%x}',ord($1))
69
LWP::Debug::_log("S>$prefix \"$line\"");
79
$msg .= "\n" unless $msg =~ /\n$/; # ensure trailing "\n"
81
my($package,$filename,$line,$sub) = caller(2);
82
unless((my $this_time = time()) == $last_message_time) {
83
print LWPERR "# Time now: \{$this_time\} = ",
84
scalar(localtime($this_time)), "\n";
85
$last_message_time = $this_time;
87
print LWPERR "$sub: $msg";
97
LWP::DebugFile - routines for tracing/debugging LWP
101
If you want to see just what LWP is doing when your program calls it,
102
add this to the beginning of your program's source:
106
For even more verbose debug output, do this instead:
108
use LWP::DebugFile ('+');
112
This module is like LWP::Debug in that it allows you to see what your
113
calls to LWP are doing behind the scenes. But it is unlike
114
L<LWP::Debug|LWP::Debug> in that it sends the output to a file, instead
115
of to STDERR (as LWP::Debug does).
119
The options you can use in C<use LWP::DebugFile (I<options>)> are the
120
same as the B<non-exporting> options available from C<use LWP::Debug
121
(I<options>)>. That is, you can do things like this:
123
use LWP::DebugFile qw(+);
124
use LWP::Debug qw(+ -conns);
125
use LWP::Debug qw(trace);
127
The meanings of these are explained in the
128
L<documentation for LWP::Debug|LWP::Debug>.
129
The only differences are that by default, LWP::DebugFile has C<cons>
130
debugging on, ad that (as mentioned earlier), only C<non-exporting>
131
options are available. That is, you B<can't> do this:
133
use LWP::DebugFile qw(trace); # wrong
135
You might expect that to export LWP::Debug's C<trace()> function,
136
but it doesn't work -- it's a compile-time error.
138
=head1 OUTPUT FILE NAMING
140
If you don't do anything, the output file (where all the LWP debug/trace
141
output goes) will be in the current directory, and will be named like
142
F<lwp_3db7aede_b93.log>, where I<3db7aede> is C<$^T> expressed in hex,
143
and C<b93> is C<$$> expressed in hex. Presumably this is a
144
unique-for-all-time filename!
146
If you don't want the files to go in the current directory, you
147
can set C<$LWP::DebugFile::outpath> before you load the LWP::DebugFile
150
BEGIN { $LWP::DebugFile::outpath = '/tmp/crunk/' }
153
Note that you must end the value with a path separator ("/" in this
154
case -- under MacPerl it would be ":"). With that set, you will
155
have output files named like F</tmp/crunk/lwp_3db7aede_b93.log>.
157
If you want the LWP::DebugFile output to go a specific filespec (instead
158
of just a uniquely named file, in whatever directory), instead set the
159
variable C<$LWP::DebugFile::outname>, like so:
161
BEGIN { $LWP::DebugFile::outname = '/home/mojojojo/lwp.log' }
164
In that case, C<$LWP::DebugFile::outpath> isn't consulted at all, and
165
output is always written to the file F</home/mojojojo/lwp.log>.
167
Note that the value of C<$LWP::DebugFile::outname> doesn't need to
168
be an absolute filespec. You can do this:
170
BEGIN { $LWP::DebugFile::outname = 'lwp.log' }
173
In that case, output goes to a file named F<lwp.log> in the current
174
directory -- specifically, whatever directory is current when
175
LWP::DebugFile is first loaded. C<$LWP::DebugFile::outpath> is still not
176
consulted -- its value is used only if C<$LWP::DebugFile::outname>
182
If you set the environment variables C<LWPDEBUGPATH> or
183
C<LWPDEBUGFILE>, their values will be used in initializing the
184
values of C<$LWP::DebugFile::outpath>
185
and C<$LWP::DebugFile::outname>.
187
That is, if you have C<LWPDEBUGFILE> set to F</home/mojojojo/lwp.log>,
188
then you can just start out your program with:
192
and it will act as if you had started it like this:
194
BEGIN { $LWP::DebugFile::outname = '/home/mojojojo/lwp.log' }
197
=head1 IMPLEMENTATION NOTES
199
This module works by subclassing C<LWP::Debug>, (notably inheriting its
200
C<import>). It also redefines C<&LWP::Debug::conns> and
201
C<&LWP::Debug::_log> to make for output that is a little more verbose,
202
and friendlier for when you're looking at it later in a log file.
208
=head1 COPYRIGHT AND DISCLAIMERS
210
Copyright (c) 2002 Sean M. Burke.
212
This library is free software; you can redistribute it and/or modify it
213
under the same terms as Perl itself.
215
This program is distributed in the hope that it will be useful, but
216
without any warranty; without even the implied warranty of
217
merchantability or fitness for a particular purpose.
221
Sean M. Burke C<sburke@cpan.org>
added
removed
lib/LWP/DebugFile.pm
