#!/usr/bin/perl -w

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

use RSI::Funcs;
use RSCT::DBAccount;
use RSCT::Programs;
use RSCT::Session;
use RSCT::DBSite;
use RSCT::SiteRedirectMap;
use MPB::DeprecatedSite;
use CGI qw(:standard);
use DBI ();
use vars qw($MAX_TRIES $ID_LENGTH $DO_DISCONNECT);
use strict;
use Data::Dumper;

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) {
         # map it to the new domain
         my ($site_redirect_map) = RSCT::SiteRedirectMap->search(old_siteID => $site);
         # printf STDERR "Dump of site_redirect_map: %s\n", Dumper($site_redirect_map);
         if (defined $site_redirect_map and $site_redirect_map->enabled) {
            my $new_site = RSCT::DBSite->load($site_redirect_map->new_siteID);
            $url = $new_site->url;
         }
         $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"; }
   }
   my ($deprecated_site) = MPB::DeprecatedSite->search(old_siteID => $site);
   if (defined $deprecated_site) {
      $site = $deprecated_site->new_siteID;
   }
   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;
   }
   if ($main::config{sitename} eq "mpb" and $account =~ /272906p=13/) {
      $account = 272906;
      $site = 42;
      $program = 13;
   }


   # 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 $old_site_obj = RSCT::DBSite->load($site);
   my ($site_redirect_map) = RSCT::SiteRedirectMap->search(old_siteID => $site);
   my $temp_site;
   if (defined $site_redirect_map and $site_redirect_map->enabled) {
      my $new_site = RSCT::DBSite->load($site_redirect_map->new_siteID);
      my $new_siteID = $new_site->id;
      print STDERR "doing site redirect from $site to $new_siteID\n";
      $temp_site = $new_site;
   }
   else {
      $temp_site = $old_site_obj;
   }
   my $new_domain = $old_site_obj->prefix . "." . $temp_site->url;

#   if (1) {
#      my $new_site = RSCT::SiteRedirectMap->find_site_redirect($site);
#      print STDERR "Doing a site redirect to the new domains, from $site to $new_site\n";
#      my $new_site_obj = RSCT::DBSite->load($new_site);
#      
#     # $new_domain = $new_site_obj->prefix . "." . $new_site_obj->url;
#   }

   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;
   #}

# GS: added to block access if account or program is deleted or disabled
my $account_object = RSCT::DBAccount->load($account);

# DB20060119:  "Disable" this account, but not really.  He's a spammer.  Block
# clicks but leave this account active so he can be paid for old ones.
# DON'T SAVE THIS ACCOUNT OBJECT!
$account_object->status('disabled') if $account == 289787;

if (defined $account_object && ($account_object->status eq 'deleted' || $account_object->status eq 'disabled')) {
print "content-type:text/html\n\n";
print <<EOM;
<html><head><title>inactive account</title></head>
<body>
this account is not active.
</body></html>
EOM
;
exit;
}


   
   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");
      print redirect_url("$new_domain/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 = "http://$new_domain";
            $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};
      my $url = sprintf "http://$new_domain/%s/$html_page",$session->id;
      print STDERR "redirecting to $url\n";

      print redirect_url($url);
      return 0;
   }

}

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


sub gslogit {
   my ($file, $params) = @_;
   my $filepath = "/home/megapornbucks.com/riverstyx/graham/$file.log";
   if ( -s $filepath > (1000*1000) ) {unlink $filepath;}
   open(LF, ">>/home/megapornbucks.com/riverstyx/graham/$file.log");
   foreach my $key (keys %$params) {
      print LF "$key: " . $params->{$key} . "\t";
   }
   print LF "\n";
   close(LF);
}