survey-manager/survey-nginx/cgi-bin/logger.pl

#!/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 = &timestamp();
	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;