#!/usr/bin/perl
##############################################################################
# clickcount.pl     V1.1                                                     #
# COPYRIGHT NOTICE                                                           #
# Copyright 1998 Wolfgang Wiese     All Rights Reserved.                     #
#       EMail: xwolf@xwolf.com                                               #
#       URL  : http://www.xwolf.com/                                         #
#                                                                            #
# clickcount.pl may be used and modified free of charge by anyone so long as #
# this copyright notice and the comments above remain intact.  By using this #
# code you agree to indemnify Wolfgang Wiese from any liability that         #  
# might arise from it's use.                                                 #  
#                                                                            #
# Selling the code for this program without prior written consent is         #
# expressly forbidden.  In other words, please ask first before you try and  #
# make money off of my program.                                              #
#                                                                            #
# Obtain permission before redistributing this software over the Internet or #
# in any other medium.	In all cases copyright and header must remain intact.#
##############################################################################


$LOGFILE='/var/www/html/thueringen/clicks/clickcount.txt';
	# Logfile - Hierin werden die Clicks geschrieben

$ALTLINK=$ENV{'HTTP_REFERER'} || 'http://www.thueringen-urlaub.de/';	
	# Hierin kommt man, wenn kein Link angegeben wurde
@ignore_host=("131.188.73.16","131.188.73.28");
	# Diese Hosts werden nicht mitgezaehlt

# Benutzung:
# Anstlle des Eintrags in einer HTML-File:
# <a href="http://www.uni-erlangen.de/docs/RRZE/blabla.html">
# schreibt man:
# <a href="http://www.uni-erlangen.de/cgi-bin/clickcount.pl?http://www.uni-erlangen.de/docs/RRZE/blabla.html">
# Die Clicks fuer diese Seite werden dann gezaehlt.
# 4.03.1998 , Wolfgang Wiese
# GGf. laesst sich das Logfile noch erweitern mit der Angabe des benutzten Browser..

################################################################################
# Main program after this point. Don't change
################################################################################
$LOCK_SH = 1;
$LOCK_EX = 2;
$LOCK_NB = 4;
$LOCK_UN = 8;
 
 $notignore=1;
 
 if ($ENV{'REQUEST_METHOD'} eq "GET") { $buffer = $ENV{'QUERY_STRING'}; } 
 else { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});  }
 
 if (!($buffer)) {$buffer=substr($ENV{'PATH_INFO'},1,length($ENV{'PATH_INFO'}));}
 if (!($buffer)) {$buffer=@ARGV; }

 $buffer =~ tr/+//;
 $buffer =~ tr/ //;
 $buffer =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
 $buffer =~ s/[\x00-\x20<>\|;\(\)\$^\+!\^\[\]\?\"\'\`]//g;

 if (!($buffer)) {&Redirect($ALTLINK);}
 
 for ($i=0;$i<=$#ignore_host;$i++) {
  if ($ignore_host[$i] eq $ENV{'REMOTE_ADDR'}) {$notignore=0;}
 }
 if ($notignore) {&WriteLog;}
 &Redirect($buffer);

exit(0);
#################### Subroutines ########################
sub WriteLog {
 my ($i)=0;
 my ($oldlink)=0;
 my ($name,$version);
 
 if (-r $LOGFILE) {
  open(f1,"$LOGFILE") || &Redirect($ALTLINK);
   while(<f1>) {
    chop($_);
    $clickinfo[$i++]=$_;
    if ($_ =~ /^$buffer/) {
     $oldlink=1;
    }
   }
  close f1;
 }
# $oldlink=0;
 if ($oldlink==0) {
  open(f1,">>$LOGFILE") || &Redirect($ALTLINK);
   flock(f1,$LOCK_EX);
   seek(f1, 0, 2);
   print f1 "$buffer, 1\n";
   flock(f1,$LOCK_UN); 
  close f1;
 } else {
  open(f1,">$LOGFILE") || &Redirect($ALTLINK);
   flock(f1,$LOCK_EX);
   seek(f1, 0, 2);
   for ($i=0;$i<=$#clickinfo;$i++) {
    if ($clickinfo[$i] =~ /^$buffer/) {
     ($page,$hit)=split(/, /,$clickinfo[$i]);
     $hit++;
     print f1 "$page, $hit\n";
    } else {
     print f1 "$clickinfo[$i]\n";
    }
   }
   flock(f1,$LOCK_UN); 
  close f1;
 }
}
################################################################################
sub Redirect {
 my($url)=@_;
 print "Status: 302 Found\n";
 print "Location: $url\n";
 print "URI: <$url>\n";
 print "Content-type: text/html\r\n\r\n";
 exit(1);
}
################################################################################