#!/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;