#!/usr/bin/perl 
################################################################################
##
## Hello
##
## Here we have a web page hit counter which can control multiple counters
## via passed arguments. Number of hits is stored as both an absolute number
## and as number of non-consecutive hits (hits from different domains). 
## File locking is enabled to make sure no hits are lost due to simultaneous
## access. Records are kept on a daily basis. This script will function 
## correctly until 1st Janurary, 2038 (so called Y2K bug, this is a feature of 
## perl, see man page Time::Local for details). Days are stored wrt
## localtime. This should be considered when moving data files across
## time zones.
##
## Binary format of file
## 	Each entry is delimated by a '\0'. This prevents it for clashing
##		with the counter and ip numbers 
##	Entry consists of the following
##		long	'epoch_day', convert using getDate
##		int	# non-consecutive hits
##		int	# of actual hits
##		char x4	IP # of previous host that accessed page
##
## Copyright (c) Brendan Hack, 1999
##
################################################################################

use Time::Local;
use CGI qw(keywords remote_host);
use Fcntl qw(:flock);
use strict 'vars';
use strict 'subs';
use integer;

# Directory to counter storage
#my $base_dir = "/usr/local/etc/httpd/cgi-bin/counters";
my $base_dir = "/usr/www/users/ewok/bendys/cgi-bin/counters";

# Counter filename extension
my $file_ext = "cnt";

################################################################################

# Get epoch day and counter name
my ($counter) = keywords();

exit if (!defined $counter);


if ($counter eq "showstats")
{
	print "Content-type: text/html\n\n";
	printStats($counter);
}
else
{
	my ($date) = getEpochDay();
	processFile("$base_dir/$counter.$file_ext",$date);
	print "Content-type: image/gif\n\n";     
	while (<DATA>) {
		print;
	}
}

#########################################################################


# Calculates difference between current time zone and GMT in seconds.
# We calculate this at the 2nd of January 1970 so negative time zones
# do not always return as -1
sub calcTimeDiff {
	return timegm(localtime(86400))-86400;
}


# Returns "epoch day" wrt current time zone
# Epoch day is the number of days since 1 January 1970.
# The epoch day is actually wrt to local time.
# Why do I do this? Sp epoch day will work properly. Basically, the epoch is
# wrt GMT, so we need to convert it to localtime otherwise the epoch day 
# increments at (eg) 10am for melbourne (+10GMT) instead of midnight.
# So we manually add the time difference to our epoch.
# time. See getDate for an implementation. This makes the epoch day
# specific to this time zone. 
# (current GMT + Timezone Difference) / # secs per day
sub getEpochDay {
	return (time+calcTimeDiff())/86400;	
}


# Gets todays local date from the "epoch day"
# Convert from epoch day to epoch second and call gmtime on it.
# For how gmtime gives us the local date see getEpochDay
sub getDate {
	my $ed;
	($ed)= @_;
	return gmtime($ed*86400);
}


# Process the file
# Parameters are $filename,$epoch_day
# Lock and open data file and check if first entry is for today
# If it isn't then insert a new entry for today with counters starting
# at 1
# If first entry is for today then update counters as necessary and close
# file.
sub processFile {
	my ($filename,$epoch_day) = @_;
	my ($new_entry,$contents);
	my ($day,$count,$raw_count,@ip);
	my (@newip);
	my ($oldin) = $/;

	# Need to check if file exists. If not, create it.
	if (! -e $filename) {
		open FH, ">$filename" or htmldie( "Cannout create non-existant file $filename:$!\n<P>");
		close FH;
	}

	# Open and get an exclusive lock
	open FH, "+<$filename" or htmldie( "Cannot open file to read $filename:$!\n<P>");
	flock FH, LOCK_EX or htmldie( "Cannout lock file $filename:$!\n<P>");

	# Rewind to start in case it's been written to
	seek FH,0,0;

	# Read all existing file contents
	undef $/;
	$contents =  <FH>;
	$/ = $oldin;

	# Extract contents of first entry
	if (defined $contents) {
		($day,$count,$raw_count,@ip) = unpackData($contents);
	}

	# If new file or no entry for today then add new entry
	if (!defined $contents  || $day != $epoch_day) {
		$day = $epoch_day;
		$count=$raw_count=1;
		@newip =getRemoteIP();
		$new_entry = packData($day,$count,$raw_count,@newip);
		$contents = $new_entry.$contents;
	}
	else
	# Otherwise replace the first entry with an updated one
	{
		$raw_count++;
		@newip = getRemoteIP();
		if ($newip[0] != $ip[0] || $newip[1] != $ip[1] ||
			$newip[2] != $ip[2] || $newip[3] != $ip[3]) {
			$count++;
		}
		$new_entry = packData($day,$count,$raw_count,@newip);
		substr($contents,0,length($new_entry)) = $new_entry;
	}

	# Rewind to start of file
	seek FH,0,0;
	# Write new message
	print FH $contents;

	# Unlock and close
	flock FH, LOCK_UN or htmldie( "Cannot unlock file $filename:$!\n<P>");
	close FH;
}


# Unpack data from string
sub unpackData
{
	return unpack("LIIC4",$_[0]);
}


# Pack data into string
sub packData
{
	return pack("LIIC4",@_);
}

# Get the remote IP address and return it as a list, one entry per
# number
sub getRemoteIP {
	return (split /\./, $ENV{'REMOTE_ADDR'});
	#return (split /\./, remote_host());
}

sub htmldie {
	print "Content-type: text/html\n\n";
	print "<HTML>";
	print @_;
	print "\n";
	print "<P></HTML>";
	exit 1;
}

# Process the file
# Parameters are $filename,$epoch_day
# Lock and open data file and check if first entry is for today
# If it isn't then insert a new entry for today with counters starting
# at 1
# If first entry is for today then update counters as necessary and close
# file.
sub printStats {
	my ($counter);# = @_;
	my $contents="";
	my $date=0;
	my $day=0;
	my $raw_count=0;
	my (@ip);
	my $count=0;
	my ($record_len) = dataLen();
	my ($oldin) = $/;    
	my ($filename);# = "$base_dir/$counter.$file_ext";
	my (@counters) = findCounters();

	($counter,@counters) = @counters;
	$date = localtime();
	print "<H1> Counter Statistics</H1>";
	print "<H3>$date</H3>";
	while (defined $counter)
	{
		$filename = "$base_dir/$counter";

		# Need to check if file exists. If not, create it.
		if (! -e $filename) {
			print "Counter file '$filename' does not exist<BR>";
			return;
		}

		# Open and get an exclusive lock
		open FH, "+<$filename" or htmldie( "Cannot open file to read $filename:$!\n<P>");

		# Rewind to start in case it's been written to
		seek FH,0,0;

		# Read all existing file contents
		undef $/;
		$contents =  <FH>;
		$/ = $oldin;
		close FH;

		# Extract contents of first entry
		$counter = substr $counter,0,-4;
		print "<H3>Counter stats for $counter</H3>";
		print qq(<TABLE ROWS=4 ALIGN="center" WIDTH="100%">);
		print "<TR><TD>Date</TD><TD>Count</TD><TD>Raw Count</TD><TD>Last IP</TD></TR>";
		while (defined $contents) {
			($day,$count,$raw_count,@ip) = unpackData($contents);
			$contents = substr $contents, $record_len;
			$date =  getDate($day);
			print "<TR>";
			print "<TD>$date</TD>";
			print "<TD>$count</TD>";
			print "<TD>$raw_count</TD>";
			print "<TD>$ip[0].$ip[1].$ip[2].$ip[3]</TD>";
			print "</TR>";

	#		print "$date: $count, $raw_count. Last IP:$ip[0].$ip[1].$ip[2].$ip[3].<BR>\n";
		}
		print "</TABLE>";
		($counter,@counters) = @counters;
	}
}

sub dataLen
{
	return length(pack("LIIC4",0,0,0,0,0,0,0));
}

sub findCounters
{
	my @files;
	opendir(DIR,$base_dir);
	@files = grep { /\.$file_ext/ } readdir(DIR);
	return sort(@files);
}


__DATA__
GIF89a‘ÿÿÿÿ|»!ù,@T;
