#!/usr/bin/perl -w

# this is meant to be run as an Apache::Registry script

use RSI::Funcs;
use RSCT::Programs;
use RSCT::Session;
use CGI qw(:standard);
use DBI ();
use vars qw($MAX_TRIES $ID_LENGTH $DO_DISCONNECT);
use strict;

my $q = new CGI;

BEGIN {
   $main::debug = 0;

   $DO_DISCONNECT = 0;                       # disconnect when done?
   $MAX_TRIES     = 10;                      # max tries to create a session_id
   $ID_LENGTH     = 8;                       # length of the session ID
}

{
   my %siteurl;
   my %urlsite;
   my %firstpage;

   # if we don't already have the siteurl info loaded, then 
   if (!%siteurl) {
      my $sth = $main::dbh->prepare("select site,url,prefix,firstpage from sites");
      $sth->execute;
      while (my ($site,$url,$prefix,$firstpage) = $sth->fetchrow_array) {
	 $firstpage ||= "index.html";
	      $firstpage{$site} = $firstpage;
	      $siteurl{$site} = $url;
	      $siteurl{$site} =~ /^www/ or $siteurl{$site} = "$prefix.$url";
	      $siteurl{$site} = "http://$siteurl{$site}";
	      $url =~ s|http://||;
	      $url !~ /^www/ and $url = "$prefix.$url";
	      $urlsite{$url} = $site;
      }
      $sth->finish;
   }

   my $r = Apache->request;

   my $html_page = $q->param('j');

   my $account = $q->param("account");
   $account ||= $q->param("a");
   $account ||= "";
   my $orig_account = $account;
   my $error = "";
   $account =~ s/amp;//;
   my $site = param("site");
   $site ||= param("s");
   $site ||= "";
   $site =~ s/amp;//;
   if ($site !~ /^\d+$/) {
      my $sth = $main::dbh->prepare("select site from sites where site_abbr=?");
      $sth->execute($site);
      ($site) = $sth->fetchrow_array;
      $sth->finish;
   }
   if ($main::config{sitename} eq "mpb") {
      if ($site eq "6") { $site = "171"; } 
      elsif ($site eq "129") { $site = "172"; }
      elsif ($site eq "148") { $site = "171"; }
      elsif ($site eq "150") { $site = "172"; }
      elsif ($site eq "47") { $site = "171"; }
      elsif ($site eq "68") { $site = "172"; }
      elsif ($site eq "50") { $site = "20"; }
      elsif ($site eq "75") { $site = "119"; }
   }
   if (!$site) {
      my $server_name = $ENV{SERVER_NAME} || "";
      if ($urlsite{$server_name}) {
	 $site = $urlsite{$server_name};
      }
   }
   $site ||= "";
   my $program = param("program");
   $program ||= param("p");
   $program ||= $main::config{default_program};
   $program =~ s/amp;//;
   if ($program !~ /^\d+$/) {
      # this is for adultcash migration.
      $program eq "s" and $program = "persignup";
      $program eq "u" and $program = "perunique";
      $program eq "p" and $program = "perunique";
      my $sth = $main::dbh->prepare("select program from programs where program_abbr=?");
      $sth->execute($program);
      ($program) = $sth->fetchrow_array;
      $sth->finish;
   }

   # check if the program and site combo are valid.
   my ($count) = RSI::SQL::count("privs","programID=? and siteID=? and status=1",$program,$site);

   # if not then assign default program
   if (!$count) {
      $program = $main::config{default_program};
   }
   my $banner  = param("banner");
   $banner ||= param("b");
   $banner ||= "";
   $banner =~ s/amp;//;

   my $fatal = 0;
   my $env_http_referer = $ENV{HTTP_REFERER} || "";
   my $env_server_name  = $ENV{SERVER_NAME}  || "";
   my $env_request_uri  = $ENV{REQUEST_URI}  || "";

   $r->header_in("Referer","");  # this is weird, but it seems to stick around sometimes when it shouldn't, so i clear it
   $ENV{HTTP_REFERER} = "";
   ($account !~ /^[0-9]{6,6}$/) and $account = "00$account";
   if ($account !~ /^[0-9]{6,6}$/) {
      print STDERR "impossible account:\n";
      printf STDERR "\$account %s\n",$account;
      printf STDERR "found    %s\n",$orig_account;
      printf STDERR "account  %s\n",param("account"); 
      printf STDERR "a        %s\n",param("a");
      printf STDERR "uri      %s\n",$env_request_uri;
      printf STDERR "query    %s\n",$ENV{QUERY_STRING};
      printf STDERR "redirect %s\n",$ENV{REDIRECT_QUERY_STRING}||"";
      #printf STDERR "mod_perl %s\n",Apache->request->args;
      printf STDERR "method   %s\n",$ENV{REQUEST_METHOD};
      printf STDERR "referer  %s\n",$env_http_referer;
      $error = "impossible account (account=$account,referer=$env_http_referer,uri=http://$env_server_name/$env_request_uri)";
      $fatal = 0;
   }
   elsif (length $banner>60) {
      $error = "banner tracking code was greater than 60 characters (length: ".length($banner). ") (account=$account,referer=$env_http_referer,uri=http://$env_server_name$env_request_uri)";
      $fatal = 0;
   }
   elsif (!exists($siteurl{$site})) {
      $error = "site doesn't exist (site=$site,account=$account,referer=$env_http_referer,uri=http://$env_server_name$env_request_uri)";
      $fatal = 1;
   }
   #elsif (! RSCT::Accounts::account_exists($account)) {
   #   $error = "account doesn't exists (account=$account,referer=$env_http_referer,uri=http://$env_server_name$env_request_uri)";
   #   $fatal = 0;
   #}
   if ($error && $fatal) {
      print <<EOM;
content-type: text/html

<html>
<head>
<title>Error</title>
</head>
<body>
An error occurred.  Check your linking code and try again.<br>
<p>$error<p>
Account = $account<br>
Site = $site<br>
Program = $program<br>
Banner = $banner<br>
</body>
</html>
EOM
      RSI::Funcs::log("click","Invalid click was sent fatal, $error");
      exit;
   }
   elsif ($error) {
      RSI::Funcs::log("click","Invalid click was sent, $error");
      my $siteurl = $siteurl{$site} || "";
      $siteurl =~ s|^http://www2\.|http://www\.|;
      $siteurl =~ s|^http://www3\.|http://www\.|;
      print redirect_url("$siteurl/index.php");
      $DO_DISCONNECT and $main::dbh->disconnect;
      exit(0);
   }
   else {
      my $session = new RSCT::Session;
      $session->create({
	 account => $account,
	 site => $site,
	 program => $program,
	 banner => $banner,
	 referrer => $env_http_referer,
	 ip => $ENV{REMOTE_ADDR},
      });
      my $siteurl = $siteurl{$site};

      # Megapornbuck specific changes
      if (!$html_page) {
         if (my $temp = $q->param('t')) {
            my $secure_url = $main::config{siteurl};            
            $secure_url =~ s/http\:\/\///gis;
            print redirect_url(sprintf "https://$secure_url/cgi/jp.cgi?s=%s&t=$temp",$session->id);
         }
      }
      $html_page ||= $firstpage{$site};

      print redirect_url(sprintf "$siteurl/%s/$html_page",$session->id);
      return 0;
   }

}

sub redirect_url {
   my ($location) = @_;
   print "Location: $location\n\n";
}