Once again I strongly suggest everyone move to the perl -> php wrapper method posted here http://forums.digitalpoint.com/showthread.php?t=7517&highlight=coop.php
If you have not moved yet and are using the perl version it is important that you update it to this version to abide by the hit timeouts on the DP server. If you have a busy site and are using version 1.11 you will get banned. I am happy to provide advice to anyone who wants to move to the wrapper.
Be sure to set the ad_file variable to the full path of your ad_network_ads.txt file and set that file writable by the web process. You may also want to change the ad_separator if you are using multiple ads and ad_count if you are not.
New Code:
#!/usr/bin/perl
# $Id: ad_network.cgi,v 1.12 2005/01/18 01:26:19 cvs Exp $
# $Revision: 1.12 $
use strict;
use LWP::UserAgent;
use Fcntl qw(:flock);
use Socket;
srand;
use vars qw/$ad_file $ad_url $VERSION $ad_network $ad_count $ad_separator @ad_params/;
# use ini subroutine with global vars, usefull for mod_perl
sub init {
### User Variables
# edit ad_file to set the path to the ad_network_ads.txt file
# default is to look in the same directory as where the script runs
# just create a blank file in that directory that is writable by the
# web server process and this script will set it up properly
$ad_file = 'ad_network_ads.txt';
# change type= here to the type of link you wish to serve
$ad_url = qq[http://ads.digitalpoint.com/network.php?b=$ENV{'HTTP_HOST'}&type=link];
# set this to the number of ads you want to display on each page
$ad_count = 5;
# set this to the text or html you want to separate the ads ex: <br> |
$ad_separator = '<br>';
if($ENV{QUERY_STRING}) {
my @tags = split(/;/,$ENV{QUERY_STRING});
foreach(@tags) {
my ($name,$value) = split(/=/,$_);
$ad_count = $value if($name eq 'ad_count');
$ad_separator = $value if($name eq 'ad_separator');
}
}
$ad_count = 5 if($ad_count > 5);
### end User Variables
$VERSION = sprintf "%d.%d", qq$Revision: 1.12 $ =~ /(\d+)\.(\d+)/;
$ad_network = '';
}
init();
# only print content type if called as cgi (include) for other perl scripts
# may be called with `/path/to/file/ad_network.cgi` to get output without
# Content-type: declaration
print qq{Content-type: text/html\n\n} if($ENV{GATEWAY_INTERFACE} =~ /CGI/);
if(-w $ad_file) {
if(open(FILE,"$ad_file")) {
# if we can't get a lock that means a process is writing, just serve an ad from the existing file
# and don't check the timestamp, this prevents a slow response from the DP server from hanging
# every web process waiting to read an ad, there is slim a chance we could end up with a partial ad
if(!flock(FILE, LOCK_SH|LOCK_NB)) {
my $adlist = join('',<FILE>);
close(FILE);
my @ads = split(/<ad_break>/,$adlist);
@ad_params = split(/\|/,$ads[0]);
for(my $i=0;$i<$ad_count;$i++) {
my $randad .= $ads[int(rand(@ads-1))+1]; # dont get control info found in position 0
if($ENV{REMOTE_ADDR} eq $ad_params[1]) {
$randad =~ s/" \/>/" class="$ad_params[2]" \/>/;
} else {
$randad =~ s/" \/>/">/;
}
$ad_network .= $randad;
$ad_network .= $ad_separator if($ad_count > 1);
}
} else {
my $adlist = join('',<FILE>);
close(FILE);
my @ads = split(/<ad_break>/,$adlist);
@ad_params = split(/\|/,$ads[0]);
# if we haven't hit our cache limit or
# the timestamp is less than timeout
if((@ads < $ad_params[3] && $ad_params[0] + $ad_params[5] < time()) || $ad_params[0] + $ad_params[4] < time()) {
if(open(FILE,">$ad_file")) {
flock(FILE, LOCK_EX); # get an exclusive lock so we can write the ad_network_ads file
my $ua = new LWP::UserAgent;
$ua->agent("Ad-Network-Perl/$VERSION)");
my $req = HTTP::Request->new(GET => $ad_url);
my $res = $ua->request($req);
if($res->is_success) {
my $content = '';
$content .= $res->content;
my ($params,$newad) = split(/<ad_param>/,$content);
my @new_params = split(/\|/,$params);
for(my $i=0;$i<@new_params;$i++) {
$ad_params[$i+2] = $new_params[$i];
}
push(@ads,'') if(@ads == 0);
push(@ads,$newad);
} else {
warn qq { Not sucessfull getting ad network ads from digitalpoint };
}
if(@ads > $ad_params[3]) {
shift @ads;
}
my $packedip = gethostbyname('validate.digitalpoint.com');
my $ipadr = inet_ntoa($packedip);
@ad_params[0] = time();
@ad_params[1] = $ipadr;
$ads[0] = join('|',@ad_params);
print FILE join('<ad_break>',@ads);
close(FILE);
}
for(my $i=0;$i<$ad_count;$i++) {
if(@ads > 1) { # dont get control information
my $randad .= pop(@ads);
if($ENV{REMOTE_ADDR} eq $ad_params[1]) {
$randad =~ s/" \/>/" class="$ad_params[2]" \/>/;
} else {
$randad =~ s/" \/>/">/;
}
$ad_network .= $randad;
$ad_network .= $ad_separator if($ad_count > 1);
}
}
} else {
for(my $i=0;$i<$ad_count;$i++) {
my $randad .= $ads[int(rand(@ads-1))+1]; # dont get control info found in position 0
if($ENV{REMOTE_ADDR} eq $ad_params[1]) {
$randad =~ s/" \/>/" class="$ad_params[2]" \/>/;
} else {
$randad =~ s/" \/>/">/;
}
$ad_network .= $randad;
$ad_network .= $ad_separator if($ad_count > 1);
}
} # end else on check for 100 ads or timestamp older than one hour
} # end else on if flock
} else {
warn qq { could not open file $ad_file because $! };
} # end else on opening ad file
} else {
$ad_network = 'You must set the "ad_network_ads.txt" file to be writable.';
} # end else on writable ad file
print $ad_network . qq{\n};