#!/usr/bin/perl
# Change the line above to match the path to perl on your server

# use strict;
# strict should be used for development. It may be commented out when deployed.

######################## UNICOUNTER V 1.05 ##########################
##
## Copyright J D Turner 2003-2015
## Published by Cathonian Software
##
## YOU MUST NOT NOT REMOVE ANY PART OF THIS NOTICE
##
## Unicounter is a versatile program designed to count page-hits
## or file downloads. It can work with or without SSI.
##
## This program may be used in private or commercial websites
## without charge.
##
## If you use this program, should place a link to
##   http://www.cathonian.com
## on your website with a message that reads something like
##   Counters provided by CATHONIAN.COM
##
## This program is supplied without any warranty of any sort.
## If you use this program, you must accept all liablity for
## losses that may result. You should test this program
## thoroughly before deployment.
##
## You may modify this program but you may not redistribute any
## such modified versions.
##
## For the complete license terms, visit
##   http://www.cathonian.com/software/unicounter
##
## Please report bugs via http://www.cathonian.com/software/unicounter/contact.html
##
######################################################################

# Declare global vars - required for strict compilation
use vars qw(
  $fatal %urlparams $counter @iparray

  $filename $write $inc $cache $deliver $create $trackip
);

# declare the recognised parameter names
use constant PARAM_NAME    => 'name';    # use name=index to create a counter for an index page
use constant PARAM_CREATE  => 'create';  # use create=77 to create a new counter with initial value 77
use constant PARAM_WRITE   => 'write';   # 1 or 0 or ssi : default = 1 - write value to page : javascript mode
use constant PARAM_INC     => 'inc';     # 1 or 0 : default = 1 - increment counter.
use constant PARAM_CACHE   => 'cache';   # 1 or 0 : default = 0 - prevent server/browser caching.
use constant PARAM_DELIVER => 'deliver'; # use deliver=http://.../cleverstuff.zip to deliver data file.
use constant PARAM_TRACKIP => 'trackip'; # 0 - 16 : default = 8 - see constant defip below.

# declare other constants
# For websites that expect many users to be online simultaneously, these values may need to be increased.
use constant maxip => 16; # The maximum number of IP addresses that can be stored.
use constant defip =>  8; # The default value  of the trackip parameter.

# Typically, perl programs call the die procedure when a fatal error condition arises. However, this
# usually only results in a message being written to the server error log. This is not very helpful, so
# to prevent this happening, we'll use a global variable and test it regularly.
$fatal = '';

sub read_urlparams
# reads key=value parameter pairs in the query part of the url.
{ my ($q,@q,$k,$v);

  $q = $ENV{'QUERY_STRING'};
  @q = split('&',$q);

  foreach (@q) {
    ($k,$v) = split('=',$_,2);
    if ($k) { $urlparams{"$k"} = $v }
  }
}

sub read_param # ($name)
{ my $name = shift; return $urlparams{$name} }

sub Initialise {
  read_urlparams;

# Load the name of the file/counter and other values from the parameter list
# NOTE : Even if a fatal error occurs, we still must still continue to construct the HTTP header block.
#      : Creation parameters are read by the function ValidateCounter.
  $filename = read_param(PARAM_NAME);  unless ($filename)       { $fatal = "Parameter missing: name" }
  $write    = read_param(PARAM_WRITE); unless (defined($write)) { $write = 1 }
  $inc      = read_param(PARAM_INC);   unless (defined($inc))   { $inc   = 1 }
  $cache    = read_param(PARAM_CACHE); unless (defined($cache)) { $cache = 0 }
  $deliver  = read_param(PARAM_DELIVER); # undefined is ok

# Fix potential parameter conflict and adjust $deliver parameter if required.
  if (defined($deliver)) {
    $write = 0;
    my $host = $ENV{'HTTP_HOST'};
    my $tmp  = index($deliver,'/');
    if ($tmp == 0) { $deliver = 'http://'.$host.$deliver }
    else {
      $tmp  = '://\*/';
      $host = '://'.$host.'/';
      $deliver =~ s/$tmp/$host/; # replace '://*/' with '://www.domain.com/'
    }
  }

# Write the HTTP header block information for the output data.
# This information is required so that the server/intermediaries/browser know what to do.
# The block must be terminated by a blank line - hence two sequential \n are required.
# The information in these block headers is nominally equivalent to the HTML META tag HTTP-EQUIV.

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

# There are several ways to switch off caching depending on which version of HTTP is in use.
# You may try other methods if the method chosen below fails.
# unless ($cache) { print "Expires: -1\n"      }
# unless ($cache) { print "Pragma: no-cache\n" }

  unless ($cache) { print "Cache-Control: no-cache\n" }

  if ($deliver)   { print "Location: $deliver\n" }

  print "\n"; # Terminate HTTP header block with a blank line
}

# Best practice requires that sharing locks be used for file access, however, this is only a counter.
#
# Data is stored as follows :-
# Line 0 : Counter value
# Line 1 : trackip value
# Line 2 : reserved for future expansion
# Line 3 : ...ditto
# Line 4 : ...ditto
# Line 5 : Most recent IP address
# Line 6 : 2nd most recent IP address
# Line 7 : 3rd etc.

sub ValidateCounter {
# Test if the counter file exists. If it does not, create one and initialise it.
  unless (-e $filename) {
#   Read creation parameters
    $create  = read_param(PARAM_CREATE);  if     (defined($create))  { $inc     = 0 } else { $create = 0 }
    $trackip = read_param(PARAM_TRACKIP); unless (defined($trackip)) { $trackip = defip }

    unless (open(HFILE, ">$filename") and print(HFILE "$create\n$trackip\n") and close(HFILE)) {
      $fatal = "$filename : write error"
    }
  }
}

sub ReadCounter {
# Attempt to open the storage file for read access.
  unless (open(HFILE, "<$filename")) { $fatal = "$filename : Read open error"; return }

# Read the counter value.
  $counter = <HFILE>; if (defined($counter)) { chomp($counter) } else { $counter = 0 }

# Read the trackip value.
  $trackip = <HFILE>; if (defined($trackip)) { chomp($trackip) } else { $trackip = 0 }

# Ensure trackip is valid since it will be used to set array dimensions.
  if ($trackip < 0) { $trackip = 0 } elsif ($trackip > maxip) { $trackip = maxip }

# Read the reserved data lines and discard.
  my $tmp;
  $tmp = <HFILE>;
  $tmp = <HFILE>;
  $tmp = <HFILE>;

# If necessary, read IP data from file.
  if ($trackip) {
    my $i = 0;
    my $ip;
    $#iparray = $trackip - 1;
    while ($i < $trackip) {
      $ip = <HFILE>; if (defined($ip)) { chomp($ip) } else { $ip = "" }
      $iparray[$i] = $ip;
      $i++;
    }
  }

# Close the file - we've got what we need.
  close(HFILE);
}

sub NewIP {
  if ($trackip == 0) { return 1 }; # We're not looking for IP addresses so return true;

# Read into the $thisip variable the IP address (if available) of the caller
# This will be tested and used to suppress counter incrementation.
  my $thisip = $ENV{'REMOTE_ADDR'};

# If the IP address is not available, simply return true.
  if (!defined($thisip) or ($thisip eq "")) { return 1 }

# Scan the array and return false if it contains $thisip.
  foreach (@iparray) { if ($_ eq $thisip) { return 0 } }

# This IP address is not currently recorded so place it in the array.
  unshift(@iparray, $thisip);

# If necessary, remove the oldest value from the array.
  if ($#iparray > ($trackip - 1)) { pop(@iparray) }

  return 1;
}

sub SaveCounter {
  unless (open(HFILE, ">$filename")) { $fatal = "$filename : Write open error"; return }

# unless (flock(HFILE,6))            { $fatal = "$filename : Write lock error"; return }

# Save the $counter and $trackip values together with 3 blank lines reserved for future enhancements.
  print HFILE "$counter\n$trackip\n\n\n\n";

# If necessary, save the list of IP addresses.
  if ($trackip) { foreach (@iparray) { print HFILE "$_\n" } }

# Close the file - we've written all necessary data to it.
  close(HFILE);
}

sub main {
  Initialise();      if ($fatal) { return }
  ValidateCounter(); if ($fatal) { return }
  ReadCounter();     if ($fatal) { return }

# If necessary, increment the counter and save.
  if ($inc and NewIP()) { $counter++; SaveCounter(); if ($fatal) { return } }

  if ($write) {
    if    ($write eq 'ssi')   { print "$counter" }
    elsif ($write eq 'jsvar') { print "var $filename=$counter;" }
    else { print "document.write(\'$counter\');" }
  }
}

############## PROGRAM BODY ###############

  main();

  if ($fatal) { print "$fatal\n\n"; die "$fatal" }

################## END ####################