CGI::Log - Perl extension for centralized logging of debug, error, status and success messages from scripts or other modules.

CGI-Log documentation Contained in the CGI-Log distribution.

Index

Code Index:

NAME

Top

CGI::Log - Perl extension for centralized logging of debug, error, status and success messages from scripts or other modules.

SYNOPSIS

Top

  use CGI::Log;

  Log->debug("user: $user");		## add messages
  Log->status("Welcome $user.");
  Log->error("I'm sorry $user, but you do not have access to that area.");

  @msg = Log->get_debug();		## get messages
  @msg = Log->get_error();
  @msg = Log->get_error("UI");
  @msg = Log->get_status();

  Log->is_error;			## test for messages
  Log->is_status;
  Log->is_success;

  Log->debug_off;		## causes print() and debug() to be skipped

  Log->print();			## outputs debug and error logs in HTML
  Log->clear;			## clear all entries (current pid)

  Log->_report;			## reports the sizes of the arrays (lengths)
  Log->ui_no_error();		## turns off inclusion of $! in user error messages

DESCRIPTION

Top

This module acts as a central repository for debug, status and error messages. It instantiates itself automatically (if it needs to) so you can access the Log object functions from anywhere in you code including other modules/objects with a simple consistent syntax.

It was written for CGI and mod_perl programming, but it could easily be used in any perl script where there is a need for centralized logging. (The only function which is CGI specific is print() since it outputs the debug and error logs with HTML formatting.)

It was originally written to just hold debugging information, but it has been extended to hold information that you might want to return to the user (i.e. the user-interface).

It is designed to be very painless to use. Add the following to any script or module where you want to log messages:

	use CGI::Log;

The CGI::Log:: namespace has been aliased to Log:: in order to save a bit of typing when adding debugging messages. So, to add a debug message, enter:

	Log->debug("Your message here.");
	## note: this is equivalent to CGI::Log->debug();

To add an error message:

	Log->error("Some information about the error goes here.");

To add an success, or status message:

	Log->status("A status or informational message for the user.");
	Log->success("Something worked properly.");

The following commands all retrieve the messages you've logged:

	@msg = Log->get_debug;
	@msg = Log->get_error;
	@msg = Log->get_error("UI");
	@msg = Log->get_status;
	@msg = Log->get_success;

Note: All the get_* methods return array references when called in scalar context. e.g.

	$msg = Log->get_success;	## ref($msg) eq "ARRAY"

During CGI/mod_perl development it is very handy to dump all of the debugging messages at the bottom of the HTML page. This is done with:

	Log->print;

This can just be left at the bottom of your main script. Logging can be turned off (default is on), and when it is turned off Log->print() doesn't do anything.

Types and Formats of Messages

Each of the four types of messages (debug, error, status, success) have slightly different logic. The differences are as follows:

The debug messages are not designed to be visable by the user (and in fact may be a security risk if you show the connection string for databases, etc.) The format of a debug message is:

	[caller:line [caller:line...]] message

	where:

	caller is a method name
	line is the line number from the method 
	message is your debugging message

An example will make this clearer:

    [file: test.pl]

    1:      use CGI::Log;
    2:      &foo;
    3:      sub foo
    4:      {
    5:            Log->debug("We are on line 5 of the method: foo");
    6:            &bar;
    7:      }
    8:      sub bar
    9:      {
    10:           Log->debug("line 10 method: bar process id: " . $$);
    11:           Log->error("Error on line 11 in the method: bar");
    12:     }
    13:     Log->print();

When run it prints:

    -- DEBUG (test.pl) (pid: 3262) --
    [main:2 main::foo:5] We are on line 5 of the method: foo
    [main:2 main::foo:6 main::bar:10] line 10 method: bar process id: 456
    [ERROR] [main:2 main::foo:6 main::bar:11] This an error being called from the method: bar (No such file or directory)
    -- ERROR --
    [main:2 main::foo:6 main::bar:11] Error on line 11 in the method: bar (No such file or directory)

(Note: the HTML in the output has been removed for clarity.)

There are some things to note:

Each debug message includes the context of how it came to be called. This allows for your debug messages to be very short -- often just stating a simple fact such as "a is undefined" or showing the value of a variable.

Error messages are duplicated in the error and debug arrays, so that you can determine how your error message got called, and its relation to any debugging messages.

Error messages in the debug list have "[ERROR]" prepended to them.

Error messages include the contents of the error variable $! in brackets. This saves you from having to remember to include this variable in your error message.

Log messages of type "status" and "success" are not manipulated or modified. Whatever you put in is what you get back.

Log messages of type "error" are stored in two formats. The first is the format that in the output above. The second is suitable for returning to the user. (It doesn't include the call trace.) By default it includes the error message from the variable $!. If this is not desirable, call Log->ui_no_error()

TIPS/TRICKS

Top

It is nice to be able to add as many debugging messages without having to worry about slowing down your application when it gets deployed. Calling Log->debug_off will set the instance variable DEBUG_FLAG to undefined, and will prevent any messages in the current process from being stored. e.g.

	if ($config{DEBUG} eq "Off")	## pretend %config holds global
	{				##   configuration info
		Log->debug_off;
	}
	Log->debug("this debug message won't be saved because debugging is off.");

Even though the debug() function won't do anything when debugging is turned off (it returns immediately), there is still the overhead of a function call for each debug message. If you really want to get obsessive about performance you can try redefining the debug() method. e.g.

	use CGI::Log;
	sub CGI::Log::debug () { 1 };		## redefine with prototype so it gets inlined
						## note: I haven't tested the efficiency of this!
						##
						## note: prototypes are from perl 5.002 +

It is very handy to be able to turn on debugging from the URL. e.g.

	http://somewhere.com/cgi-bin/test.pl?debug=secret

In your perl code you could have:

	if ($param{debug} ne "secret" 		## $param{debug} holds the CGI variable "debug" 
		|| $DEBUG != 1)			## $DEBUG is a config variable
	{
		Log->debug_off();
	}

This can be a huge timesaver if access to the webserver is difficult. This can be huge trouble if you have confidential or security related information in your debugging messages. (That is why "debug" in the above example is the string "secret" and not "1" or something easy to guess.)

You can add nice status messages to your web application by doing something like:



	if (Log->is_error)
	{
		print "<font color=\"#ff0000\">ERROR</font><BR>\n";
		for (Log->get_error) { print $_ . "<BR>\n"; }
	}
	elsif (Log->is_success)
	{
		print "<img src=\"smiley_face.gif\">";
		for (Log->get_success) { print $_ . "<BR>\n"; }
	}

	for (Log->get_status) { print $_ . "<BR>\n"; }

Make sure you have "Log" and not "log" or you will get the run-time error:

	Can't take log of 0

At the end of your script (whether a CGI or mod_perl) you will almost always want a:

	Log->clear;

Documentation for CGI::Log was created by h2xs.

BUGS

Top

- too much noise in the debug call tracing under mod_perl. e.g.

	[main:0 (eval):0 Apache::Registry::handler:141 (eval):141 Apache::ROOT::perl::test_5flog_2epl::handler:16] debug message.

- not thread-safe.

- if you are using mod_perl and you do not remember to clean out the log with Log->clean(), you will waste lots of memory.

- CGI::Log takes the Log:: namespace by default. This might be seen as rude, or cause problems if it is already being used. (Check if %Log:: is defined???)

AUTHOR

Top

Jason Moore, 1998 <jmoore@sober.com>

SEE ALSO

Top

perl(1).

modperl(1).

CGI-Log documentation Contained in the CGI-Log distribution. 
package CGI::Log;

use strict;

$CGI::Log::VERSION	= '1.00';
$CGI::Log::DEBUG_FLAG	= 1;		## undef to turn off debugging...

*Log:: = \%CGI::Log::;			## short cut for calling, so the following are equivalent:
					##   CGI::Log->debug("hi"); 
					##   Log->debug("hi");


##################################################
sub	new
##
##      - initialize a CGI::Log object
##      - creates instance variables using PID
##
##      - note: you generally don't want to call this directly, as it
##        is called automatically by the other methods if required.
##
## returns: Log::CGI object ref
##
##################################################
{
	my $class = shift;
	my $self = {};
	bless $self;

	## defaults

	$self->{DEBUG_FLAG} = $CGI::Log::DEBUG_FLAG;

	## the following are defined here even though there would be vifified/created
	## automatically when called, since there are errors if i try to access
	## the anon array if it hasn't been defined.

	## e.g. looking at @{$self->{ERROR}} gives the error:
	##      Can't use an undefined value as an ARRAY reference 
	##

	$self->{DEBUG}		= [];		# programmer
	$self->{ERROR}		= [];			

	$self->{UI_ERROR}	= [];		# user/user-interface
	$self->{SUCCESS}	= [];
	$self->{STATUS}		= [];

	return($self);
}

##################################################
##
sub debug_off
##  
##   - sets DEBUG_FLAG so that calls to Log->debug() return without doing
##     anything.  Also, calls to Log->print() return without doing anything.
{
	my($self) = @_;
	
	if (!ref($self))		## not instantiated
	{
		CGI::Log->_find_self(\$self);
	}

	$self->{DEBUG_FLAG} = undef;
	return(1);
}

##################################################
##
sub debug
##
##
{
	return(1) if !defined($CGI::Log::DEBUG_FLAG);

	my($self, $debug) = @_;

	CGI::Log->_find_self(\$self);			## $self is now an instantiated Log object

	my $t = $self->_trace();

	push(@{$self->{DEBUG}}, $t . " " . $debug);

	return(1);
}

##################################################
##
sub error
##
##
{
	my($self, $err) = @_;

	CGI::Log->_find_self(\$self);			## $self is now an instantiated Log object

	my $t = $self->_trace();

	## errors get put into DEBUG, UI_ERROR and ERROR

	my $ui_err;
	if (!defined($self->{NO_UI_ERROR}))
	{
		$ui_err = " ($!)"; 
	}

	push(@{$self->{DEBUG}}, "[ERROR] " . $t . " " . $err . " ($!)");
	push(@{$self->{ERROR}}, $t . " " . $err . " ($!)");
	push(@{$self->{UI_ERROR}}, $err . $ui_err);

	return(1);
}

##################################################
##
sub status
##
##
{
	my($self, $msg) = @_;

	CGI::Log->_find_self(\$self);
	push(@{$self->{STATUS}}, $msg);
	return(1);
}

##################################################
##
sub success
##
##   - adds a "success" message
##
{
	my($self, $msg) = @_;

	CGI::Log->_find_self(\$self);
	push(@{$self->{SUCCESS}}, $msg);
	return(1);
}

##################################################
##
sub get_debug
##
##   returns: array (or array ref in scalar context) of "debug" messages
## 
{
	my($self) = @_;
	return( CGI::Log->_get("DEBUG") );
}

##################################################
##
sub get_error
##
##   0:
##   1: "UI" will return the error messages suitable to return to the user
##   returns: array (or array ref in scalar context) of "error" messages
## 
{
	my($self, $what) = @_;
	if (uc($what) eq "UI")
	{
		$what = "UI_ERROR";
	}
	else
	{
		$what = "ERROR";	
	}

	return( CGI::Log->_get($what) );
}

##################################################
##
sub get_success
##
##   - returns: array (or array ref in scalar context) of "success" messages
## 
{
	my($self) = @_;
	return( CGI::Log->_get("SUCCESS") );
}

##################################################
##
sub get_status
##
##   - returns: array (or array ref in scalar context) of "success" messages
## 
{
	my($self) = @_;

	return( CGI::Log->_get("STATUS") );
}

##################################################
##
sub _get
{
	my($self, $what) = @_;
	CGI::Log->_find_self(\$self);			## $self is now an instantiated Log object
	return($self->{$what}) if !wantarray;
	return(@{$self->{$what}});
}

##################################################
##
sub is_error
##
##   - returns: number of errors
##
{
	my($self) = @_;
	CGI::Log->_find_self(\$self);			## $self is now an instantiated Log object

	return( scalar(@{$self->{ERROR}}) );
}

##################################################
##
sub is_success
##
##   - returns: number of "success" messages
##
{
	my($self) = @_;
	CGI::Log->_find_self(\$self);			## $self is now an instantiated Log object

	return( scalar(@{$self->{SUCCESS}}) );
}

##################################################
##
sub is_status
##
##   - returns: number of status messages 
##
{
	my($self) = @_;
	CGI::Log->_find_self(\$self);

	return( scalar(@{$self->{STATUS}}) );
}



##################################################
##
sub print
##
##   - if debugging is on, prints out contents of debug array
##
##
{
	my($self) = @_;

	CGI::Log->_find_self(\$self);

	if (!$self->{DEBUG_FLAG})
	{
		# print "Log print OFF.\n";
		return(1);
	}

	print "-- DEBUG ($0) (pid: $$) --<BR>\n";

	my $m;
	for $m (@{$self->{DEBUG}})
	{
		print $m . "<BR>\n";
	}

	if ($self->is_error)
	{
		print "<BR>\n-- ERROR --<BR>\n";
	
		for $m (@{$self->{ERROR}})
		{
			print $m . "<BR>\n";
		}
	}
}


##################################################
##
sub ui_no_error
{
	my($self) = @_;
	CGI::Log->_find_self(\$self);
	$self->{NO_UI_ERROR} = 1;
}

##################################################
##
sub _find_self
##
##   - returns the Log object for this process id (pid)
##   - private method 
##   - automatically instantiates the Log object for 
##     the current process id if required. 
##
##
##
{
	my($self, $new_self) = @_;

	if (defined($new_self) &&
		## $$new_self eq "CGI::Log")		## it's bad to assume the name of the caller object
		!ref($$new_self) )			## just checking for a ref is better
	{
		## find the Log object for this pid

		if (!defined($CGI::Log::instance))
		{
			# print "instantiated object does not exist. creating.\n";
			$$new_self = new CGI::Log;
			$CGI::Log::instance = $$new_self;
		}
		else
		{
			$$new_self = $CGI::Log::instance;
			# print "object exists. self is: $self object: $$new_self\n";
		}
	}

	return(1);			## value of reference is edited, so just return true.
}


##################################################
##
sub _trace
##
##   - traces up from a function call.  Output is in the format:
##        function:line [function:line]
##   - the output moves from the top down to the caller.. (i.e. starts at "main") 
##
##
##
{
        my($self) = @_;

	## CGI::Log->_find_self(\$self);		## we have "found outselves" (what object
							## reference we are, by the time we get here.)

        my @call = caller(1);
        my $line = $call[2];
        my $cnt = 2;

        my @stack;

        while (defined($call[0]))
        {
                my $caller = $call[0];
                @call = caller($cnt);
                $call[3] = $caller if (!defined($call[3]));
                unshift(@stack, $call[3] . ":" . $line);
                $line = $call[2];
                $cnt++;
        }
        return("[" . join(" ", @stack) . "]");
}

##################################################
##
sub _report
{
##   report on how many Log objects there are, and size of 
##   arrays in each object.
##
##   returns: scalar

	my $c = 0;
	my($self) = @_;
	my($out);

	CGI::Log->_find_self(\$self);

	$out = "Log Report (PID: $$)\n<ul>\n";

	for ("DEBUG", "ERROR", "UI_ERROR", "SUCCESS", "STATUS")
	{
		$out .= $_ . ": " . scalar(@{$self->{$_}}) . " <BR>\n";
	}
	$out .= "</ul>\n";
	return($out);
}

##################################################
##
sub clear 
##
##   clears/resets all the arrays
##
{
	my($self) = @_;
	CGI::Log->_find_self(\$self);

	$self->{DEBUG}		= [];
	$self->{ERROR}		= [];
	$self->{UI_ERROR}	= [];
	$self->{STATUS}		= [];
	$self->{SUCCESS}	= [];
}

##################################################
##
#sub DESTROY 
##
#{
#}



1;