view release on metacpan or  search on metacpan

Log.pm  view on Meta::CPAN

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;