|
|
|
PERL/CGI Books |
|
####################################################################
# Countlink Version 1.0
# Copyright 1998 Edward Preble info@datatrendsoftware.com
# Created 01/11/99 Last Modified 01/11/99
# Datatrend Software http://www.datatrendsoftware.com/cgi.html
####################################################################
# This script will do the following:
# 1. Is activated by a link,
# "http://www.site.com/scripts/countlink.cgi?linkaddress"
# 2. Will add a count to "countlink.log", for the proper file.
# 3. Will auto-forward to http://linkaddress.
# 4. The interface is seamless, no user prompts.
####################################################################
# COPYRIGHT NOTICE
# Copyright 1998 Edward Preble All Rights Reserved.
#
# This script is free. You may use and modify this script as you please.
# Do not remove this header, as it is the only thing that gives me credit
# for my work in writing this code. If you wish to sell this code, you
# must obtain permission from the authors first.
#
# Scripts provided by Datatrend Software are supplied "as-is". You agree
# to indemnify the author's from any liability that may arise from the use
# of this script. We will provide support for bugs and operation issues,
# but NOT for installation. Sorry for that, but it is just too time
# consuming and the volume of requests is truly staggering.
#
# Obtain permission before redistributing this software over the Internet or
# in any other medium. In all cases copyright and header must remain intact
####################################################################
#
# You must modify the the location of PERL in the first line above to match
# the location on your server. Your system admin must help you with this.
# You must also modify the following variable to match your preferences.
# This is the total counter log filename
$Counter = '/usr/yourdir/docs/scripts/logs/countlink.log';
##########################################################
# No changes need to be made after these lines
##########################################################
$link = $ENV{'QUERY_STRING'};
# Add hit to main counter
open (CNT,"+<$Counter") || &endIt;
flock (CNT,2); seek (CNT,0,0);
@infile = <CNT>;
# This will put the hits in order from max to min for each file added
$record = 0; # Starting record in the log is always 0
$correctspot = 'N'; # Tells script if this record is the one that was hit
# Proceeds as long as the record number is less than the total
# number of records in the file and the correct record hasn't been found yet.
while (($correctspot eq 'N') && ($record <= $#infile))
{ ($count,$linkname,$eol) = split(/\|/,$infile[$record]);
if ($linkname eq $link) #if this is the right record, hit it, trip correctspot
{$count++;
$infile[$record] = join ("\|",$count,$linkname,"\n");
$correctspot = 'Y';
}
$record++;
}
if ($correctspot eq 'N')
{ $count = 1;
$newrecord = join ("\|",$count,$link,"\n");
push @infile, $newrecord;
}
@outfile = sort {($b =~ /(\d+)/)[0] <=> ($a =~ /(\d+)/)[0]} @infile;
seek (CNT,0,0);
print (CNT @outfile);
truncate (CNT,tell(CNT));
close (CNT);
#############
print "Content-type: text/html\n";
print "Location: http://$link\n\n";
sub endIt # exit on error
{ exit;
} # end endIt