#!/usr/bin/perl
#######################
##  AutoRank v2.1.0  ##
###################################################
##  rankem.cgi - track incoming hits             ##
###################################################

use strict;
use lib '.';                                      ## On NT you may need to use a full path here
my( $DDIR, %QRY );
$DDIR = './data';                                 ## On NT you may need to use a full path here

eval {
  require "$DDIR/vars.dat";
  main();
};

err("$@", 'rankem.cgi') if( $@ );
exit;

sub main {
  parseget();
  checktime();
  givehit($QRY{'id'});
}

sub givehit {
  my($id) = shift;
  if(-e "$DDIR/members/$id.cnt") {
    open(DATA, "+<$DDIR/members/$id.cnt") || err($!, "$id.cnt");
    flock(DATA, 1);
    my @cd = split(/\|/, <DATA>);
    flock(DATA, 8);

    $cd[0]++;

    flock(DATA, 2);
    truncate(DATA, 0);
    seek(DATA, 0, 0);
    print DATA "$cd[0]|$cd[1]";
    flock(DATA, 8);
    close(DATA);
  }
  print "Location: $VAR::HU/autorank.html\n\n";
}

sub checktime {
  open(RR, "+<$DDIR/rerank") || err($!, "rerank");
  flock(RR, 1);
  my $lastrr = <RR>;
  flock(RR, 8);
  if( time - $lastrr >= $VAR::RR ) {
    require "ar.pl";
    ar::rerank();
    flock(RR, 2);
    truncate(RR, 0);
    seek(RR, 0, 0);
    print RR time;
    flock(RR, 8);
  }
  close(RR);

  open(RS, "+<$DDIR/reset") || err($!, "reset");
  flock(RS, 1);
  my $lastrs = <RS>;
  flock(RS, 8);
  if( time - $lastrs >= $VAR::RS ) {
    require "ar.pl";
    ar::resetcnt();
    flock(RS, 2);
    truncate(RS, 0);
    seek(RS, 0, 0);
    print RS time;
    flock(RS, 8);
  }
  close(RS);
}

sub parseget {
  my @pairs = split(/&/, $ENV{'QUERY_STRING'});
  my ($name, $value);
  
  for (@pairs) {
    ($name, $value) = split(/=/, $_);
    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    $QRY{$name} = $value;
  }
}

sub err {
  my($cause, $file, $fnct) = @_;
  my @cone = caller(1);
  my @ctwo = caller(2);
  chomp($cause);
  
  $fnct = "$cone[3] from $cone[1]\n";
  $fnct = "$cone[3] -> $ctwo[3] from $cone[1] line $cone[2]\n" if( $cone[3] =~ /cgiworks/ );
  $fnct = "Unknown\n" if( $fnct =~ /^\sfrom\s$/ );

  print "Content-type: text/html\n\n" if( $ENV{'REQUEST_METHOD'} );
  print "<pre>\n" if( $ENV{'REQUEST_METHOD'} );
  print "A CGI ERROR HAS OCCURRED\n========================\n";
  print "Error Message     :  $cause\n";   
  print "Accessing File    :  $file\n";
  print "Calling Function  :  $fnct";

  exit -1;
}