#!/usr/local/bin/perl
#
# VersaCounter (version 1.0)
#
# Copyright (c) 1998 Michael Chavel (chavel@aquilo.net)
# You may use this program for PERSONAL AND NON-PROFIT PURPOSES ONLY!
#
# The most recent version of this program and documentation can
# be found at http://www.aquilo.net
###
# use in web page
# with Server Side Includes:
#
#
# without Server Side Includes:
#
#
# (change the script name vcounter to vcounter.cgi as necessary.)
#
# options include:
# page=PAGE_NAME The NAME can be any text string you like (no spaces).
# If unspecified the pages path/name is taken from
# the DOCUMENT_URI environment variable (SSI)
# or the HTTP_REFERER variable (non-SSI).
# style=STYLE_NAME The style of digits to be used in the counter.
# "text" is the default. Other options are given by
# the names of the subdirectories in the $digits_dir.
# Currently: "LED", "LED_g", "LED_r", "odometer",
# "odometer_sm", "curly", "rosewood"...
# More GIFs can be added, just create the coresponding
# directory and the "size" file containing:
# x (all digits within a
# style must be the same size).
# show=counter displays "[counter value]" (default action)
# show=all displays "[counter value] hits since [date initalized]"
# show=date displays just the "[date initialized]", no counter increment
# show=nothing displays nothing, but does increment the counter file
# hidden=1 same effect
# invisible=1 same effect
# digits=N pads the counter with left zeros to be at least N digits
# commas=0 remove commas from text counter
# trans=r,g,b rgb color to make transparent
# link=1 adds a hyperlink around the counter to $LINKURI
# align=[top][middle][bottom] alignment of text after counter (bottom default)
# increment=0 no counter increment (in case of multiple counters on a page)
# block=N block incrementing from consecutive reloads for N seconds
# header=0 when calling this script from another CGI script (passing
# the page name via the URI_DOCUMENT variable and options
# via the QUERY_STRING variable) set header=0, allowing
# the calling script to output the HTTP header.
# the next two options only need to be given (if desired) upon initial use:
# start=NUM initialize counter to the starting value NUM
# start_date=DATE initialize counter to the starting date DATE (any format)
###
use 5.004;
use CGI qw(:cgi);
use Fcntl qw(:flock);
use GD;
### site defaults:
$site_URI = 'http://www.disneywarehouse.com'; # URI of this site
$wd = '/home/disney/public_html/'; # full directory path to the root of site
$digits_dir = 'digits/'; # dir of GIF digits (relative to $wd)
$log_dir = 'cgi-bin/versacount/logs/'; # dir for log files (relative to $wd)
$image_dir = 'logs/'; # dir for counter images (relative to $wd)
$error_log ="$wd$log_dir".'error.log';
$auto_init = 1; # allow automatic creation of counters for new pages
%valid_servers = ('www.bigschool.edu'=> 1, # valid **remote** servers
'www.greatstuff.com'=> 1 # for counters (1=yes 0=no)
);
$link = $site_URI.'/cgi-bin/stats'; # hyperlink to place around counter
$resolve = 0; # resolve IP addresses to DNS names in logs
$hr_adjust = 0; # add this to local hour for starting date
$text_string = 'hits since'; # text displayed between
# counter and date for show=all
### user overrideable defaults:
$show = 'counter';
$style = 'text'; # for SSI usage
$imagestyle = 'odometer'; # for non SSI usage
$pad_to = 0;
$align = 'bottom';
$commas = 1;
$invisible = 0;
$increment = 1;
$log = 1;
$http_header= 1;
$block_time = 60*60; # block counter from incrementing from consequtive
# hits by the same host within 360 seconds (= 1 hour)
###
# uncomment to log errors
#open (ERROR, "> $error_log") || bail("cannot open error file:$!");
#flock(ERROR, LOCK_EX) || bail("cannot flock error file: $!");
$remote_host = $ENV{'REMOTE_HOST'};
$SSI_URI = $ENV{'DOCUMENT_URI'} if ($ENV{'DOCUMENT_URI'});
$referer = $ENV{'HTTP_REFERER'};
$referer =~ s/^$site_URI(.)/$1/o; # remove $site_URI if not a remote web page
$string = param('page') || $SSI_URI || $referer; # page to be counted
$string =~ s/\%7E/~/g; # fix any URL escaped '~' characters
if ($string =~ /\/$/) { # chop off any trailing /'s in page identifier
chop($string);
};
$string =~ tr/\?\&/||/; # substitute '|' for '?' and '&'
$string =~ s/^http:\/\/(.)/$1/; # remove http://
($page, @query) = (split(/\|/, $string)); # split page name from query string
$end = index($page, '/'); # (if present)
$host = substr($page, 0, $end) if $end>0;
$page =~ tr/\//_/; # substitute '_' for '/'
$link .= '?page='.$page;
$style = $imagestyle if (!$SSI_URI);
$time=time();
# parse options from the query string
$show = param('show') if (length(param('show')));
$style = param('style') if (param('style'));
$pad_to = param('digits') if (length(param('digits')));
$commas = param('commas') if (length(param('commas')));
$transparent = param('trans') if (length(param('trans')));;
$link = 0 if (!param('link'));
$align = param('align') if (param('align'));
$invisible = 1 if ($show =~ m/nothing/i || $show eq '0');
$invisible = 1 if (param('invisible') || param('hidden'));
$increment = param('increment') if (length (param('increment')));
$increment = 0 if ($show =~ m/date/);
$block_time = param('block') if (length(param('block')));
$log = param('log') if (length(param('log')));
$http_header = param('header') if (length(param('header'))) ;
$init = param('start');
$init_date = param('start_date');
if ($http_header) { # output http header unless being called from a CGI script
if (length($SSI_URI)) {
print "Content-type: text/html\n" ; # http header for SSI mode
print "Pragma: no-cache\n";
print "Expires: now\n\n";
} else {
$| = 1; binmode STDOUT;
print "Content-type: image/gif\n" ; # http header for image tag
print "Pragma: no-cache\n";
print "Expires: now\n\n";
if ($invisible) { # output blank (transparent gif)
$blank = new GD::Image(1,1);
$backgrnd = $blank->colorAllocate(0,0,0);
$blank->transparent($backgrnd);
print $blank->gif;
} else {
bail('cannot display text without SSI') if (lc($style) eq 'text');
$link = 0; # not SSI mode: so no link
$commas = 0; # no commas
$show = 'counter'; # ignore 'date' and 'all' requests
};
};
};
if (valid($host) ) {
if ((-e "$wd$log_dir$page")) {
&update_counter; # get date and count for page
} elsif ($auto_init == 1) {
&new_counter; # or make file for new counter
} else {
bail("counter does not exist: $! "); # or die if auto_init disabled
};
} else {
bail("invalid counter URL from $host");
};
if (!$invisible) {
if (lc($show) eq 'date') { # if show=date just print date
print "$date";
} else { # otherwise...
$count_length = length($count); # pad $count if smaller than $pad_to
for ($i = $pad_to;$i>$count_length;$i--) {
$count = "0$count";
};
if (lc($style) ne 'text') { # build counter GIF and HTML image tag
&build_gif_image;
if ($SSI_URI) {
open(COUNT_GIF, "> $wd$image_dir$page".'-.gif') ||
bail("cannot open gif file $wd$image_dir$page".'-.gif'."$!");
print COUNT_GIF "$image_gif";
close(COUNT_GIF) ||
bail("cannot close gif file $wd$image_dir$page".'-.gif:'."$!");
$count = '';
###
# One could handle the SSI operation this way, without using
# the Gd.pl module. But, it seems less elegant.
#
# $counter='';
# $new_cnt_length = length($count);
# for ($i=0; $i<$new_count_length ; $i++) {
# $number = substr($count,$i,1);
# $counter .= '';
# };
# $count = $counter;
###
} else {
$count = $image_gif;
};
} elsif ($commas) {
$new_cnt_length = length($count);
$gsd = $new_cnt_length - $count_length;
for ($j=$new_cnt_length-3; $j>$gsd; $j-=3) {
$three_places = substr($count,$j,3);
$left = substr($count,0,$j);
if (!$comma_count) {
$comma_count = ','.$three_places;
} else {
$comma_count = ','.$three_places.$comma_count;
};
};
$count = $left.$comma_count if ($left);
};
if ($link) { # add link, if specified
$count = ''.$count.'';
};
if (lc($show) eq 'all') { # print counter with date
print "$count $text_string $date";
} else { # or just the counter
print "$count";
};
};
};
&update_log if ($log && $increment);
#close(ERROR);
sub update_counter { # subroutine to update count file
open(COUNT,"+< $wd$log_dir$page") || # open corresponding count file
bail("cannot open $wd$log_dir$page: $!");
flock(COUNT, LOCK_EX) || bail ("cannot flock $wd$log_dir$page: $!");
chomp($line = );
($count,$date,$previous_host,$previous_time,
$init, $init_time) = split(/\|/,$line);
$increment = 0 if ( (lc($remote_host) eq lc($previous_host))
&& ($time-$previous_time < $block_time) );
if ($increment) {
$count++ ; # increment counter value and save
seek(COUNT, 0, 0) || bail("cannot rewind $wd$log_dir$page: $!");
print COUNT "$count\|$date\|$remote_host\|$time\|$init\|$init_time\n";
truncate(COUNT, tell(COUNT)) ||
bail("cannot truncate $wd$log_dir$page: $!");
};
close(COUNT) || bail("cannot close $wd$log_dir$page: $!");
}
sub update_log { # subroutine to update log file
if ($resolve && $remote_host =~ m/^\d+\.\d+\.\d+\.\d+$/) {
$rhost = hostname($remote_host) || $remote_host;
# resolve IP address to DNS name
} else {
$rhost = $remote_host;
};
open(LOG,">> $wd$log_dir$page".'.log') ||
bail("cannot open $wd$log_dir$page".".log: $!");
flock(LOG, LOCK_EX) || bail ("cannot flock $wd$log_dir$page"
.".log:: $!");
print LOG "$time|$rhost\|$referer\|$ENV{'HTTP_USER_AGENT'}\n";
close(LOG) || bail("cannot close $wd$log_dir$page".".log: $!");
}
sub new_counter { # subroutine to initalize a new counter
@months = ("January","February","March","April","May","June","July",
"August","September","October","November","December");
($mday,$mon,$year) = (localtime($time+$hr_adjust*3600))[3,4,5];
$year += 1900; #Y2K OK!
$date = $init_date || "$months[$mon] $mday, $year";
$count = $init || '1';
open(COUNT,"> $wd$log_dir$page") ||
bail("cannot create $wd$log_dir$page: $!");
flock(COUNT, LOCK_EX) || bail ("cannot flock $wd$log_dir$page: $!");
print COUNT "$count\|$date\|$remote_host\|$time\|$init\|$time\n";
close(COUNT) || bail ("cannot close $wd$log_dir$page: $!");
}
sub build_gif_image { # subroutine to build GIF image of counter
# from individual digit GIFs and save
$new_cnt_length = length($count);
open(SIZE, "$wd$digits_dir$style/size") ||
bail("cannot find digit style $style: $!") ;
($digit_width, $digit_height) = split (/x/,);
$image_width = $digit_width*$new_cnt_length;
close(SIZE) || bail();
$image = new GD::Image($image_width,$digit_height);
for ($i=0; $i<$new_cnt_length ; $i++) {
$number = substr($count,$i,1);
open (DIGIT, "$wd$digits_dir$style/$number".'.gif') || bail();
$digit = newFromGif GD::Image(DIGIT);
$image->copy($digit, $i*$digit_width,0, 0,0,
$digit_width,$digit_height);
close(DIGIT) || bail();
};
if ($transparent) {
($r,$g,$b) = split(/\,/, $transparent);
$trn_color = $image->colorClosest($r,$g,$b);
$image->transparent($trn_color);
};
$image_gif = $image->gif;
}
sub hostname {
my (@bytes,
$packedaddr,
$host_name
);
@bytes = split(/\./, $_[0]);
$packedaddr = pack("C4",@bytes);
$host_name = (gethostbyaddr($packedaddr, 2))[0];
return($host_name);
}
sub valid { # function to validate remote host
if ($valid_servers{$_[0]} || length($_[0])==0) {
return 1;
} else {
return 0;
};
}
sub bail { # function to output errors to browser
my $error = "@_";
print "Error:", $error;
print ERROR "$error\n";
# while (($key, $val) = each %ENV) { # for testing only
# print ERROR "$key = $val\n"; #
# }; #
die $error;
}
';
###
# One could handle the SSI operation this way, without using
# the Gd.pl module. But, it seems less elegant.
#
# $counter='';
# $new_cnt_length = length($count);
# for ($i=0; $i<$new_count_length ; $i++) {
# $number = substr($count,$i,1);
# $counter .= '
';
# };
# $count = $counter;
###
} else {
$count = $image_gif;
};
} elsif ($commas) {
$new_cnt_length = length($count);
$gsd = $new_cnt_length - $count_length;
for ($j=$new_cnt_length-3; $j>$gsd; $j-=3) {
$three_places = substr($count,$j,3);
$left = substr($count,0,$j);
if (!$comma_count) {
$comma_count = ','.$three_places;
} else {
$comma_count = ','.$three_places.$comma_count;
};
};
$count = $left.$comma_count if ($left);
};
if ($link) { # add link, if specified
$count = '
