#!/usr/bin/perl
###########################
##  AutoRank v4.0.x      ##
#####################################################################
##  rankem.cgi - track incoming hits to the list                   ##
#####################################################################

$DDIR = './data';

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

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

#####################################################################
##  Removing the link back to JMB Software is a license violation. ##
##  Altering or removing any of the code that is responsible, in   ##
##  any way, for generating that link is strictly forbidden.       ##
##  Anyone violating the above policy will have their license      ##
##  terminated on the spot.  Do not remove that link - ever.       ##
#####################################################################

sub main
{
    parseget();
    checkTime();
    giveHit();
}



sub giveHit
{
    if( -e "$DDIR/members/$QRY{id}.cnt" )
    {
        diskspace("$DDIR/members/$QRY{id}.cnt");

        sysopen(FH, "$DDIR/members/$QRY{id}.cnt", $O_RDWR) || err("$!", "$QRY{id}.cnt");
        $ofh = select(FH); $|=1; select($ofh);
        flock(FH, $LOCK_EX);
        my @cd = split(/\|/, <FH>);

        $cd[0]++;
        $cd[2]++;

        seek(FH, 0, 0);
        print FH join('|', @cd);
        truncate(FH, tell(FH));
        close(FH);
    }

    print "Location: $HTML_URL/autorank.html\n\n";
}



sub checkTime
{
    if( getAge("$DDIR/times/rerank") >= $RERANK )
    {
        fwrite("$DDIR/times/rerank", time);
        fwrite("$DDIR/times/rerank.frm", 'rankem.cgi');
        require 'ar.pl';
        doRerank($USE_RERANK_CAT);
    }

    if( $RESET ne '-1' && getAge("$DDIR/times/reset") >= $RESET )
    {
        fwrite("$DDIR/times/reset", time);
        fwrite("$DDIR/times/reset.frm", 'rankem.cgi');
        require 'ar.pl';
        doReset();
    }
}



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 getAge
{
    my $file = shift;
    return time - freadline($file);
}



sub diskspace
{
    fremove("$DDIR/test.file") if( -e "$DDIR/test.file");

    sysopen(FILE, "$DDIR/test.file", $O_WRONLY | $O_CREAT) || return;
    flock(FILE, $LOCK_EX);
    truncate(FILE, 0);
    print FILE "THIS FILE IS USED TO CHECK FOR FREE DISK SPACE";
    flock(FILE, $LOCK_UN);
    close(FILE);
    mode(0666, "$DDIR/test.file");

    my $size = (-s "$DDIR/test.file");

    fremove("$DDIR/test.file");

    err("No Disk Space Available", $file) if( $size == 0 );

    $DS_CACHE = 1;
}



sub mode
{
    my($perms, $file) = @_;
    if( -O $file )
    {
        chmod($perms, $file) || err("$!", $file);
    }
}



sub fremove
{
    my($file) = shift;
    unlink($file) || err("$!", $file);
}



sub freadline
{
    my($file) = shift;

    open(FILE, $file) || err("$!", $file);
    flock(FILE, $LOCK_SH);
    my $line = <FILE>;
    close(FILE);
    flock(FILE, $LOCK_UN);
    chomp($line);

    return $line;
}



sub fwrite
{
    my($file, $data) = @_;
    sysopen(FILE, $file, $O_WRONLY | $O_CREAT) || err("$!", $file);
    flock(FILE, $LOCK_EX);
    truncate(FILE, 0);
    print FILE $data;
    flock(FILE, $LOCK_UN);
    close(FILE);
    chmod(0666, $file) if( -O $file );
}



sub err 
{
    my($cause, $file) = @_;
    chomp($cause);

    print "Content-type: text/html\n\n";
    print "<pre>\n";
    print "A CGI ERROR HAS OCCURRED\n========================\n";
    print "Error Message     :  $cause\n";   
    print "Accessing File    :  $file\n\n</pre>";
    print "<font face='Verdana' size='2'><b><a href='$HTML_URL/autorank.html'>Continue...</a></b></font>";
    exit;
}