package Yaala::Parser::WebserverTools;

use strict;
use warnings;
use vars qw(%fields %MONTH_NUMBERS);

use Exporter;
use Yaala::Config qw#get_config read_config#;

@Yaala::Parser::WebserverTools::EXPORT_OK = qw(%MONTH_NUMBERS detect_referer
	detect_browser detect_os extract_data);
@Yaala::Parser::WebserverTools::ISA = ('Exporter');

read_config ('webserver.config');

our $referer_format = get_config ('referer_format');
our $localhost_name = '';
our @local_aliases = get_config ('localhost');

our %recognized_browsers;
our %recognized_oses;

# Used to translate the month's name into it's number
%MONTH_NUMBERS = (	'Jan'	=>	1,
			'Feb'	=>	2,
			'Mar'	=>	3,
			'Apr'	=>	4,
			'May'	=>	5,
			'Jun'	=>	6,
			'Jul'	=>	7,
			'Aug'	=>	8,
			'Sep'	=>	9,
			'Oct'	=>	10,
			'Nov'	=>	11,
			'Dec'	=>	12	);

our %fields =
(# the CGI fields that different search engines use to store the search strings in
	'MT'		=>	'lycos',	# hotbot.lycos.com
	'ask'		=>	'ask.com',	# ask.com/main/metaAnswer.asp
	'origq'		=>	'msn',		# search.msn.com/results.asp
	'p'		=>	'yahoo',	# google.yahoo.com/bin/query
	'q'		=>	'google|freshmeat',	# google.com/search, freshmeat.net/search, google.de/search
	'qs'		=>	'virgilio',	# search.virgilio.it/search/cgi/search.cgi
	'query'		=>	'lycos',	# search-arianna.iol.it/abin/internationalsearch, search.lycos.com/main/default.asp, suche.lycos.de/cgi-bin/pursuit
	'search'	=>	'altavista|excite'	# altavista.com/iepane, search.excite.ca/search.gw
);

{
	my $include_local = get_config ('referer_include_localhost');
	
	if ($include_local =~ m/true/i)
	{
		$localhost_name = 'localhost';
	}
}

my $VERSION = '$Id: WebserverTools.pm,v 1.5 2003/12/07 16:47:14 octo Exp $';
print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);

return (1);

sub detect_referer
# Used to extract the referer if parsing webserver
# logs.
{
	my $referer = shift;
	my $host;
	my $uri;
	my $params;
	
	($host, $uri, $params) =
		$referer =~ m#^\w+://([^:/]+)(?::\d+)?(/[^\?]*)(\??.*)#;
		#$referer =~ m#^\w+://([^:/]+)(?::\d+)?#;

	return ('') unless (defined ($host));
		
	if (grep { $host =~ m/$_/i } @local_aliases)
	{
		$host = $localhost_name;
	}
	
	return ('*NONE*') unless ($host);
	
	if ($referer_format eq 'full')
	{
		return ($host . $uri . $params);
	}
	elsif ($referer_format eq 'url')
	{
		return ($host . $uri);
	}
	else
	{
		return ($host);
	}
}

sub detect_browser
# This is used to (try) to translate the browser
# string into something more human-readable and
# to have a smaller number of browsers so
# information is easier to cathegorize.. If you
# don't understand this routine without comments
# you should invest in some perl book, I think..
{
	my $browser = shift;

	if (defined $recognized_browsers{$browser})
	{
		return ($recognized_browsers{$browser});
	}
	
	my $name = 'unknown';
	if ($browser =~ /Lynx/i) { $name = 'Lynx'; }
	elsif ($browser =~ /Links/i) { $name = 'Links'; }
	elsif ($browser =~ /Opera/i) { $name = 'Opera'; }
	elsif ($browser =~ /WebTV/i) { $name = 'WebTV'; }
	elsif ($browser =~ /curl/i) { $name = 'curl'; }
	elsif ($browser =~ /wget/i) { $name = 'wget'; }
	elsif ($browser =~ /GetRight|GoZilla/i) { $name = 'Download Manager'; }
	elsif ($browser =~ /bot|Google|Slurp|Scooter|Spider|Infoseek|Crawl|Mercator|FireBall|av\.com|Teoma|Ask Jeeves/i) { $name = 'Search Engines'; }
	elsif ($browser =~ /Mozilla/i)
	{
		if ($browser =~ /Galeon/i) { $name = 'Galeon'; }
		elsif ($browser =~ /Phoenix/i) { $name = 'Phoenix'; }
		elsif ($browser =~ /Chimera|Camino/i) { $name = 'Camino'; }
		elsif ($browser =~ /Konqueror/i) { $name = 'Konqueror'; }
		elsif ($browser =~ /Safari/i) { $name = 'Safari'; }
		elsif ($browser =~ /MultiZilla/i) { $name = 'MultiZilla'; }
		elsif ($browser =~ /MSIE/i) { $name = 'MSIE'; }
		elsif ($browser =~ /compatible/i) { $name = 'Netscape compatible'; }
		elsif ($browser =~ m!Mozilla/[0-4]!i or $browser =~ m/Netscape/i)
		{ $name = 'Netscape Navigator'; }
		else { $name = 'Mozilla'; }
	}
	elsif ($::DEBUG & 0x2000)
	{
		print $/, __FILE__, ": Unknown browser: '$browser'";
	}

	$recognized_browsers{$browser} = $name;
	return ($name);
}

sub detect_os
# uses the same string "detect_browser" does,
# except for that it extracts the operating system
# as good as possible.
{
	my $os = shift;
	
	if (defined $recognized_oses{$os})
	{
		return ($recognized_oses{$os});
	}
	
	my $name = 'unknown';
	if ($os =~ /IRIX/i) { $name = 'IRIX'; }
	elsif ($os =~ /AIX/i) { $name = 'AIX'; }
	elsif ($os =~ /Sun/i) { $name = 'SunOS'; }
	elsif ($os =~ /BeOS/i) { $name = 'BeOS'; }
	elsif ($os =~ /OS.?2/i) { $name = 'OS/2'; }
	elsif ($os =~ /Amiga/i) { $name = 'AmigaOS'; }
	elsif ($os =~ /Mac|PPC/i) { $name = 'MacOS'; }
	elsif ($os =~ /BSD/i)
	{
		if ($os =~ /open/i) { $name = 'OpenBSD'; }
		elsif ($os =~ /free/i) { $name = 'FreeBSD'; }
		elsif ($os =~ /net/i) { $name = 'NetBSD'; }
		else { $name = 'some BSD'; }
	}
	elsif ($os =~ /Linux|X11|KDE|Genome|Gnome/i) { $name = 'Linux'; }
	elsif ($os =~ /Win/i)
	{
		if ($os =~ /95/)     { $name = 'Windows 95'; }
        	elsif ($os =~ /98/)  { $name = 'Windows 98'; }
        	elsif ($os =~ /Me/i) { $name = 'Windows ME'; }
		elsif ($os =~ /NT/i)
		{
			if ($os =~ /NT.5.1/i) { $name = 'Windows XP'; }
			elsif ($os =~ /NT.5.0/i) { $name = 'Windows 2000'; }
        		else { $name = 'Windows NT'; }
		}
		elsif ($os =~ /2000|2k/i) { $name = 'Windows 2000'; }
		elsif ($os =~ /xp/i) { $name = 'Windows XP'; }
		else { $name = 'some Windows'; }
	}
	elsif ($os =~ /ix/i) { $name = 'some UNIX'; }
	elsif ($::DEBUG & 0x2000)
	{
		print $/, __FILE__, ": Unknown OS:      '$os'";
	}
	
	$recognized_oses{$os} = $name;
	return ($name);
}

sub extract_data
# This routine looks for data in the referer and
# extracts terms that visitors of this site were
# searching for at ome of the major searchengines.
# I know that my list is far from being complete.
# If your favorite search engine isn't included
# please feel free to contact me.
{
# If there is a field that may contain such
# information, then it's this one..
	my $referer = shift;

# We will save every field (if any) here with it's
# data being the value..
	my %form = ();
	my ($key, $val) = ('', '');

# $server is the server the visitor is coming
# from, $string the entire data which will need
# soem decoding..
	my ($server, $string) = split (/\?/, $referer, 2);

# Don't do anything unless there is any data..
# We have to return an empty list since zero would
# get interpreted as a one-element array with the
# only value being "0", making zero the top word..
	return () unless $string;

	my $field = '';
	my %words = ();

# Split data into key=value pairs
	foreach (split (/\&/, $string))
	{
		($key, $val) = split (/=/, $_, 2);
		next unless defined $val;

# A "+" in the request-string means a whitespace
		$val =~ s/\+/ /g;

# Ignore all special characters.. I know that's
# lazy and will screw up words like "foo-bar", but
# IMO it does more good than bad. If you don't
# think so either uncomment the appended line or
# write better code and drop me a copy..
#		$val =~ s/\%(.{2})/pack("C", hex($1))/eg;
		$val =~ s/\%(.{2})//g;
		$form{$key} = $val;
	}

# Print the hash's content to STDOUT if you set
# $::DEBUG to anything higher than 2 (3, eg.)
# This is extremely usefull for finding search-
# engines and which fields they are using..
# use './yaala | grep DATA | sort | less' for the
# best/easiest to read results..
	if ($::DEBUG & 0x1000)
	{
		print $/, __FILE__, "Extracted data: $_ = ", $form{$_} for (keys %form);
	}

	my $regexp;
# Cycles through every PREdefined field that may
# contain the information we want. If this field
# exists, we check wether the previous visited
# server matches the regexp (the corresponding
# value in %fields) and if that's the case, we
# split the line into words saving it to %words to
# prevent duplicates. (otherwise a search for
# "foo foo foo foo foo foo foo" would result into
# increasing "foo" dramatically..
	foreach $field (keys %fields)
	{
# check for this field's existance..
		next unless defined $form{$field};

		$regexp = $fields{$field};

# check wether the server matches out regexp..
		next unless $server =~ /$regexp/i;

		$string = lc ($form{$field});

# this is a google-only thing that appears when
# the visitor used google's cache option..
		next if $string =~ /^cache:/;

# And, after all these tests, save the data..
		map { if (length ($_) > 2) { $words{$_} = 1; } } (split (/\s+/, $string));
	}
# return %words's keys as a list, which may be
# empty..
	return keys %words;
}
