You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
151 lines
3.9 KiB
151 lines
3.9 KiB
#!/usr/bin/perl -w
|
|
#
|
|
# $Id: logger.pm,v 1.1.1.1 2004/01/09 09:22:07 jeffo Exp $
|
|
#
|
|
# $Source: /usr/local/cvsroot/Testmanager/cgi-bin/logger.pm,v $
|
|
#
|
|
#############################################################################
|
|
# #
|
|
# COPYRIGHT NOTICE #
|
|
# #
|
|
# This code was written by Ed Loehr, all rights reserved, 1999. You are #
|
|
# hereby granted a non-exclusive license to do whatever you want with #
|
|
# this code, including modification and redistribution, so long as you #
|
|
# retain this copyright notice in the code and do not attempt to prevent #
|
|
# anyone else from the same privileges. #
|
|
# #
|
|
# ALL SOFTWARE HAS BUGS. THIS CODE COMES "AS-IS" WITH ABSOLUTELY NO #
|
|
# WARRANTY OR GUARANTEE OF ITS FITNESS FOR ANY PURPOSE WHATSOEVER. #
|
|
# BY INCORPORATING THIS CODE, YOU ASSUME COMPLETE RISK FOR ANY #
|
|
# CONSEQUENCES AND AGREE NOT TO BRING ANY GRIEVANCE OR LIABILITTY #
|
|
# CLAIMS WHATSOVER AGAINST Ed Loehr. #
|
|
# #
|
|
#############################################################################
|
|
package logger;
|
|
|
|
use strict;
|
|
use Carp qw(cluck);
|
|
use Time::HiRes;
|
|
|
|
#
|
|
# These are only turned on/off here and override the other switches.
|
|
# The values below are application-lifetime override values.
|
|
#
|
|
$logger::outputMasterSwitches = {
|
|
'ERROR' => 1,
|
|
'USERERROR' => 1,
|
|
'INFO' => 1,
|
|
'WARNING' => 1,
|
|
'DEBUG' => 1,
|
|
'TRACE' => 1,
|
|
};
|
|
|
|
#
|
|
# These can be turned on/off from the code at various points.
|
|
# The values below are application initialization values.
|
|
#
|
|
$logger::outputSwitches = \%$logger::outputMasterSwitches;
|
|
|
|
#
|
|
# Set this switch to 1 to enable all output, or set it to 0 to disable
|
|
# all output.
|
|
#
|
|
$logger::masterOutputSwitch = 1;
|
|
|
|
sub switch {
|
|
my ($switch,$value) = @_;
|
|
if ( defined($value) ) {
|
|
$logger::outputSwitches->{$switch} = $value;
|
|
}
|
|
return $logger::outputSwitches->{$switch};
|
|
}
|
|
|
|
sub masterSwitch {
|
|
my ($switch,$value) = @_;
|
|
if ( defined($value) ) {
|
|
$logger::outputMasterSwitches->{$switch} = $value;
|
|
}
|
|
return $logger::outputMasterSwitches->{$switch};
|
|
}
|
|
|
|
sub debugOn() {
|
|
return switch("DEBUG");
|
|
}
|
|
|
|
sub setDebugOn() {
|
|
return switch("DEBUG", 1);
|
|
}
|
|
|
|
sub setDebugOff() {
|
|
return switch("DEBUG", 0);
|
|
}
|
|
|
|
sub timestamp() {
|
|
my ($seconds, $microseconds) = Time::HiRes::gettimeofday();
|
|
my $s = scalar(localtime($seconds));
|
|
my $us = sprintf(".%03d ",$microseconds/1000);
|
|
my $stamp = substr($s,0,19).$us.substr($s,20);
|
|
return $stamp;
|
|
}
|
|
|
|
|
|
sub _logit {
|
|
#};
|
|
|
|
#sub old_logit {
|
|
my $label = shift;
|
|
return if ( ! $logger::masterOutputSwitch || ! (switch($label) && masterSwitch($label) ) );
|
|
my $show_backtrace = shift;
|
|
my $timestamp = ×tamp();
|
|
my $pidstamp = "[pid $$]";
|
|
my $ip = $ENV{'REMOTE_ADDR'} || "127.0.0.1";
|
|
my $message = sprintf("%s", "$timestamp $ip [$$] $label: ".join(' ',@_));
|
|
chomp $message;
|
|
$message .= "\n";
|
|
if ( $show_backtrace ) {
|
|
# This excludes these logging functions from the backtrace...
|
|
$Carp::CarpLevel = 2;
|
|
cluck $message;
|
|
$Carp::CarpLevel = 0;
|
|
} else {
|
|
print STDERR $message;
|
|
}
|
|
|
|
return $message;
|
|
}
|
|
|
|
sub logerr {
|
|
return &_logit("ERROR", 1, @_);
|
|
}
|
|
|
|
# Log user/operator error ...
|
|
sub loguerr {
|
|
return &_logit("USERERROR", 0, @_);
|
|
}
|
|
|
|
sub logmsg {
|
|
return &_logit("INFO", 0, @_);
|
|
}
|
|
|
|
sub logquery {
|
|
return &_logit("QUERY", 0, @_);
|
|
}
|
|
|
|
sub loginfo {
|
|
return logmsg(@_);
|
|
}
|
|
|
|
sub logwarn {
|
|
return &_logit("WARNING", 1, @_);
|
|
}
|
|
|
|
sub logdbg {
|
|
my ($pkg, $file, $line) = caller(0);
|
|
return &_logit("DEBUG", 0, @_, " (logged at $pkg::$file line $line)");
|
|
}
|
|
|
|
sub logbt {
|
|
return &_logit("TRACE", 1, @_);
|
|
}
|
|
|
|
1;
|
|
|