Counter
This page has been viewed 1101 times
The counter was inserted into this page with the following command:
<!--#include virtual="/cgi-bin/Counter.pl?500"-->
If I did not include the parameter of 500 then the command would be the following:
<!--#exec cgi="/cgi-bin/Counter.pl"-->
Note that this web page has the extension of shtml which tells the web server to parse and process any CGI commands found within the web page. This particular counter can count individual web pages as it creates a unique tracking file for each page on which it is placed. It also has a minimum count option.
Below is the Perl source code for this counter:
#!/usr/bin/perl -Tw
use strict;
use Fcntl; # Needed for O_CREAT|O_RDWR|O_NONBLOCK definitions
use Fcntl qw(:flock); # Needed for LOCK_EX definition
use CGI ':standard';
# This makes warnings and error appear in the Browser.
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
# By the way, Perl converts strings to integers with the following code:
# $number = $string + 0. Bizarre.
my $lnMinimumCount = 0;
if (defined($ENV{INC_QUERY_STRING}))
{
$lnMinimumCount = $ENV{INC_QUERY_STRING} + 0;
}
elsif (defined($ENV{QUERY_STRING}))
{
$lnMinimumCount = $ENV{QUERY_STRING} + 0;
}
my $lcMessage = "";
my $lcFileName = UnTaint($ENV{DOCUMENT_URI});
my $lcCounterFile = $lcFileName . ".dat";
my $lnVisits = 0;
if (sysopen(LNFILESTREAM, $lcCounterFile, O_CREAT|O_RDWR|O_NONBLOCK))
{
# Wait for a lock.
flock(LNFILESTREAM, LOCK_EX);
$lnVisits = <LNFILESTREAM>;
$lnVisits = ($lnVisits < $lnMinimumCount) ? $lnMinimumCount : $lnVisits + 1;
# Set to the beginning of the file
sysseek(LNFILESTREAM, 0, 0);
print LNFILESTREAM "$lnVisits";
close (LNFILESTREAM);
}
else
{
$lcMessage = "Can't open $lcCounterFile";
}
if (length($lcMessage) == 0)
{
$lcMessage = $lnVisits;
}
print "Content-type: text/html\n\n$lcMessage";
#--------------------------------------------------------------------
sub UnTaint
{
my $lcString = $_[0];
$lcString =~ s/\///g ;
$lcString =~ s/\.shtml//g ;
$lcString =~ s/\.html//g ;
$lcString =~ s/\.htm//g ;
$lcString =~ s/\;//g ;
if ($lcString =~ /^([-\@\w.]+)$/)
{
$lcString = $1;
}
return ($lcString);
}
#--------------------------------------------------------------------
This program is licensed under the Common Public License. This FAQ should answer most of your questions on this particular license.