#!/usr/bin/perl
##########################################################################
# counter.cgi
##########################################################################
# 
#
##########################################################################

umask(000);

$delay = 5;
$update = 0;

# set input string to $query
if ($ENV{'REQUEST_METHOD'} eq 'GET') {
  $query = $ENV{'QUERY_STRING'};
}
elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
  read(STDIN, $query, $ENV{'CONTENT_LENGTH'});
  $update = 1;
}
#else {
#  print "ERROR: Bogus request method.\n";
#  exit;
#}

# split $query into fields
@fields = split('&', $query);
foreach (@fields) {
  /([^=]+)=(.*)/ && do {
    local ($field, $value) = ($1, $2);
    $query{$field} = &Decode($value);
  }
}

if( $update == 1 ) {
  $value  = $query{VALUE};
}

$image  = $query{IMAGE};
$digits = $query{DIGITS};
$tdelay = $query{DELAY};
$id     = $query{ID};
$referrer = $ENV{'HTTP_REFERER'};
$realpage = $referrer;
($realpage) = split '\?', $realpage;  #strip off query (if any)
($realpage) = split '\#', $realpage;  #strip off hash (if any)
$host  = $ENV{REMOTE_HOST};
$agent = $ENV{HTTP_USER_AGENT};
$agent =~ s/ /_/g;

if( $id eq "" ) { $id = "noid"; }

$realpage =~ s/www\.//i;
$realpage =~ s/prenticenet\.com/prenticenet.com/i;
$realpage =  lc($realpage);
$realpage =~ s/prenticenet\.com\/news/prenticenet.com\/home\/news/;
$realpage =~ s/index.html?//;
$realpage =~ s/#.*$//;  # is this really needed??

$realpage =~ s/[\||\`|\<|\>]//g;

$ip = "209.204.246.250";
$_ = "$realpage/";
if( /http:.*$ip\/(.*?)\/(.*?)\/.*/i ) { 
  $dat = "$1.$2";
  $username = $2;
  if( $id ne "" ) { $dat = $id; }
}
else {
  $realpage =~ s/\/$//g;
  $dat = "$realpage.";
  $dat =~ s/http:\/\///g;
  $dat =~ s/www\.//g;
  $dat =~ s/\//\./g;
}
$dat = "$dat.dat";

if( $id ne "" ) {
  $dat = "$id.dat";
}
if( $referrer !~ m/prenticenet.com/i ) {
  $dat = "bogus.dat";
}

if( $username eq "" ) { $username = "bogus"; }
if( $image eq "" )  { $image = "modocr"; }
if( $digits eq "" ) { $digits = 3; }
if( $tdelay ne "" ) { $delay = $tdelay; }
if( $digits > 10 )  { $digits = 10; }

$idir = "digits";
$cdir = "counter";

($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$tmp  = "00$min";
$min  = substr( $tmp, length($tmp) - 2 );
$tmp  = "00$hour";
$hour = substr( $tmp, length($tmp) - 2 );
$tmp  = "000$yday";
$yday = substr( $tmp, length($tmp) - 3 );
$now  = "$year$yday$hour$min";
$exp  = $now - $delay;

if( open DAT, "$cdir/$dat" ) {
  $count = <DAT>;                   # Read first line for count
  chop($count);                     # Remove newline 
  $nn = 0;
  $mk = 0;
  while( $line = <DAT> ) {          # Read remaining lines for xlist
    chop($line);
    ($t1, $t2) = split / /, $line;
    if( $t1 > $exp ) {
      if( $t2 eq "$host.$agent" ) { # If time not expired and visitor eq
        $xlist[$nn++] = "$now $t2"; #  host/agent, then update time
        $mk = 1;
        $count--;
      }
      else {                        # Else (if time not expired and
        $xlist[$nn++] = $line;      #  visitor ne host) keep line
      }
    }
  }
  close DAT;
  if( $mk == 0 ) {                      # If host/agent new to list,
    $xlist[$nn] = "$now $host.$agent";  #  add it
  }
}
else {
  if( $update == 0 ) { $count = 1; }
  else { 
    &DoError( "That ID does not exist .. the counter must be set up and working before you can change it." ); 
  }
}

if( $update == 1 ) {
  &DoMail( $username, $id, $count, $value ); 
  $count = $value; 
}
$tmp  = "0000000000$count";
$countstr = substr( $tmp, length($tmp) - $digits );

if( $update == 0 ) { &doIt; }

if( open CNT, ">$cdir/$dat" ) {
  $count++;
  print CNT "$count\n";
  foreach $line (@xlist) {
    print CNT "$line\n";
  }  
  close CNT;
}

exit;

##########################################################################
# subs

sub DoMail {
  local ($mailto, $pid, $num1, $num2 ) = @_;
    if (open (MAIL, "|/usr/lib/sendmail $mailto\@prenticenet.com")) {
      print MAIL "From: AutoMailer\@PrenticeNet.com\n";
      print MAIL "Subject: Counter change\n\n";
      print MAIL "*** Automated Delivery from PrenticeNet ***\n";
      print MAIL "Your counter has been reset.\n\n";
      print MAIL "PAGE ID: $pid\n";
      print MAIL "OLD NUMBER: $num1\n";
      print MAIL "NEW NUMBER: $num2\n\n";
      close (MAIL);
    }
  print <<HTML;
Content-type: text/html

<html><body><h2>Counter updated!</h2>
<b><a href="javascript:history.back();">Back</a></b>
</body</html>
HTML

}

sub doIt {
#  open OUT, ">counter.gif";
#  open OUT, ">-";
#  open OUT, ">&STDOUT";
#  $num = substr( $count, 0, 1 );
  $num = "0";
  if( open IMG, "$idir/$image$num.gif" ) {
    &doHeader;
    close IMG;
#  }
    for( $n=0; $n<$digits; $n++ ) {
      $num = substr( $countstr, $n, 1 );
      if( open IMG, "$idir/$image$num.gif" ) {
        &doImage;
        close IMG;
      }
    }
#  print OUT ";";
    print ";";
#  close OUT;
  }
  else {
    if( open IMG, "$idir/error.gif" ) {
      print "Content-type: image/gif\n\n";
      while( $line = <IMG> ) {
        print $line;
      }
    }
  }
}

#######################################################################

sub doHeader {
#  print OUT "Content-type: image/gif\n\n";
  print "Content-type: image/gif\n\n";
  $trash = &cRead( IMG, 6 );
#  print OUT "GIF89a";
  print "GIF89a";
  $tmp1 = ord( &cRead( IMG, 1 ) );
  $tmp2 = ord( &cRead( IMG, 1 ) );
  $X = ($tmp2 * 256) + $tmp1;
  $WID = $X * $digits;
  $tmp1 = ord( &cRead( IMG, 1 ) );
  $tmp2 = ord( &cRead( IMG, 1 ) );
  $HGT = ($tmp2 * 256) + $tmp1;
#  print OUT pack( "c", $WID );
  print pack( "c", $WID );
#  print OUT pack( "c", 0 );
  print pack( "c", 0 );
#  print OUT pack( "c", $HGT );
  print pack( "c", $HGT );
#  print OUT pack( "c", 0 );
  print pack( "c", 0 );
  $tmp0 = &cRead( IMG, 1 );
#  print OUT $tmp0;
  print $tmp0;
  $tmp1 = unpack( "B8", $tmp0 );
  $M = substr( $tmp1, 0, 1 );
  $P = substr( $tmp1, 5, 3 );
  $tmp1 = substr( $P, 2, 1 );
  $tmp2 = substr( $P, 1, 1 );
  $tmp3 = substr( $P, 0, 1 );
  $COL = 2 ** (($tmp1 * 1) + ($tmp2 * 2) + ($tmp3 * 4) + 1);
#  print OUT &cRead( IMG, 2 );
  print &cRead( IMG, 2 );
  # --- Global color map ---
  if( $M == 1 ) {
    for( $i=0; $i<$COL; $i++ ) {
#      print OUT &cRead( IMG, 3 );
      print &cRead( IMG, 3 );
    }
  }
}

sub doImage {
  $trash = &cRead( IMG, 10 );
  $tmp0 = &cRead( IMG, 1 );
  $tmp1 = unpack( "B8", $tmp0 );
  $M = substr( $tmp1, 0, 1 );
  $P = substr( $tmp1, 5, 3 );
  $tmp1 = substr( $P, 2, 1 );
  $tmp2 = substr( $P, 1, 1 );
  $tmp3 = substr( $P, 0, 1 );
  $COL = 2 ** (($tmp1 * 1) + ($tmp2 * 2) + ($tmp3 * 4) + 1);
  $trash = &cRead( IMG, 2 );
  # --- Global color map ---
  if( $M == 1 ) {
    for( $i=0; $i<$COL; $i++ ) {
      $trash = &cRead( IMG, 3 );
    }
  }
  # --- Image ---
  $tmp1 = &cRead( IMG, 1 );

#  $tmp0 = &cRead( IMG, 1 );
  if( $tmp1 eq "!" ) {
    while( $tmp1 ne "," ) { 
#      print OUT $tmp1;
      print $tmp1;
      $tmp1 = &cRead( IMG, 1 );
    }
  }

  if( $tmp1 eq "," ) {
#    print OUT $tmp1;
    print $tmp1;
    $trash = &cRead( IMG, 8 );     # eat the next 8 bytes
    $x = $n * $X;
#    print OUT pack( "c", $x );    # write x,y location
    print pack( "c", $x );    # write x,y location
#    print OUT pack( "c", 0 );
    print pack( "c", 0 );
#    print OUT pack( "c", 0 );
    print pack( "c", 0 );
#    print OUT pack( "c", 0 );
    print pack( "c", 0 );
#    print OUT pack( "c", $X );    # write x,y size
    print pack( "c", $X );    # write x,y size
#    print OUT pack( "c", 0 );
    print pack( "c", 0 );
#    print OUT pack( "c", $HGT );
    print pack( "c", $HGT );
#    print OUT pack( "c", 0 );
    print pack( "c", 0 );
    
#print "LOCATION=$x,0  SIZE=$X x $HGT ";

#    print OUT &cRead( IMG, 1 );    # assume NO local color map!!!
    print &cRead( IMG, 1 );    # assume NO local color map!!!

    # --- Raster data ---
#    print OUT &cRead( IMG, 1 );
    print &cRead( IMG, 1 );
    $tmp0 = &cRead( IMG, 1 );
#    print OUT $tmp0;
    print $tmp0;
    $isz = ord( $tmp0 );
#print "SIZ=$isz \n";
    for( $i=0; $i<=$isz; $i++ ) {
#      print OUT &cRead( IMG, 1 );
      print &cRead( IMG, 1 );
    }
  }
}



sub cRead {
  local( $fhnd, $chars ) = @_;
  read( $fhnd, $out, $chars );
  return $out;
}

#====================================================================
# Decode - decodes a hex encoded string

sub Decode { 
  local ($value) = @_;
  $value =~ s/\+/ /g;
  $value =~ s/%([A-Fa-f0-9]{2})/pack('c',hex($1))/ge;
  return $value;
}

#=========================================================================
# DoError

sub DoError { 
  local ($msg) = @_;
  print <<HTML;
Content-type: text/html

<html><body>
<h2>ERROR: $msg</h2>
If you feel this message is incorrect, please contact
<a href="mailto:webmaster\@prenticenet.com">webmaster\@prenticenet.com</a>.
CALLINGFILE=$callingfile
CGIFILE=$cgifile
REFERER=$referer
</body></html>
HTML
  exit;
}