#!/usr/bin/perl -w # # $Id: logger.pl,v 1.2 2004/01/13 19:22:04 jeffo Exp $ # 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. # my $outputMasterSwitches = { 'ERROR' => 1, 'USERERROR' => 1, 'INFO' => 0, 'WARNING' => 0, 'DEBUG' => 0, 'TRACE' => 0, }; # # These can be turned on/off from the code at various points. # The values below are application initialization values. # my $outputSwitches = \%$outputMasterSwitches; # # Set this switch to 1 to enable all output, or set it to 0 to disable # all output. # my $masterOutputSwitch = 1; sub switch { my ($switch,$value) = @_; if ( defined($value) ) { $outputSwitches->{$switch} = $value; } return $outputSwitches->{$switch}; } sub masterSwitch { my ($switch,$value) = @_; if ( defined($value) ) { $outputMasterSwitches->{$switch} = $value; } return $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 { my $label = shift; return if ( ! $masterOutputSwitch || ! (switch($label) && masterSwitch($label) ) ); my $show_backtrace = shift; my $timestamp = ×tamp(); my $pidstamp = "[pid $$]"; my $ip = $ENV{'REMOTE_ADDR'}; 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 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;