#!/usr/bin/perl ######################################################################## # COPYRIGHT NOTICE: # # Copyright 2008 FocalMedia.Net All Rights Reserved. # # Selling the code for this program without prior written consent # from FocalMedia.Net is expressly forbidden. You may not # redistribute this program in any shape or form. # # This program is distributed "as is" and without warranty of any # kind, either express or implied. In no event shall the liability # of FocalMedia.Net for any damages, losses and/or causes of action # exceed the total amount paid by the user for this software. # ######################################################################## #### EDIT HERE -- FOR WINDOWS/IIS BASED INSTALLATIONS ONLY ####### $config_cgi = "config.cgi"; ## <-- CHANGE THIS LINE TO THE FULL SERVER PATH TO config.cgi # THE PATH ON A WINDOWS INSTALLATION WILL LOOK SOMETHING LIKE THIS: # $config_cgi = "c:/inetpub/webpub/cgi-bin/pseek/config.cgi"; #### DO NOT CHANGE ANYTHING BELOW THIS LINE ################# #use FindBin; #use lib $FindBin::Bin; use CGI::Carp qw(fatalsToBrowser); use CGI; use DBI; use fmspm; &get_setup; fmspm::check_spamb("go.cgi", "header", "$data_dir"); $q = CGI->new; ################# $lnkid = $q->param('id'); $lnkid =~ s/[^0-9]//g; if ($mysql_hostname eq ""){$dsn = "DBI:mysql:$db_name";}else{$dsn = "DBI:mysql:$db_name:$mysql_hostname:$mysql_port";} $dbh = DBI->connect($dsn, $db_username, $db_password); if ( !defined $dbh ) {die "Cannot connect to MySQL server: $DBI::errstr\n"; } $sql = "SELECT url, hits FROM links WHERE lnkid = '$lnkid'"; $sth = $dbh->prepare($sql); $sth->execute; $serror = ""; $serror = $sth->errstr; if ($serror ne "") {die "SQL Syntax Error: $serror - From: $sql";} while ( @row = $sth->fetchrow() ) { $url = $row[0]; $hits = $row[1]; } $hits++; $sql = "UPDATE links SET hits = '$hits' WHERE lnkid = '$lnkid'"; $sth = $dbh->prepare($sql); $sth->execute; $serror = ""; $serror = $sth->errstr; if ($serror ne "") {die "SQL Syntax Error: $serror - From: $sql";} $sth->finish; $dbh->disconnect; $url =~ s/\n//g; $crit = chr(10); $url =~ s/$crit//g; $crit = chr(13); $url =~ s/$crit//g; #print "Content-type: text/html\n\n"; print "Location: $url\n\n"; #print "Content-type: text/html\n\n"; #print qq[ # # #
#Redirecting to:
#$url
Please wait...
# # #]; ################ sub get_setup { $exists = (-e "$config_cgi"); if ($exists > 0) { open (STP, "$config_cgi"); while (defined($line=