Hi all, I'm the coder behind chachi's perl version. We actually have 3 versions. One is a cgi script meant to be included with <!--#include. The second is a perl library meant to be included with 'require' in another perl script to add an ad network routine to an existing perl program. The final one is a module meant to be 'use'd, that provides the ability to add it to and existing perl program running in a mod_perl environment where a 'require' might not work properly. Each one requires the LWP::UserAgent module to be installed, I believe it's standard these days but I am not positive. I am including the cgi version meant to be called by #include here. This is only useful if you don't have php installed as Shawns php can also be #included and should be used before our version. If you need one of the other versions let me know. This version is mod_perl safe as an include and conforms to all of Shawn's caching requirments. This code is provided as-is, use at your own risk, etc, etc. #!/usr/bin/perl # $Id: ad_network.cgi,v 1.3 2004/08/14 07:47:57 cvs Exp $ # $Revision: 1.3 $ use strict; use LWP::UserAgent; srand; use vars qw/$ad_file $ad_url $VERSION $ad_network/; # 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 = 'http://ads.digitalpoint.com/network.php?type=link'; ### end User Variables $VERSION = sprintf "%d.%03d", qq$Revision: 1.3 $ =~ /(\d+)\.(\d+)/; $ad_network = ''; } init(); print qq{Content-type: text/html\n\n}; if(-w $ad_file) { if(open(FILE,"$ad_file")) { my $adlist = join('',<FILE>); close(FILE); my @ads = split(/<ad_break>/,$adlist); # if we haven't hit our 101 cache limi or # the timestamp is less than an hour old if(@ads < 101 || $ads[0] + 3600 < time()) { 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 = qq{<!-- } . time() . qq{ -->}; $content .= $res->content; push(@ads,$content); } if(@ads > 101) { shift @ads; shift @ads; } $ads[0] = time(); if(open(FILE,">$ad_file")) { print FILE join('<ad_break>',@ads); close(FILE); } $ad_network = pop(@ads) if(@ads > 1); # dont get a timestamp } else { $ad_network = $ads[int(rand(@ads-1))+1]; # again dont get a timestamp } $ad_network .= qq{<!-- an-hl -->}; } else { warn qq { could not open file $ad_file because $! }; } } else { $ad_network = 'You must set the "ad_network_ads.txt" file to be writable.'; } $ad_network =~ s/\<\!-- [0-9]* --\>//g; print $ad_network . qq{\n};
What did you have in mind? The code provided if put in an include can be called more than once on a page and will produce different results each time. I don't think I am clear on exactly what you are looking for but if you let me know I'll see what I can do.
Sorry didn't see that multiple ads per page are now allowed. I'll have some updated code here in a bit.
Ok here is the updated version to support multiple ads. The new config variables are ad_count (# of ads) and ad_separator (text/html to put between ads). Are there some [] tags i can put around the code to keep the formatting when posting? #!/usr/bin/perl # $Id: ad_network.cgi,v 1.4 2004/10/04 07:27:07 cvs Exp $ # $Revision: 1.4 $ use strict; use LWP::UserAgent; srand; use vars qw/$ad_file $ad_url $VERSION $ad_network $ad_count $ad_separator/; # 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 = 'http://ads.digitalpoint.com/network.php?type=link'; # set this to the number of ads you want to display on each page $ad_count = 5; # set this to the html you want to separate the ads ex: <br> | $ad_separator = '<br>'; ### end User Variables $VERSION = sprintf "%d.%03d", qq$Revision: 1.4 $ =~ /(\d+)\.(\d+)/; $ad_network = ''; } init(); print qq{Content-type: text/html\n\n}; if(-w $ad_file) { if(open(FILE,"$ad_file")) { my $adlist = join('',<FILE>); close(FILE); my @ads = split(/<ad_break>/,$adlist); # if we haven't hit our 101 cache limi or # the timestamp is less than an hour old if(@ads < 101 || $ads[0] + 3600 < time()) { 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 = qq{<!-- } . time() . qq{ -->}; $content .= $res->content; push(@ads,$content); } if(@ads > 101) { shift @ads; shift @ads; } $ads[0] = time(); if(open(FILE,">$ad_file")) { print FILE join('<ad_break>',@ads); close(FILE); } for(my $i=0;$i<$ad_count;$i++) { if(@ads > 1) { # dont get a timestamp $ad_network .= pop(@ads); $ad_network .= qq{<!-- an-hl -->}; $ad_network .= $ad_separator if($ad_count > 1); } } } else { for(my $i=0;$i<$ad_count;$i++) { $ad_network .= $ads[int(rand(@ads-1))+1]; # again dont get a timestamp $ad_network .= qq{<!-- an-hl -->}; $ad_network .= $ad_separator if($ad_count > 1); } } } else { warn qq { could not open file $ad_file because $! }; } } else { $ad_network = 'You must set the "ad_network_ads.txt" file to be writable.'; } $ad_network =~ s/\<\!-- [0-9]* --\>//g; print $ad_network . qq{\n};
if anyone is using it as an include and wants to be able to specify the number of ads to show and the separator in the include tag ie: #include virtual="/cgi-bin/ad_network.cgi?ad_count=5;ad_separator=:" let me know. the one here is written to be as fast as possible and hence does not parse any cgi input. however i have a version that can support changing the number of ads per page in the include without needing multiple versions of the script.
Hey guys it has come to my attention that this code may be contacting DP's server more often than it should. I have a fix on the way that will be available soon.
Ok guys. Here is the new perl version to address the problem with contacting the servers too frequently on heavily loaded sites. Also prevents the file from being clobbered by the same. Also added a little feature where you can specify the # of ads and the ad separator in the URL ex: ad_network.cgi?ad_count=5;ad_separator=| The defaults are count 5 and separator br (html br). You can hard code them as before with the ad_count and ad_separator variables or send them in the include paramaters. Enjoy! #!/usr/bin/perl # $Id: ad_network.cgi,v 1.5 2004/10/12 02:54:29 cvs Exp $ # $Revision: 1.5 $ use strict; use LWP::UserAgent; use Fcntl qwflock); srand; use vars qw/$ad_file $ad_url $VERSION $ad_network $ad_count $ad_separator/; # 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 = 'http://ads.digitalpoint.com/network.php?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.5 $ =~ /(\d+)\.(\d+)/; $ad_network = ''; } init(); print qq{Content-type: text/html\n\n}; 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); for(my $i=0;$i<$ad_count;$i++) { $ad_network .= $ads[int(rand(@ads-1))+1]; # again dont get a timestamp $ad_network .= qq{<!-- an-hl -->}; $ad_network .= $ad_separator if($ad_count > 1); } } else { my $adlist = join('',<FILE>); close(FILE); my @ads = split(/<ad_break>/,$adlist); # if we haven't hit our 101 cache limi or # the timestamp is less than an hour old if(@ads < 101 || $ads[0] + 3600 < 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 = qq{<!-- } . time() . qq{ -->}; $content .= $res->content; push(@ads,$content); } if(@ads > 101) { shift @ads; shift @ads; } $ads[0] = time(); print FILE join('<ad_break>',@ads); close(FILE); } for(my $i=0;$i<$ad_count;$i++) { if(@ads > 1) { # dont get a timestamp $ad_network .= pop(@ads); $ad_network .= qq{<!-- an-hl -->}; $ad_network .= $ad_separator if($ad_count > 1); } } } else { for(my $i=0;$i<$ad_count;$i++) { $ad_network .= $ads[int(rand(@ads-1))+1]; # again dont get a timestamp $ad_network .= qq{<!-- an-hl -->}; $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 $ad_network =~ s/\<\!-- [0-9]* --\>//g; print $ad_network . qq{\n};
Delete and re-create your ad_network_ads.txt file after installing this and makes ure all the permissions are set right. This version supports the 401 link caching and the 15 minute timeout, as well as the new format for DP to send down the link check code. Defaults to 5 ads, you can set the ad_count variable to serve less. As always the formatting will be lost but the code should still work fine. Let me know if anyone has any trouble. ClickDoc #!/usr/bin/perl # $Id: ad_network.cgi,v 1.7 2004/11/29 23:04:16 cvs Exp $ # $Revision: 1.7 $ use strict; use LWP::UserAgent; use Fcntl qwflock); srand; use vars qw/$ad_file $ad_url $VERSION $ad_network $ad_count $ad_separator $ad_cache_size $ad_timeout_seconds/; # 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?type=link&s=$ENV{'HTTP_HOST'}]; # 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>'; # ad cache size, current size is 401 $ad_cache_size = 401; # timeout, current timeout is 15 minutes (900 seconds) $ad_timeout_seconds = 900; 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.7 $ =~ /(\d+)\.(\d+)/; $ad_network = ''; } init(); print qq{Content-type: text/html\n\n}; 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); for(my $i=0;$i<$ad_count;$i++) { $ad_network .= $ads[int(rand(@ads-1))+1]; # again dont get a timestamp $ad_network .= qq{<!-- an-hl -->}; $ad_network .= $ad_separator if($ad_count > 1); } } else { my $adlist = join('',<FILE>); close(FILE); my @ads = split(/<ad_break>/,$adlist); # if we haven't hit our cache limit or # the timestamp is less than timeout if(@ads < $ad_cache_size || $ads[0] + $ad_timeout_seconds < 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 = qq{<!-- } . time() . qq{ -->}; $content .= $res->content; push(@ads,$content); } if(@ads > $ad_cache_size) { shift @ads; shift @ads; } $ads[0] = time(); print FILE join('<ad_break>',@ads); close(FILE); } for(my $i=0;$i<$ad_count;$i++) { if(@ads > 1) { # dont get a timestamp $ad_network .= pop(@ads); $ad_network .= $ad_separator if($ad_count > 1); } } } else { for(my $i=0;$i<$ad_count;$i++) { $ad_network .= $ads[int(rand(@ads-1))+1]; # again dont get a timestamp $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 $ad_network =~ s/\<\!-- [0-9]* --\>//g; print $ad_network . qq{\n};