#!/usr/bin/perl

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

use RSI::Funcs;
use RSI::SQL;
use RSCT::Programs;
use RSCT::Session;
use RSCT::DBAccount;
use Geo::IP;
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
use DBI ();
use Apache::Cookie;
use vars qw($MAX_TRIES $ID_LENGTH $DO_DISCONNECT);

use strict;
use warnings;
no warnings 'uninitialized', 'numeric';

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
}

{
#   warn 'DS click start';
   my %siteurl;
   my %urlsite;
   my %firstpage;
   my $error = "";
   my $fatal = 0;

   # if we don't already have the siteurl info loaded, then 
   if (!%siteurl) {
      my ($sth) = RSI::SQL::exec("select site,url,prefix,firstpage from sites");
      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;
      }
   }
   my $gi = Geo::IP->new(GEOIP_STANDARD);
   my $country = $gi->country_code_by_addr($ENV{REMOTE_ADDR});
   if ($main::config{sitename} eq "adultcash") {
      if ($country eq "GB") {
         print "Location: http://www.erosconnect.com/bnr/3050857320\n\n";
         print STDERR "uk redirect\n";
         exit;
      }
   }

   my $r = Apache->request;

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

   my $account = $q->param("account");
   $account ||= $q->param("a");
   $account ||= "";

   my $c = RSCT::DBAccount->new;
   $c->clear_cache;

   my $db_account = RSCT::DBAccount->load($account);
   if (defined $db_account and $db_account->status eq "disabled") {
      $r->print("Content-Type: text/html\n\n");
      $r->print("This account ($account) is disabled.  Sorry!\n");
      exit;
   }
   my $orig_account = $account;
   $account =~ s/amp;//;
   my $site = param("site");
   $site ||= param("s");
   $site ||= "";
   $site =~ s/amp;//;
   $site =~ s|/$||;              # some traffic scripts throw a / at the end of link codes for some bizarre reason
   if ($site and $site !~ /^\d+$/) {
      ($site) = RSI::SQL::one_row("select site from sites where site_abbr=?", $site);
   }
   else {
      $site = $site+0;
   }

=cut   
   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 ($main::config{sitename} eq "adultcash") {
      if ($site eq "5") { $site = "14"; }
      elsif ($site eq "10") { $site = "14"; }
      elsif ($site eq "11") { $site = "14"; }
      elsif ($site eq "12") { $site = "14"; }
      elsif ($site eq "42") { $site = "14"; }
      elsif ($site eq "84") { $site = "81"; }
      elsif ($site eq "94") { $site = "81"; }
      elsif ($site eq "95") { $site = "81"; }
      elsif ($site eq "96") { $site = "81"; }
      elsif ($site eq "93") { $site = "81"; }
      elsif ($site eq "140") { $site = "137"; }
      elsif ($site eq "150") { $site = "137"; }
      elsif ($site eq "151") { $site = "137"; }
      elsif ($site eq "152") { $site = "137"; }
      elsif ($site eq "149") { $site = "137"; }
   }
=cut

   if (!$site) {
      my $server_name = $ENV{SERVER_NAME} || '';
      if ($urlsite{$server_name}) {
         $site = $urlsite{$server_name};
      }
   }
   $site ||= '';



   # DB20060315
   if ($account == 100000) {
      # This could be the result of a type-in.  Check for a cookie, and if
      # present, use the account defined within its yummy centre.
# print STDERR "DB20060315: click came in for 100000, search for cookie.\n";
      my $name = "tr-rsct-$site";
      my $cgi  = CGI->new;
      my $cookie_value = $cgi->cookie($name);
      if ($cookie_value) {
         (undef, my $cookie_accountID, undef) = split /-/, $cookie_value;
         #print STDERR "DB20060315: found cookie $cookie_value, account is $cookie_accountID\n";
         my $cookie_account = RSCT::DBAccount->load($cookie_accountID);
         if (defined $cookie_account and $cookie_account->status ne "disabled") {
            $account = $cookie_accountID;
         }
      }
      else {
         #print STDERR "DB20060315: no cookie found.\n";
      }
   }



   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";
      ($program) = RSI::SQL::one_row("select program from programs where program_abbr=?", $program);
   }

   # HL20070726: Comment out TeenRev customized code
   #if ($main::config{sitename} eq "TeenRevenue") {
   #   if ($program eq "5") { $program = "1"; }
   #}

   # 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
   unless ($count) {
      $program = $main::config{default_program};
   }
   my $banner  = param("banner");
   $banner ||= param("b");
   $banner ||= "";
   $banner =~ s/amp;//;

   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} = "";
   if ($account && $account !~ /^[0-9]{6,6}$/) {
      my $sth = $main::dbh->prepare("select account from accounts where username=?");
      $sth->execute($account);
      ($account) = $sth->fetchrow_array;
      $sth->finish;
   }
   
   ($account =~ /\d+/) and $account = sprintf("%08d", $account);
   ($account !~ /^[0-9]{6,8}$/) and $account = sprintf("%08d", $account);
   if ($account !~ /^[0-9]{6,8}$/) {
      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") || 'no account'; 
      printf STDERR "a        %s\n",param("a") || '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) {

# DB20060418: Kevin wants to redirect to the 404 page instead of displaying an error.
# HL20070626: Do we still want to redirect to this page? Comment out for now.
       #print redirect_url('http://www.littleapril.com/404.html');

# RSI::Funcs::log("click","Invalid click was sent fatal, $error");
#      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

      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\.|;
      my $firstpage = "";
      $firstpage{$site} and $firstpage = $firstpage{$site};
      $firstpage ||= "index.html";
      print redirect_url("$siteurl/$firstpage");
      $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};
      # Default URL to send them to

=cut
      # 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);
            return 0;
         }
      }
=cut

      $html_page ||= $firstpage{$site};

      # DB20060317. commented out. Ugly anyway.
      # if ($html_page =~ /\/$/) { $html_page .= 'index.html'; }
#      warn 'DS click redirect ready';
      my $redir_url = sprintf "$siteurl/%s/$html_page",$session->id;

      # Mainstreamdollars redirects
      # HL20070626: Comment out for now.
=cut     
      if ($main::config{sitename} eq "mainstreamdollar") {
         die "We are here for some reason";
         my $orig_url = $redir_url;
         my $session_id = $session->id;
         # JM: processing for non-hosted sites on mainstreamdollars.  We're passing these
         # through into another person's affiliate system and getting notification on sales.
         if ($site == 5) {
	    $redir_url = "http://rdr.primegra.com/p/10000510830?sourceid=$session_id";
         }
         elsif ($site == 6) {
	    $redir_url = "http://int.dvd.freecooloffers.com/p/10000515355?sourceid=$session_id";
	 }
         elsif ($site == 7) {
	    $redir_url = "http://lnk.freecooloffers.com/p/10000515356?sourceid=$session_id";
	 }
         elsif ($site == 8) {
	    $redir_url = "http://rdr.moneypluscard3.com/p/10000510828?sourceid=$session_id";
	 }
         elsif ($site == 9) {
	    $redir_url = "http://rdr.usaplatinumplus.com/p/10000510829?sourceid=$session_id";
	 }
         elsif ($site == 10) {
	    $redir_url = "http://rdr.usaplatinumcard.com/p/10000510831?sourceid=$session_id";
	 }
         elsif ($site == 11) {
	    $redir_url = "http://rdr.freecardsearch.com/p/10000510833?sourceid=$session_id";
	 }
         elsif ($site == 12) {
	    $redir_url = "http://rdr.cupidjunctionapp.com/p/10000510832?sourceid=$session_id";
	 }
	 # JM: normally we record clicks in Session.pm, but these sites aren't mirrored
         if ($redir_url ne $orig_url) {
	    my $sth = $main::dbh->prepare("select raw from clicks where session_id='$session_id'");
            my $rv = $sth->execute;
            $sth->finish;
	    #print "rv=$rv<br>\n";
            if ($rv == 1) {
               $main::dbh->do("update clicks set raw=raw+1,second=1 where session_id='$session_id'");
            }
            else {
               my $referer = $ENV{HTTP_REFERER} || "";
#               $rv = $main::dbh->do("insert into clicks set account='$account',real_referer='$referer',referer='$referer',ip='$ENV{REMOTE_ADDR}',site='$site',program='$program',datetime=now(),date=now(),raw=1,second=1,banner='$banner',session_id='$session_id',processed='no'");
            }
         }
      }
=cut

      # DB20060315:  Set a cookie.
      # my $shorturl = $siteurl;
      if ($account != 100000) {
         my $shorturl = $main::config{siteurl};
         $shorturl =~ s/http:\/\///;
         my $cookie_account = $account;
         length($cookie_account) > 6 and $cookie_account =~ s/^00//;
         my $cookie_value = $session->id."-$cookie_account-$program";
         my $cookie = Apache::Cookie->new($r, -domain => $shorturl, -name => "tr-rsct-$site", -value => $cookie_value, -expires => '+10d');
         print STDERR "click: setting cookie: '",$cookie->as_string,"'\n";
         $cookie->bake();
      }

      print STDERR "DB20060317: Will redirect to: $redir_url\n";
      print redirect_url($redir_url);
      return 0;
   }

}

# JA: Turn off warnings. why?
$SIG{__WARN__} = sub {};

#JA could use...
# or use $cgi->redirect($url) in code and get rid of this.
#sub redirect_url { CGI->redirect(shift) }
sub redirect_url {
   my ($location) = @_;
   return "Location: $location\n\n";
}