# Copyright 2003-2004 by William G. Davis.
#
# This library is free software released under the terms of the GNU Lesser
# General Public License (LGPL), the full terms of which can be found in the
# "COPYING" file that comes with the distribution.
#
# This library is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.
#
# This class contains methods for generating and reporting diagnostic messages.
# You really don't need to be looking in here unless you plan on hacking
# Net::Gopher. See the POD for Net::Gopher new() and debug().
package Net::Gopher::Debugging;
use 5.005;
use strict;
use warnings;
use vars qw(@ISA $DEBUG $LOG $LOG_FILE $STARTED);
use Carp;
use Net::Gopher::Exception;
push(@ISA, 'Net::Gopher::Exception');
# is debugging turned on?
$DEBUG = 0;
# should the diagnostic messages be printed to a log file instead of to STDERR?
$LOG = 0;
# if logging is on, then this stores the name of the log file to use:
$LOG_FILE = undef;
# has the opening formatting for the debugging messages been printed yet?
$STARTED = 0;
################################################################################
#
# Method
# debug_print()
#
# Purpose
# This function prints out a formatted diagnostic message, either
# to STDERR or to the log file specified by $LOG_FILENAME.
#
# Parameters
# None.
#
sub debug_print
{
my $self = shift;
return unless ($DEBUG);
chomp(my $unformatted_message = shift);
my $message;
# make sure we print the opening message before anything else:
if ($STARTED)
{
# separate this message from the last one:
$message .= "\n";
}
else
{
# print the opening message:
$message .= sprintf("[%s]\n%s\n",
scalar localtime,
'=' x 80
);
$STARTED++;
}
my ($filename, $line) = (caller(0))[1, 2];
my $sub_name = (caller(1))[3];
$sub_name = '' unless (defined $sub_name);
$filename =~ s{.*[\\/:]}{}; # remove the path name
$sub_name =~ s{.*::}{}; # remove the package name
$message .= sprintf("(In %s at line %d%s)\n%s\n",
$filename,
$line,
($sub_name and $sub_name ne '__ANON__')
? ", $sub_name() function."
: '.',
$unformatted_message
);
if ($LOG)
{
open(LOG, ">> $LOG_FILE")
or return Net::Gopher::Exception->call_die(
"Couldn't open debug log ($LOG_FILE): $!."
);
print LOG $message;
close LOG;
}
else
{
print STDERR $message;
}
}
sub debug
{
my $self = shift;
if (@_)
{
if (shift @_)
{
$DEBUG = 1;
}
else
{
$DEBUG = 0;
$LOG = 0;
}
}
else
{
return $DEBUG;
}
}
sub log_file
{
my $self = shift;
if (@_)
{
$LOG_FILE = shift;
$LOG = 1 if (defined $LOG_FILE);
}
else
{
return $LOG_FILE;
}
}
END {
return unless ($DEBUG and $STARTED);
my $message = "\n". '=' x 80 . "\n\n";
if ($LOG)
{
open(LOG, ">> $LOG_FILE")
or return Net::Gopher::Exception->call_die(
"Couldn't open debug log ($LOG_FILE): $!."
);
print LOG $message;
close LOG;
}
else
{
print STDERR $message;
}
}
1;
syntax highlighted by Code2HTML, v. 0.9.1