#!/usr/local/bin/perl -wT

#The Above line may need to be changed, depending
#on the location  of perl on your web server

use strict;
use CGI qw(escape);
use vars qw(
	$VERSION
	$WEBSITE_ID
	$AT_SERVER
	$COOKIE_YEARS
);

#Configuration Settings
$VERSION      = '2.0';            #Assoctrac Version
$WEBSITE_ID   = 613;              #Assoctrac Website ID
$AT_SERVER    = 'assoctrac.com';  #Assoctrac Server Location
$COOKIE_YEARS = 3;                #Years that a cookie will remain on client's machines, default 3

#Check to see if we are being called in version 1.0's style
version1();

#Create a new Client Cookie (CC)
my $CC = new_cc();

# create a new CGI object
my $cgi = CGI->new;

# Redirect the browser to assoctrac.com, into the correct directory, and pass it some of the values from %ENV
print $cgi->redirect(
	-cookie   => bake_cookie($CC,$cgi),
	-location => "http://$AT_SERVER/$VERSION/$WEBSITE_ID/entry.cgi?CC_$VERSION=$CC",
	-status   => '302 Moved Temporarily',
);
#print "Location: http://$AT_SERVER/$VERSION/$WEBSITE_ID/entry.cgi?CC_$VERSION=$CC\n", bake_cookie($CC,$cgi), "\n\n";

### Subroutines

#Create a CC from scratch
sub new_cc {

	$ENV{SCRIPT_NAME} ||= $0;  		#Script Name

	# Environment Variables that are totally necessary
	# for Assoctrac to track orders/visitors
	my @required = qw(
	  HTTP_REFERER
	  QUERY_STRING
	  SCRIPT_NAME
	  SERVER_NAME
	  PATH_INFO
	);

	my %CC;

	# Grab all the Environment Variables we need
	@CC{ @required } = @ENV{ @required };

	#Make the $cc Cookie
	return escape(CGI->new(\%CC)->query_string)
}

#Constructs an HTTP Cookie
sub bake_cookie {

  my $cookievalue = shift || return;   #Value of the Cookie

	my $cgi = shift;

  #The Months of the Year
  my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);

  #The Days of the Month
  my @days   = qw(Sun Mon Tue Wed Thu Fri Sat);

  #Sets the Expiration time for the Cookie to $years Years in the future
  my $exptime = time + (60 * 60 * 24 * 365 * $COOKIE_YEARS);

  #Get the time, and break it into it's seperate elements
  my ($sec, $min, $hour, $mday, $mon, $year, $wday) = (gmtime($exptime))[0..7];

  #Construct the Expiration Date
  my $expires = sprintf( "%s, %02d %s %04d %02d:%02d:%02d GMT",	#String to Output
		                      $days[$wday],  	#Day Name
		                      $mday,         	#Day Numerical
		                      $months[$mon],	#Month Name
		                      $year + 1900,  	#Year Numerical
		                      $hour,         	#Hour Numerical
		                      $min,          	#Minutes Numerical
		                      $sec           	#Seconds Numerical
		                    );

	#Bakes the Cookie to be placed on the Client's side
	return $cgi->cookie(
		-name => "CC_$VERSION",
		-value => $cookievalue,
		-expires => $expires,
		-path => '/',
	);

}

#This routine is called to remain backwards compatible with how
#Assoctrac 1 called t.cgi
sub version1 {

	#Parse out the contents of the
	#$ENV{PATH_INFO} if there is any
	if(exists $ENV{PATH_INFO}) {

		#Check to see if this script was called in this manner:

		#at.cgi/12345/index.html

		#The first parameter in the above example is 12345, which is the associate id
		#the second parameter in the above example is index.html, which is the
		#page the user would like to be redirected to after being tracked by AT2

		my ($a, $e) = ($ENV{PATH_INFO} =~ m#^/([^/]*)(/?.*)#);

		#See if the first parameter is an Associate ID, or a keyword
		if($a =~ /^\d+$/) {
			$ENV{QUERY_STRING} .= "&a=$a";	#It is all numbers, it must be an Associate ID
		} else {
			$ENV{QUERY_STRING} .= "&k=$a";	#Anything else, it must be a keyword
		}

		#Did the user specify an entry page?
		if(defined $e) {
			$ENV{QUERY_STRING} .= "&e=$e"; #Yes, append it onto the Query string, as if it had been called the standard way
		}
	}

}

#Bug Testing Subroutine
BEGIN {
  $SIG{__DIE__} = sub { print "Content-type: text/plain\n\nERROR: ", @_; }
}

__END__