—package
Debug::STDERR;
use
strict;
use
warnings;
use
Carp;
use
Data::Dumper;
our
@EXPORT
=
qw(debug)
;
our
$VERSION
=
'0.00003'
;
if
(DEBUG_FLAG) {
# debug method
*debug
=
sub
{
my
$message
=
shift
;
my
$hashref
=
shift
;
STDERR
"-"
x 120,
"\n"
;
# timestamp
my
(
$sec
,
$microsec
) = gettimeofday;
my
$date
= strftime(
'%Y-%m-%d %H:%M:%S'
,
localtime
(
$sec
) );
STDERR
"$date $microsec\t"
;
# caller info
my
(
$package
,
$filename
,
$line
,
$subroutine
) =
caller
();
STDERR
"$subroutine\n"
if
$subroutine
;
STDERR
" FROM : $package of $filename line $line\n"
;
# output message
STDERR
" MESSAGE : "
,
$message
,
"\n"
;
if
(
ref
(
$hashref
) eq
"HASH"
) {
STDERR
" DUMPER :\n"
;
STDERR
" "
, Dumper(
$hashref
);
}
};
# save and redirect STDERR out to log file
if
(
my
$logfile
=
$ENV
{STDERR2LOG} ) {
no
warnings;
open
( SAVEERR,
"<&STDERR"
) || confess
"Cannot open SAVEERR"
;
open
( STDERR,
">$logfile"
) || confess
"Cannot open $logfile"
;
$|++;
}
}
else
{
# do nothing
*debug
=
sub
{ };
}
1;
__END__
=head1 NAME
Debug::STDERR - provide debug() method and redirect STDERR.
=head1 SYNOPSIS
use strict;
use warnings;
# set environment variables, or set and export it for your shell
BEGIN {
$ENV{DEBUG} = 1;
$ENV{STDERR2LOG} = "log.out";
}
use Debug::STDERR;
debug( "foo" => { bar => "baz" });
=head1 DESCRIPTION
Debug::STDERR provides debug() method and redirect STDERR out to a file.
If you want to use it, you should set tow environment variables for your shell.
$ export DEBUG=1
$ export STDERR2LOG=log.out
or edit $ENV on BEGIN block. ( you must put it on before the line 'use Debug::STDERR;' )
If you set only 'DEBUG' variable, the debug messages out to STDERR.
Furthermore if you set 'STDERR2LOG' variable, the data for STDERR will be redirect to log file.
=head1 OUTPUT SAMPLE
# sample code
use strict;
use warnings;
use LWP::UserAgent;
BEGIN {
$ENV{DEBUG} = 1;
}
use Debug::STDERR;
my $ua = LWP::UserAgent->new;
debug( my_debug => { ua => $ua } );
# output sample
------------------------------------------------------------------------------------------------------------------------
2009-05-21 15:12:07 511529 FROM : main of test.pl line 9
MESSAGE : my_debug
DUMPER :
$VAR1 = {
'ua' => bless( {
'max_redirect' => 7,
'protocols_forbidden' => undef,
'show_progress' => undef,
'handlers' => {
'response_header' => bless( [
{
'owner' => 'LWP::UserAgent::parse_head',
'callback' => sub { "DUMMY" },
'm_media_type' => 'html',
'line' => '/usr/local/lib/perl5/site_perl/5.10.0/LWP/UserAgent.pm:608'
}
], 'HTTP::Config' )
},
'no_proxy' => [],
'protocols_allowed' => undef,
'use_eval' => 1,
'requests_redirectable' => [
'GET',
'HEAD'
],
'timeout' => 180,
'def_headers' => bless( {
'user-agent' => 'libwww-perl/5.826'
}, 'HTTP::Headers' ),
'proxy' => {},
'max_size' => undef
}, 'LWP::UserAgent' )
};
=head1 METHOD
=head2 debug($label => \%hash)
=head1 AUTHOR
takeshi miki E<lt>miki@cpan.orgE<gt>
=head1 LICENSE
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 SEE ALSO
=cut