view release on metacpan or  search on metacpan

SearchEngineLog.pm  view on Meta::CPAN

package Apache::SearchEngineLog;
# Logging of terms used in searchengines

require 5.005;
use strict;
use warnings;

use Apache;
use Apache::Log;
use DBI;

use vars qw#$SERVER $REGEXEN $DBH $STH $TIMEOUT $LASTPING#;

our $VERSION = '0.51';

# to have the test-script run ok
return 1 if $0 eq 'test.pl';

init ();

return 1;
#List of subroutines:
# check_alive_dbi
# check_regexen
# cleanup
# connect_dbi
# db_save
# handler
# init

sub check_alive_dbi
##########################################################################
# Checks wether DB connection is alive by pinging it periodically.       #
# Reconnects if neccessary.                                              #
#                                                                        #
# Arguments:                                                             #
#  0: Apache::Log object                                                 #
#                                                                        #
# Returns:                                                               #
#  0: true if (re)conntected; false if reconnect fails                   #
##########################################################################
{
	my $l = shift;

	my $time = time;

	if (($time - $TIMEOUT) < $LASTPING)
	{
		return 1;
	}

	$l->debug ('Apache::SearchEngineLog: Timeout reached, pinging');

	if ($DBH->ping ())
	{
		$LASTPING = $time;
		return 1;
	}

	$l->info ('Apache::SearchEngineLog: Connection to database died: Reconnecting');
	return connect_dbi ($l);
}

sub check_regexen
##########################################################################
# Uses regexen to check which rule applies to a given server (if any)    #
# and returns the parameter field which contains usefull information.    #
#                                                                        #
# Arguments:                                                             #
#  0: Name of server as string                                           #
#                                                                        #
# Returns:                                                               #
#  0: Name of parameter                                                  #
##########################################################################
{
	my $server = shift;
	my $retval = '';

	foreach my $re (keys %$REGEXEN)
	{
		if ($server =~ m#$re#)
		{
			$retval = $REGEXEN->{$re};
			last;
		}
	}

	return $retval;
}

sub cleanup
##########################################################################
# Checks wether DB connection is alive by pinging it periodically.       #
# Reconnects if neccessary.                                              #
#                                                                        #
# Arguments:                                                             #
#  None                                                                  #
#                                                                        #
# Returns:                                                               #
#  0: true                                                               #
##########################################################################
{
	$DBH->disconnect ();
	return 1;
}

sub connect_dbi
##########################################################################
# Connects to the database.                                              #
#                                                                        #
# Arguments:                                                             #
#  0: Apache::Log object                                                 #