#!/usr/bin/perl
#
#######################################################
#		Top Referers version 2.0
#
#     	Created by: Solution Scripts 
# 		Email: solutions@solutionscripts.com
#		Web: http://solutionscripts.com
#
#######################################################
#
#
# COPYRIGHT NOTICE:
#
# Copyright 1999 Solution Scripts  All Rights Reserved.
#
# This program is being distributed as freeware.  It may be used and
# modified free of charge, so long as this copyright notice, the header 
# above and all the footers in the program that give me credit remain 
# intact. Please also send me an email, and let me know 
# where you are using this script. 
#
# By using this program you agree to indemnify Solution Scripts from any liability.
#
# Selling the code for this program without prior written consent is
# expressly forbidden.  Obtain permission before redistributing this
# program over the Internet or in any other medium.  In all cases
# copyright and header must remain intact.
#
######################################################

use Fcntl;
use AnyDBM_File;
use Config;
use strict;
use vars qw(%fields);

##### WORD FILTER #####
#
# These are words you want filtered out (not show in referer list)
# all urls containing any of the words will be ignored 
# Sperate each by a comma and make sure they are in double quotes
#
my @filter = ("none","(none)","eastboys.com");



##### RETURN IMAGE #####
#
# The image you want to return
# (the call to referers returns an image, this is the url for that image)
#
my $image = "http://www.navrcholu.cz/cgi-bin/4web/nvhit.pl?id=00018229";


## Set this to 1 if you want to use the keyword feature, else set it to 0 ##
my $keywords = "1";

## Set this to 1 if you want to strip the query string of the end of the referers, else 0 ##
my $strip = "1";

## YOUR SERVER ##
#
# Makes sure that prorgam is called from your server
#
my @your_server = ("solutionscripts.com","alias-mail.com");



#######################################################################
################### Nothing else needs to be edited ###################

#print "Content-type: text/html \n\n";

my %fields;
my $current_time = time();

my $time = time;
(my $sec,my $min,my $hour,my $mday,my $mon,my $year,my $wday,my $yday,my $isdst) = localtime($time);
if ($year == 100) {
	$year = '00';
}
elsif ($year > 100) {
	$year = $year - 100;
}
$mon++;
my $now = "$mon.$mday.$year";
my $good_ref = '';


if ($ENV{'HTTP_REFERER'}) {
	foreach (@your_server) {
		if ($ENV{'HTTP_REFERER'} =~ /$_/i) {
			$good_ref=1;
		}
	}
}
else { $good_ref=1; }


unless ($ENV{'QUERY_STRING'}) {
	print "Location: $image\n\n";
	exit;
}
my $therefferer = $ENV{'QUERY_STRING'}; # What was tacked on to the url
my $therefferers = "\L$therefferer\E";


foreach (@filter) {
	if ($therefferer =~ /$_/i) {
		print "Location: $image\n\n";
		exit;
	}
}


if ($therefferer =~/\?/ && $keywords) {

	my $query = $therefferer;
	$query=~ s/^.*\?//;

	## YAHOO ##	
	if ($therefferer=~ /yahoo/i ) {
		&parse($query);
		&print_out('yahoo',$fields{'p'});
	}	

	## DOGPILE ##	
	if ($therefferer=~ /dogpile/i ) {
		&parse($query);
		&print_out('dogpile',$fields{'q'});
	}
				
	## INFOSEEK ##	
	if ($therefferer=~ /infoseek/i ) {
		&parse($query);
		&print_out('infoseek',$fields{'qt'});
	}

	## EXCITE ##	
	if ($therefferer =~ /excite/i ) {
		&parse($query);
		&print_out('excite',$fields{'search'});
	}

	## ALTAVISTA ##	
	if ($therefferer=~ /altavista/i ) {
		&parse($query);
		&print_out('altavista',$fields{'q'});
	}
	
	## METAFIND ##	
	if ($therefferer =~ /metafind/i ) {
		&parse($query);
		&print_out('metafind',$fields{'q'});
	}

	## NETFIND ##	
	if ($therefferer=~ /netfind/i ) {
		&parse($query);
		&print_out('netfind',$fields{'search'});
	}
	
	## METACRAWLER ##	
	if ($therefferer  =~ /metacrawler/i ) {
		&parse($query);
		&print_out('metacrawler',$fields{'general'});
	}

	## HOTBOT ##	
	if ($therefferer =~ /hotbot/i ) {
		&parse($query);
		&print_out('hotbot',$fields{'MT'});
	}

	## LYCOS ##	
	if ($therefferer =~ /lycos/i ) {
		&parse($query);
		&print_out('lycos',$fields{'query'});
	}

	## WEBCRAWLER ##	
	if ($therefferer =~ /webcrawler/i ) {
		$fields{'searchText'} =0;
		$fields{'search'} =0;
		&parse($query);
		my $string = '';
		if ($fields{'searchText'}) { $string = $fields{'searchText'}; }
		if ($fields{'search'}) { $string = $fields{'search'} };
		&print_out('webcrawler',$string);
	}

	## GOTO ##	
	if ($therefferer =~ /goto/i ) {
		&parse($query);
		&print_out('goto',$fields{'Keywords'});
	}

}
if ($strip) {
	$therefferer=~ s/\?.*$//;
}

my $flags = O_CREAT | O_RDWR;
my $db = "referrer";
tie(my %acc, 'AnyDBM_File', $db , $flags, 0666) || &error("Cannot open database-- referrer");
if ($acc{$therefferer}) {
	my @refferer_array= split(/\|/,$acc{$therefferer});
	$refferer_array[0]++;
	$refferer_array[2]++;
	$refferer_array[3]= "$current_time";	
	if ($refferer_array[5] eq $now) {
		$refferer_array[6]++;
	}
	else {
		$refferer_array[5] = $now;
		$refferer_array[6] = 1;
	}		
	if ($refferer_array[7] eq $mon) {
		$refferer_array[8]++;
	}
	else {
		$refferer_array[7] = $mon;
		$refferer_array[8] = 1;
	}
	$acc{$therefferer} = join("\|",@refferer_array);	
}
elsif ($acc{$therefferers}) {
	my @refferer_array= split(/\|/,$acc{$therefferers});
	$refferer_array[0]++;
	$refferer_array[2]++;
	$refferer_array[3]= "$current_time";	
	if ($refferer_array[5] eq $now) {
		$refferer_array[6]++;
	}
	else {
		$refferer_array[5] = $now;
		$refferer_array[6] = 1;
	}		
	if ($refferer_array[7] eq $mon) {
		$refferer_array[8]++;
	}
	else {
		$refferer_array[7] = $mon;
		$refferer_array[8] = 1;
	}

	$acc{$therefferers} = join("\|",@refferer_array);	
}
else {
	$acc{$therefferer} = "1|0|1|$current_time|$now|$now|1|$mon|1|0|";
}

untie(%acc);


print "Location: $image\n\n";





sub parse {

my $query = $_[0] ;
	
my @pairs=split(/&/,$query);
foreach my $item(@pairs) {
	(my $key,my $content)=split (/=/,$item,2);
	$content=~tr/+/ /;
	$content=~ s/%(..)/pack("c",hex($1))/ge;
	$fields{$key}=$content;
}
}


sub print_out {

my $engine = $_[0];
my $string = $_[1];
$string =~ tr/A-Z/a-z/;

if ($string) {

	my $flags = O_CREAT | O_RDWR;
	my $db = "$engine";
	tie(my %eng, 'AnyDBM_File', $db , $flags, 0666) || &error("Cannot open database-- referrer");
	if ($eng{$string}) {
		my @search = split(/\|\|\|/,$eng{$string});
		$search[0] ++;
		$search[1] = "$therefferer";
		$eng{$string} = join("\|\|\|",@search);
	}
	else {
		$eng{$string} = "1|||$therefferer";
	}
	untie(%acc);
}
}