#!/usr/bin/perl

#-------------------------Welcome-----------------------------
#
# Click Count
# Ver. 1.2.2
# By Luke and Mark Pfeifer
# http://www.staff.net/cgi-scripts/		
# Release 3-22-97
# Updated 12-30-97
#
#
# Copyright Info: This application was written by Mark and Luke
# Pfeifer. Feel free to copy, cite, reference, sample, borrow 
# or plagiarize the contents.  However, if you don't mind,
# please let us know where it goes so that we can watch and take
# part in the development of it. Information wants to be free,
# support public domain freeware.  Donations are appreciated
# and will be spent on further upgrades and other public domain
# scripts.
#
# Finally, PLEASE SEND WORKING URL's to scripts@staff.net.
# We would like to keep a list of these scripts in use.
#-------------------------------------------------------------
#
#-----------------------Version History--------------------------
#
# Version 1.0 - 3-22-97     - Orginal Version Created
#
# Version 1.11 - 3-23-97    - Update to instructions and logging
#
# Version 1.12	- 7-17-97   - Added locking file to log so log file
#				does not get erased on heavily travled sites. 
#                           - Added set lock and end lock subroutines.  
#                           - Also added Color frames in admin.
#
# Version 1.2	- 7-19-97   - Now works with IIS (Internet
#				Infromation Server) and PWS
#				(Personal Web Server)
#			    - Allows linking via protocols
#				other than HTTP, like FTP
#
# Version 1.2.1	- 7-28-97   - Better way to handle IIS
#			    - Do not need $iis configuration
#				variable any more
#
# Version 1.2.2	- 12-30-97  - Fixed header for Unix
#							- Fixed syntax error with older
#								versions of Perl
#
#-------------------------------------------------------------
#
#-----------------------ReadMe--------------------------------
#
# This script now works with IIS (Internet Infromation Server)
# and PWS (Personal Web Server)!
#
# This script requires that PERL is loaded on your web server
# and that the web server is configured to run PERL scripts as
# CGI scripts.
#
# Configure the script in the User Configuration section below.
#
# Upload this file to your CGI directory on your web server in
# ASCII mode.  If you do not know if you have a CGI directory,
# ask your web server administrator.
#
# Chmod this file to 755, if you have Unix.
#
# On unix machines you must create an empty file with the name 
# of your log file and then chmod it to 777.  Most NT machines
# do this automatically for you.
#
# The script is called by creating a link like this
#   <a href="http://www.yourdomain.com/cgi-bin/clickcount.pl?url=www.thatdomain.com">
#
# To access the log file on online you go to the url
#   <a href="http://www.yourdomain.com/cgi-bin/clickcount.pl?view=password">
#
#   Notes on above example:
#
#	- You need to change the url of the script clickcount.pl to
#	  where it is located on your server.
#
# 	- The url can contain the protocol name (i.e. http://, ftp://, etc).
#	  If it does not, the HTTP protocol will be assumed.
#
#	- Change "password" to the password you chose below for $view_log
#
#-------------------------------------------------------------
#
#--------------- Variable Defention --------------------------
#
# $filename - the name of the log file. 
#
# $main_dir - the location of the log file.  You must
#	have the full path.  If you are unsure what it is
#	contact your server admin.
#
# $autoadd - decides wether or not to automatically
#	add links that are not in the database.
#	1 = on      2 = off
#
# $view_log - The password you wish to use to view the
#	log file online so clickcount.pl?view=whatever you 
#	chose for this string.  In this script it is set-up
#	to use test so you would use clickcount.pl?view=test
#
#-------------------------------------------------------------
#
#------- Start User Configuration ----------------------------
$filename = 'click-count.log';
$main_dir = 'e:/WebSite/cgi-shl/cgi-scripts';
$autoadd=1;  
$view_log='test';
#---End User Configuration -----------------------------------

#**************** DO NOT EDIT PAST THIS LINE *****************#

&FormInput(*input);

################################
# Some Default Set Variables
################################
$addnew=0;

$lock = "$main_dir/clickcount_lock.lock";

####################
# Set Lock File
####################
if ($input{'view'} ne $view_log) 
  {
	&SetLock;
  }

####################
# Read in Data File
####################
open(DATA,"$main_dir/$filename");
   @lines = <DATA>;
close(DATA);


#####################
# View Log
#####################
if ($input{'view'} eq $view_log) 
  {
	$spacing = "&nbsp;&nbsp;&nbsp;&nbsp;";

	print "HTTP/1.0 200 OK\n" if $ENV{PERLXS} eq "PerlIS";
	print "Content-type: text/html\n\n";

	print "<html>\n";
	print "<title>ClickCount Log Viewer</title>\n";
	print "<body bgcolor=FFFFFF>\n";
	print "<center>\n";
	print "<h1>ClickCount Log Viewer</h1>\n";
	print "<table border=1>\n";
	print "<tr><td colspan=1 bgcolor=\"CCFFFF\">$spacing<strong><u>Site</strong></u>$spacing</td>\n";
	print "<td colspan=1 bgcolor=\"FF9999\">$spacing<strong><u>Clicks/Hits</strong></u> $spacing</td></tr>\n";

	foreach $line (@lines)
  	  {
		($link_url1, $link_count1) = split(/\|/,$line);
  		print "<tr><td bgcolor=\"CCFFFF\" align=left>$link_url1 $spacing</td>\n";
		print "<td bgcolor=\"FF9999\" align=right>$spacing $link_count1</td></tr>\n";
  	  }

	print "</table>\n";
	print "<hr>\n";
	print "<br><em>Click Count Ver. 1.2.2</em>\n";
	print "<br>Created By: <a href=\"http://www.staff.net/cgi-scripts/\">Click-Scripts</a> ";
	print "</center>\n";
	print "</body>\n";
	print "</html>\n";
  }  

	
#####################
# Count Incrementing
#####################

else
  {

	open(DATA,">$main_dir/$filename");
	  foreach $line (@lines)
	  {
	  	($link_url1, $link_count1) = split(/\|/,$line);
	  	if ($input{'url'} eq $link_url1) 
		  {
			$link_count1++;
		 	print DATA ("$link_url1|$link_count1\n");
		 	$addnew=1;
	  	  }
	      else 
	  	  {
			print DATA $line;
	  	  }

	  }

	#####################
	# Auto Add entry
	#####################

	if ($addnew == 0 && $autoadd == 1)
	  {
		print DATA ("$input{'url'}|1\n");
	  }
	 &EndLock;

	#####################
	# Close Log File
	#####################
	close(DATA);



	#####################
	# Go to URL
	#####################

	if ($input{'url'} !~ m?://?)
	{
		$input{'url'} = "http://" . $input{'url'};
	}
	print "HTTP/1.0 302 Temporary Redirection\r\n" if $ENV{PERLXS} eq "PerlIS";
	print "Content-type: text/html\n";

	print "Location: $input{'url'}\n\n";

		
  } # Closes Else for View Log

	exit;


#-------------------------------------------------------------
# function: FormInput
#-------------------------------------------------------------
sub FormInput
{
local (*qs) = @_ if @_;

if ($ENV{'REQUEST_METHOD'} eq "GET")
        {
        $qs = $ENV{'QUERY_STRING'};
        }
elsif ($ENV{'REQUEST_METHOD'} eq "POST")
        {
        read(STDIN,$qs,$ENV{'CONTENT_LENGTH'});
        }

@qs = split(/&/,$qs);

foreach $i (0 .. $#qs)
        {
        $qs[$i] =~ s/\+/ /g;
        $qs[$i] =~ s/%(..)/pack("c",hex($1))/ge;

        ($name,$value) = split(/=/,$qs[$i],2);

        if($qs{$name} ne "")
                {
                $qs{$name} = "$qs{$name}:$value";
                }
        else
                {
                $qs{$name} = $value;
                }
        }

return 1;
}

#-------------------------------------------------------------
# SetLock: Subroutine
#-------------------------------------------------------------
sub SetLock {

        $timecheck = 0;
	while(-e $lock)
	    {
            sleep(5);
	    $timecheck = $timecheck + 1;
	    if ($timecheck >= 5)
		{
		unlink("$lock");
		}
	    }
        open(LOCKFILE,">$lock");
        close(LOCKFILE);
        return;
}

#-------------------------------------------------------------
# EndLock: Subroutine
#-------------------------------------------------------------
sub EndLock {

	unlink("$lock");
        return;
}