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

###################### UNICOUNTER V 1.0 ########################
#
# Copyright James D H Turner 2003
# Published by Cathonian Software and SKARO.NET
#
# 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.skaro.net
# on your website with a message that reads something like
#   Counters provided by SKARO.NET
#
# 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.skaro.net/unicounter
#
# Please report bugs to unicounter@skaro.net
#
################################################################


# declare the recognised parameter names
use constant name     => 'name';    # use name=index to create a counter for an index page
use constant create   => 'create';  # use create=77 to create a new counter with initial value 77
use constant write    => 'write';   # 1 or 0 or ssi : default = 1 - write value to page : javascript mode
use constant inc      => 'inc';     # 1 or 0 : default = 1 - increment counter.
use constant cache    => 'cache';   # 1 or 0 : default = 1 - permit server/browser caching.
use constant deliver  => 'deliver'; # use deliver=http://.../cleverstuff.zip to deliver data file.
use constant trackip  => 'trackip'; # 0 - 16 : default = 0 - ignore IP addresses.

# declare other constants
use constant ssi   => 'ssi'; # value of write requirer to display using a server-side include.
use constant maxip => 16;    # The maximum number of IP addresses that can be stored.


# 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 Initialise {
# Read into $Arguments variable the string data following the ? in the calling url.
  $Arguments = $ENV{'QUERY_STRING'};

# Split the arguments into a hash variable for easy testing later.
# Note that the & and = delimiters are treated identically.
  @Params = split(/[=&]/,$Arguments);
  %Params = @Params;

# 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 = $Params{name};    unless (defined($FileName)) { $Fatal   = "Parameter missing: name" }
  $Write    = $Params{write};   unless (defined($Write))    { $Write   = 1 }
  $Inc      = $Params{inc};     unless (defined($Inc))      { $Inc     = 1 }
  $Cache    = $Params{cache};   unless (defined($Cache))    { $Cache   = 1 }
  $Deliver  = $Params{deliver}; # undefined is ok

# Fix potential parameter conflict - $Write must be 0 if $Deliver is defined.
  if (defined($Deliver)) { $Write = 0 }

# 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  = $Params{create};  unless (defined($Create))  { $Create  = 0 };
    $TrackIP = $Params{trackip}; unless (defined($TrackIP)) { $TrackIP = 0 }

    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.
  $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.
  $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.
  my $IP; foreach $IP (@IParray) { if ($IP 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 }

# 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) { my $IP; foreach $IP (@IParray) { print HFILE "$IP\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" }
    else { print "document.write(\'$Counter\');" }
  }
}

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

  main();

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

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