#!/usr/bin/perl
###########################
##  AutoRank Pro v3.0.0  ##
##################################################
##  out.cgi - track outgoing hits               ##
##################################################

package out;

#use strict;
#push(@INC, 'c:/full/path/to/cgi/scripts');       ## NT support - uncomment and fill in correct path if necessary.

my $DDIR = './data';
my %QRY;

eval {
  main();
};

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

#####################################################################
##  Removing the link back to CGI Works is a copyright 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();
  my $id = $QRY{'id'};

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

    $cd[1]++;
    $cd[3]++;

    flock(MEM, 2);
    truncate(MEM, 0);
    seek(MEM, 0, 0);
    print MEM join('|', @cd);
    flock(MEM, 8);
    close(MEM);
  }

  print "Location: $QRY{'url'}\n\n";
}

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) = @_;
  my @from = caller(1);
  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";
  print "Calling Function  :  $from[3] from $from[1]" if( $from[3] ne "" );
  exit;
}