#!/usr/bin/perl

#
# Enjoy this program.  Feel free to distribute it as you feel with my name still in it.
#   Robert R. Dell
#

$version = "getcount 3.0.0";

# tell the web browser we're going to send it HTML text it needs to process
# instead of plain text which it can display without processing
print "Content-type: text/html\n\n";

# get the query string
if ($ENV{'REQUEST_METHOD'} eq 'GET') {
   # Split the name-value pairs
   @pairs = split(/&/, $ENV{'QUERY_STRING'});
}
elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
   # Get the input
   read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});

   # Split the name-value pairs
   @pairs = split(/&/, $buffer);
}
else {
   print "Unable to process your request $version\n";
   exit 0;
};

# absolute path to the counter file on the website.
$logpath = "/Library/Webserver/Documents/count.shtml";
$theurl = "";

# we SHOULD unload $buffer at this stage to reduce memory requirements but
# in these days of massive megs of RAM, nobody worries about regaining 80
# or so bytes right?

foreach $pair (@pairs) {

   # Split the pair up into individual variables.                       #
   local($name, $value) = split(/=/, $pair);

   # Decode the form encoding on the name and value variables.          #
   # v1.92: remove null bytes                                           #
   $name =~ tr/+/ /;
   $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
   $name =~ tr/\0//d;

   $value =~ tr/+/ /;
   $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
   $value =~ tr/\0//d;
   $item = 0;

   if ($name eq 'url') {
     $theurl = $value;
     }
   }

if ($theurl eq "") {
  print "Unable to process your request $version\n";
  exit 0;
  };

$theurl =~ s/\n//;

open (LOG, "$logpath");
@data = <LOG>;
close(LOG);

if ($#data == -1) {
  print "Unable to open the counter file $version\n";
  print "fixlog.pl must be executed at least once\n";
  exit 0;
  };

$found = 0;

foreach $myarray_line(@data) {
  $oldmyarrayline = join("",$myarray_line);
  $url = join("","<tr><td><a href=\"",$theurl,"\">",$theurl,"</a>:</td>");
  if ($myarray_line =~ m/$url/) {
    $oldmyarrayline =~ s/^.*<\/td><td>//;
    $oldmyarrayline =~ s/\n//;
    $oldmyarrayline =~ s/\r//;
    $oldmyarrayline =~ s/<.*$//;
    $count = $oldmyarrayline;
    print $count;
    $found = 1;
    }
  };

if ($found == 0) {
  print "0";
  };


exit 0;

=head1 getcount

This script gets the counter information from a counter file which happens to be a
web page.

=head1 DESCRIPTION

This script scans through the site's counter file looking for the url you requested.
If it doesn't find the url, it returns 0.

=head1 AUTHOR

Robert R. Dell xyzzy@cpan.org

=head1 README

This script scans through the site's counter file looking for the url you requested.
If it doesn't find the url, it returns 0.

=head1 PREREQUISITES

fixlog.pl

=head1 COREQUISITES

CGI

=pod OSNAMES

any

=pod SCRIPT CATEGORIES

Web

=cut