scripts/cgi/count.cgi

   1 #!/usr/bin/perl
   2
   3 #
   4 # A simple counter program which maintains counts for
   5 # all files in a single counts file. Some systems may
   6 # not allow "." files to be created, so you should
   7 # rename the count file.
   8 #
   9 #
  10
  11 #
  12 # get name of accessed document
  13 #
  14 $doc = $ENV{'DOCUMENT_URI'};
  15 $host= $ENV{'REMOTE_HOST'};
  16 $path= $ENV{'PATH_INFO'};
  17 $server= $ENV{'SERVER_NAME'};
  18
  19 #
  20 # open counts file for read & write
  21 # get an exclusive lock on it
  22 #
  23 open(COUNTS, "+< /usr/lib/cgi-bin/hit_counts") || die("error: can't open hit_counts.\n");
  24 flock(COUNTS, 2);  # will wait for lock
  25
  26 #
  27 # read counts database into associative array
  28 #
  29 while (<COUNTS>) {
  30   chop;
  31   ($count, $file) = split(/:/, $_);
  32   $counts{$file} = $count;
  33 }
  34
  35 # strip off silly www hostname bits.
  36 if ($server =~ /^www\./) {
  37   $server =~ s/^www\.//;
  38 }
  39
  40 # translate some domains into other domains to avoid maintaining multiple
  41 # hit count lists for the same sites that have different names.
  42 if ($server =~ /^gruntose\.org/) {
  43   $server =~ s/^gruntose\.org/gruntose.com/;
  44 }
  45 if ($server =~ /^gruntose\.net/) {
  46   $server =~ s/^gruntose\.net/gruntose.com/;
  47 }
  48 if ($server =~ /^cromp\.net/) {
  49   $server =~ s/^cromp\.net/cromp.org/;
  50 }
  51 if ($server =~ /^hoople\.net/) {
  52   $server =~ s/^hoople\.net/hoople.org/;
  53 }
  54
  55 #
  56 # increment count of hit document, but not if I'm the
  57 # one accessing it.
  58 #
  59
  60 #we could do without that line probably.
  61
  62 #
  63 # increment count for this file
  64 #
  65 $counts{$server.$doc}++;
  66
  67 #
  68 # rewrite count file
  69 # put file marker back at beginning
  70 #
  71 seek(COUNTS, 0, 0);
  72
  73 foreach $file (keys %counts) {
  74   print COUNTS $counts{$file}, ":", $file, "\n";
  75 }
  76
  77 close(COUNTS);
  78
  79 #
  80 # print count string to STDOUT
  81 #
  82 print "Content-type: text/plain\n\n";
  83
  84 print $counts{$server.$doc};
  85