#!/usr/bin/perl
# countess.xbm - Perl server-level script to count hits to users' WEB pages
# Credits:
#   Original C code:  Frans van Hoesel (hoesel@chem.rug.nl)
#   Original port to Perl: Dan Rich (drich@corp.sgi.com)
#   Modifications for cgi: Michael Nelson (m.l.nelson@larc.nasa.gov)
#   Modifications for NSF: Mike Morse (mmorse@nsf.gov)
#   Michael Breen got this from Michael Baine (mbaine@deimos.ucsd.edu)
#   Cleaned up by: Michael Breen(http://www.ucsd.edu/webmaster,mbreen@ucsd.edu)
#   Altered to work on the server-level: Sarang Gupta (sarang@sarangworld.com)
#   I (Sarang) have seriously hacked this program down to very very few lines.
#   This version does NOT provide additional stats... just a counter

# To install: Put this in your server-level cgi-bin directory, and make a
# world-writeable subdirectory called "tmp". The program will write counts.pag
# and counts.dir into this subdirectory. My experience is that the script file
# must have the extension ".xbm". Written in Perl5.001

#Users can put this on the page where they want to have a counter:
#<img src="http://YOUR_SERVER_NAME/cgi-bin/countess.xbm?USER_NAME">
#Users needing more than one counter can append a number to their name
#(e.g. sloppy1, sloppy2, sloppy3, etc...)

dbmopen(%COUNTS,"tmp/counts",0666);if(!defined $COUNTS{$ARGV[0]}){
    $COUNTS{$ARGV[0]}=0};unless($ARGV[2]){$ARGV[2]=0};srand;
if ($ARGV[1]) {print "Counter $ARGV[0] currently at: $COUNTS{$ARGV[0]}\n";
if ($ARGV[1]=~"RESET") {&check; $COUNTS{$ARGV[0]}=$ARGV[2];
			print "Counter $ARGV[0] reset to: $ARGV[2]\n"}
if ($ARGV[1]=~"RANDOM") {&check; $COUNTS{$ARGV[0]}=int(rand(10000000));
		   print "Counter $ARGV[0] randomized to: $COUNTS{$ARGV[0]}\n"}
if ($ARGV[1]=~"DELETE") {&check; delete $COUNTS{$ARGV[0]};
			print "Counter $ARGV[0] has been deleted\n"}exit 0}
&initialize;generateBitmap(++$COUNTS{$ARGV[0]});&wBitmap;
sub wBitmap {print ("Content-type: image/x-xbitmap\n\n");
    printf ("#define count_width %d\n#define count_height 16\n",56);
    print "static char count_bits[] = {\n","$fill"x21,@bytes,"$fill"x21,"}"}
sub generateBitmap {@fc= split(//,sprintf("%07d",$_[0]));
    for $y (0..9) {for (@fc) {push(@bytes,"0x".substr($nums[$_],$y*2,2).",")}}}
sub initialize {$isInverse=1;if($isInverse){$fill="0xff,";@nums=(
"c39999999999999999c3","cfc7cfcfcfcfcfcfcfc7","c3999f9fcfe7f3f9f981",
"c3999f9fc79f9f9f99c3","cfcfc7c7cbcbcd81cf87","81f9f9f9c19f9f9f99c3",
"c7f3f9f9c199999999c3","81999f9fcfcfe7e7f3f3","c3999999c399999999c3",
"c399999999839f9fcfe3")}else{$fill="0x00,";@nums=("3c66666666666666663c",
"30383030303030303030","3c66606030180c06067e","3c66606038606060663c",
"303038383434327e3078","7e0606063e606060663c","380c06063e666666663c",
"7e666060303018180c0c","3c6666663c666666663c","3c666666667c6060301c")}}
sub check{if($ARGV[0]!~/$ENV{'USER'}/){die "$ARGV[0]: Not your counter!"}}







# Please visit http://www.sarangworld.com/perlscript.php3 for a full list
# of my Perl scripts, or http://www.sarangworld.com/ to see my website