#!/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; }