#!/usr/local/bin/perl
#
# program name : gcounter (graphic counter by cgi and gif images)
#
# function : count the number of guests and send counter gif file to
# browser.
#
# note : This counter is made for web site where cgi written by perl
# is available.
#
# programmer : makoto takenaka : takesoft@mxs.meshnet.or.jp
#
# copyright : (c) 1996 by Takesoft
#
# version(date):
# 1.0(June 13, 1996)
# 1.1(Oct 13, 1996) Add one to count.txt at smallest place(1 no kurai).
# Change designation of dir variables to include "/".
# Add parameter cf(count number file name) to
# input the file name of $countfile.
# 1.2(Oct 28, 1996) Remove $incr parameter because counter is always
# incremented at first digit from right.
#
# calling form :
#
# or
#
# ,where n means the n-th digit of the counter from the right.
# If cf is not specified, cf=count.txt is supporsed.
#
#(1) set constants.
#
$max_digit = 10;
#
# If absolute dir is required, change $count_dir and $gif_dir such as
# "/home*/user_id/public_html/" or "/home/usr**/user_id/public_html/image/",
# where * is a number.
#
$count_dir = "./"; # directory of count number file
$gif_dir = "./image/"; # directory of number gif files
#
#(2) get parameters from string.
#
$buffer = $ENV{'QUERY_STRING'};
#
@pairs = split(/&/, $buffer);
#
foreach $pair (@pairs)
{
($name, $value) = split(/=/, $pair);
$parameters{$name} = $value;
}
#
$digit = $parameters{'digit'};
$cf = $parameters{'cf'};
unless($cf)
{$cf = "count.txt";} # default value of cf
#
$countfile = "${count_dir}$cf"; # file of count number
#
#(3) Set $count.
#
#
open(COUNTFILE, "$countfile")
|| &error_mail("(3): Unable to open $countfile as read only file");
$count = ;
close(COUNTFILE);
#
# add ten "0" ahead of $count.
#
$count = "0000000000".$count;
#
#(4) get n-th digit from right in $count
# and send the gif image of the digit.
#
if($digit<1 || $digit > $max_digit)
{&error_mail("(4) wrong position in counter from right, digit = $digit")}
#
$d = substr($count, (-1)*($digit), 1);
#
if($d < 0 || $d > 9)
{&error_mail("(5) wrong number d, d = $d")}
#
$gif_file = "${gif_dir}${d}.gif";
#
#(5) send gif file to browser.
#
print "Content-type: image/gif\n\n";
#
# next part is equivalent to
#
# system("/bin/cat $gif_file"); or `/bin/cat $gif_file`;
#
# but not available in meshnet.
#
open(GIF_FILE, $gif_file)
||&error_mail("(5) Unable to open gif file.");
#
while(read(GIF_FILE, $buf, 16384))
{
print $buf;
}
close(GIF_FILE);
#
#(6) Increment $count if $digit is 1.
#
if ($digit == 1)
{
#
#(6.1) Wait a while to be the last completed cgi if $digit is 1.
# If select is not supported in your server, use "sleep(1);"
# to wait 0-1 sec.
#
select(undef, undef, undef, 0.5); # Wait 0.5 sec.
#
#(6.2) Open $countfile and increment $count.
#
open(COUNTFILE, "+< $countfile")
|| &error_mail("(6): Unable to open $countfile as read-write file");
flock(COUNTFILE, 2);
$count = ;
$count = $count + 1;
seek(COUNTFILE, 0, 0);
print COUNTFILE $count;
flock(COUNTFILE, 8);
close(COUNTFILE);
}
exit 0;
#
sub error_mail
{
local($message) = @_;
#
#(sub routine) Send error mail.
#
# If you want to use error mail, change mail address to yours
# and uncomment(remove #) next four lines.
# But at some provider such as rimnet, sending mail from cgi is not
# allowed. At some provider simple mail command may not available.
# In such case, do not mail, but print on some file, which is to be
# prepared with access mask "606".
#
# open(MAIL, "|mail user-id\@xxx.yyyyyy.or.jp");
# print MAIL "Error Message from gcounter.cgi of home page: \n";
# print MAIL "$message\n";
# close(MAIL);
#
# stop this perl program.
#
die;
}