#!/usr/bin/perl ############################################################################# ## Program Name: pod.cgi version 1.60n ## ## Personal Open Directory (POD) - Netscape Version ## John M. Grohol ## Released: 25 May 1999 ## This version: 19 Dec 1999 ## http://grohol.com/ ## ## Copyright 1999 John M. Grohol and Checkpoint Computer Consultants ## Free to distribute, but you cannot charge for this work or any ## derivatives thereof. No warranties on this program are made or implied. ## ## Warning: ## Because of the dynamic nature of the ODP third-party provider we're ## using (Netscape), this script changes monthly to keep up-to-date ## with changes Netscape makes to the formatting of their site. ## Be prepared to update this script regularly. Starting with version 1.31, ## changes are noted also within the script itself. ## ## Adapted with permission from maxcomm.cgi: ## ## Author : Ross Faulds (Checkpoint Computer Consultants Ltd) ## email : ross@checkpoint.demon.co.uk ## Web : http://www.computer-mentors.co.uk/download.html ## Copyright : Checkpoint Computer Consultants (1999) ## Date : 06/04/1999 ## ############################################################################# ## Installation Instructions: ## ## ftp pod.cgi into your cgi-bin directory. ## set permissions for pod.cgi (For unix this should be 0755) ## ## Check with your webmaster that your web server has GET and POST ## allowed. ## ## Note that when you download the footer and header files, ## that they may have the extension .txt -- Change this to .html ## ## Note that you need to have the following perl modules and libraries ## installed or this script doesn't work: ## CGI, LWP, URI, HTTP, Fcntl ## Ask your system administrator or Webmaster to install these if they ## don't already exist on your system. The nature of perl is that you ## use pre-existing libraries as much as possible; they are quick and ## painless to install on any system. Download them from http://cpan.perl.org ## ## Change the following variables: ## ## $cgi-url - set to the path to your cgi-bin (ensure forward slash on end) ## $logging - set to 1 if you want to log searches 0 if you dont. ## $logdir - set to the FULL path to the file. ## $logfile - set to the log file name you want searches logged to. ## $templatedir - set to the FULL path to the file where the header.html ## and footer.html files are located ## ## $myhome - set to whatever your Web homepage is ## $pod_name - set to whatever you want to call your Personal Open Directory ## ## $ddj - set to the path of your system date program (whereis date) ## $fontface - set font face other than default ## $fontsize - set font size other than default ## ## The below automated book-linking feature requires 2 things: ## 1. You have access to or have installed the MaxComm script ## 2. You have an Amazon Associates ID ## If you do not have both of these, then leave $whichamazon alone. ## ## $whichamazon - set to the Amazon.com bookstore you'd like to link to ## or set to "" to turn off this feature ## $amazon_ID - set to your Amazon Associates ID ## $maxcomm - set to the complete URL of where to access the MaxComm script ## $bookstorename - Name of your link to Amazon.com (default = Amazon.com) ## ## Version Changes: ## v1.60n - Bug fixes; debugger message ## v1.55n - Bug fixes ## v1.54n - Internationalization option added ## v1.53n - Minor search patch ## v1.52 - Minor patch ## v1.51 - Formatting fixes (noted in code under 1.51) ## v1.50 - Minor bug fixes and moved variables out to separate file (podvars.pm) ## v1.36 - Fixed book string and added choices to Amazon links thanks to WizarDave! ## v1.35 - Directory URL fix (again) -> change search.netscape.com to directory.netscape.com ## v1.34 - Right column option (not released) (if you want this option, suggest download ## entire program and reinstall, because changes were extensive) ## v1.331 - Change directory.netscape.com to search.netscape.com ## v1.33 - Stupid google fix (again) ## v1.32 - Fixed ads which were appearing after search results ## v1.31 - Fixed Google "Next 10 Results" link ## v1.3 - Fixed Next 10 search results, other minor fixes ## v1.24 - Fixed google image problem ## v1.22/3 - Fixed "search more results" link ## v1.21 - Fixed "search again" form ## v1.20 - Fixed Netscape redesign and search engine 'more results' bug ## Change color of tables ## v1.19 - Misc search engine formatting bug fixes ## v1.18 - Fixed book link when conducting multi-word POD searches ## Fixed about from homepage suggest-a-site ## v1.17 - Added font control ## v1.16 - Fixed image problem with Hot sites ## v1.15 - Fixed 600 width problem, improved installation instructions, ## added $bookstorename variable ## v1.14 - Fixed World subdirectory problem ## v1.13 - NR ## v1.12 - Original public release ############################################################################# ## Modules needed: use CGI; use LWP::UserAgent; use URI::Escape; use HTTP::Request; use HTTP::Response; use Fcntl; ############################################################################# ## Configuration area ## ## Configuration variables are now in separate file called "podvars.pm" ## Place this file in the same directory as POD (add full path before ## filename below if you're having troubles). require "podvars.pm"; ############################################################################# ## Main program ## Let's grab the variables being passed to the program and clean them ## up and assign them. $q = new CGI; $tag = $q->param(tag); $footer = &page_footer; print $q->header; &page_header; $dir = $q->param(dir); $dir =~ s/%([\dA-Fa-f]{2})/pack("C", hex($1))/eisg; $ssrch = "search"; $which_dir = "http://directory.netscape.com"; $keyword = $q->param(search); # 1.52 if (($dir =~ /search/) && (!($dir =~ /srp/))) { $trg = rindex($dir, "search"); $tre = index($dir,"=",$trg); $trra = rindex($dir,"\&"); $keyword = substr($dir,$tre+1); } $keyword =~ s/\`//g; $keyword =~ s/\'//g; $all = $q->param(all); $cat = $q->param(cat); $start = $q->param(start); $fo = $q->param(fo); $so = $q->param(so); $co = $q->param(co); $cp = $q->param(cp); $jsites = $q->param(jsites); $jstart = $q->param(jstart); $mcat = $q->param(morecat); if ($dir =~ /morecat/) { $mcat = 1; } if ($logging == 1) { &log_search($keyword,$ddj); } $tag = $q->param(tag); $mode = $q->param(mode); $content = &get_first_page($keyword,$all,$cat,$dir,$jsites,$jstart,$start,$mcat,$fo,$so,$co,$cp); &modify_content($pod_name,$content,$which_dir,$dir,$keyword,$whichamazon,$amazon_ID,$maxcomm,$bookstorename,$fontface,$fontsize,$start,$jstart,$cp,$lighttable,$darktable,$medtable,$tabletext,$right_column,$ssrch); exit 0; ## This is where the magic occurs. We do a number of checks for certain HTML ## on the Netscape site and begin the massive search and replace on each page fetched. ## This isn't pretty, is very dependent on the HTML, but it works. sub modify_content() { my $pod_name = shift(@_); my $content = shift(@_); my $which_dir = shift(@_); my $dir = shift(@_); my $keyword = shift(@_); my $whichamazon = shift(@_); my $amazon_ID = shift(@_); my $maxcomm = shift(@_); my $bookstorename = shift(@_); my $fontface = shift(@_); my $fontsize = shift(@_); my $start = shift(@_); my $jstart = shift(@_); my $cp = shift(@_); my $lighttable = shift(@_); my $darktable = shift(@_); my $medtable = shift(@_); my $tabletext = shift(@_); my $right_column = shift(@_); my $ssrch = shift(@_); printf "
\n"; @page = split(/\n/,$content); $skip=0; $endpoint = 0; $des = "desc.html"; $faq = "faq.html"; $help = "searchguide.html"; $aactive = 0; foreach $line (@page) { $_ = $line; if (($line =~ /<\/FONT><\/TD><\/TR><\/TABLE>/) || ($line =~ /<\!-- E3:END:AD -->/) || (((length($dir) < 2) || ($dir =~ /search/)) && ($line =~ /You are here/))) { $skip = 1; } elsif (($skip ne 1) && ($line =~ /<\!-- footer -->/)) { $skip = 1; } # 1.54 Internationalization mod contributed by: # Scott Stevenson \@ 1999 extra_lovin\@yahoo.com # If Internationalization isn't working by default in your # directory, try uncommenting out the below line: # &international; $line = uri_unescape($line); # Spits out bookstore search box on homepage if (($line =~ /escapes\/search\/about/) && ($whichamazon) && ($right_column eq 1)) { $topic = $keyword; $topic =~ s/\///g; $topic_dis = $topic; $topic =~ s/[_ ]/+/g; $topic_dis =~ s/_/ /g; printf qq~
Search

at $bookstorename
~; $line = ""; } # 1.60 if (($line =~ "Search directly from your browser.") || ($line =~ "Internet Keywords")) { $line = ""; } # end path # 1.55 $line =~ s/\/search.tmpl?/$progname/g; $line =~ s/http:\/\/info.netscape.com\/fwd\/srpcatbox\///g; # end patch $line =~ s/href=\"searchguide.html\"/href=\"$dir$help\"/; $line =~ s/<[Aa] [Hh][Rr][Ee][Ff]=\"http:\/\/search.netscape.com\/\">Netscape Search<\/[Aa]>/$pod_name<\/font><\/a>/; $line =~ s/Netscape Search/$pod_name<\/font>/; $line =~ s/Netscape Open Directory/$pod_name<\/font>/; # 1.51 $line =~ s/\/img\/nsmailGD.gif/http:\/\/directory.netscape.com\/img\/nsmailGD.gif/g; $line =~ s/[Ss][Rr][Cc]=\"netscapeimg/src=\"http:\/\/google.netscape.com\/netscapeimg/g; # end patch if ($fontface) { $line =~ s/[Ff][Aa][Cc][Ee]=\"[Ss]ans-[Ss]erif, [Aa]rial, [Hh]elvetica\"/face=\"$fontface\"/g; } if ($fontsize) { $line =~ s/[Ss][Ii][Zz][Ee]=[-+][123]/size=\"$fontsize\"/g; $line =~ s/[Ff][Oo][Nn][Tt]/font size=\"$fontsize\"/g; } if (($line =~ /[Aa][Cc][Tt][Ii][Oo][Nn]/) && (!($line =~ /cgi-bin/))) { $line =~ s/[Aa][Cc][Tt][Ii][Oo][Nn]=\"search\"/action=\"$cgi_url$progname\"/g; } $line =~ s/~~//g; $line =~ s/[Hh][Rr][Ee][Ff]=\"\//href=\"$cgi_url$progname?dir=\//g; $line =~ s/[Hh][Rr][Ee][Ff]=\"http:\/\/directory.netscape.com\//href=\"$cgi_url$progname?dir=\//g; $line =~ s/http:\/\/search.netscape.com//g; $line =~ s/\/cgi-bin\/search/$cgi_url$progname/g; $line =~ s/[Hh][Rr][Ee][Ff]=\/netscape\?q=/href=http:\/\/google.netscape.com\/netscape\?q=/g; $line =~ s/[Hh][Rr][Ee][Ff]=\"search/href=\"$cgi_url$progname/g; $line =~ s/[Hh][Rr][Ee][Ff]=\"http:\/\/home.netscape.com\/index.html/href=\"$myhome/; $line =~ s/[Hh][Rr][Ee][Ff]=\"http:\/\/home.netscape.com\/\">Home/href=\"$myhome\">Home/; $line =~ s/
/
/g; $line =~ s/[Ww][Ii][Dd][Tt][Hh]=600/width=\"92\%\"/g; $line =~ s/[Ww][Ii][Dd][Tt][Hh]=\"600\"/width=\"92\%\"/g; $line =~ s/\/images/http:\/\/directory.netscape.com\/images/g; $line =~ s/\"\/img/\"http:\/\/directory.netscape.com\/img/g; $line =~ s/\/\?cp=srpmatcat//g; $line =~ s/td width=\"40\%\"/td width=\"60\%\"/g; if ($right_column eq 0) { $line =~ s/WIDTH=585/width=\"95\%\"/g; $line =~ s/WIDTH=437/width=\"95\%\"/g; $line =~ s/WIDTH=215/width=\"50\%\"/g; } # 1.51 if (($darktable) && ($line =~ /99CCCC/) && ($skip eq 1)) { $line =~ s/#99CCCC/$darktable/g; $gsaux = 1; } if ($lighttable) { $line =~ s/#EEEEEE/$lighttable/g; } if ($medtable) { $line =~ s/#CCCCCC/$medtable/g; } if (($line =~ /006666/) && ($line =~ /-/) && ($line =~ /of/)) { $gsaux = 0; } if (($tabletext) && ($gsaux eq 1) && (($line =~ /[Ss][Ii][Zz][Ee]=2/) && ($line =~ /[Ff][Oo][Nn][Tt]/))) { $line =~ s/<[Ff][Oo][Nn][Tt] / 3) && (!($dir =~ /.html/))) || ($keyword)) && ($line =~ /<\!-- BAN_NAV:END:BOT -->/)) { $aactive = 1; $line =~ s/<\!-- BAN_NAV:END:BOT -->/
/; } # } if (($line =~ /<\!--------\*\*END MAIN TABLE\*\*-------->/) || ($line =~ /<\/body>/) || ($line =~ /<\!-- footer -->/) || ($line =~ /<\!-- start: footer -->/) # 1.51 || (($lastline =~ //) && ($line =~ /http:\/\/home.netscape.com\/misc\/nav_redir\/help.html/)) # end patch || (($right_column eq 0) && ($line =~ /
\n"; } if ((!($keyword)) && ($right_column eq 0)) { printf "
\n"; } $endpoint = 1; } # 1.51 if ($skip ==1) { printf "$line\n"; $lastline = $line; } # end patch last if ($endpoint == 1); } # Amazon.com link if ($aactive eq 1) { if (length($dir) > 3) { $topx = $dir; # $triz = rindex($topx,"?") - 1; ## The below if/else changed by WizarDave if (index($topx,"?") > 0) { if ($topx =~ nsidircat) { ## 1.52 ## If amazon.com link is missing last character, ## replace the line below with: ## $triz = rindex($topx,"?"); $triz = rindex($topx,"?") - 1; } else { $triz = rindex($topx,"?"); } } else { $triz = length($topx); } ## The above if/else changed by WizarDave $topx = substr($topx,0,$triz); $tidx = rindex($topx,"/"); $topic = substr($topx,$tidx); } else { $topic = $keyword; } $topic =~ s/\///g; $topic_dis = $topic; $topic =~ s/[_ ]/+/g; $topic_dis =~ s/_/ /g; if (($whichamazon) && ($right_column)) { printf qq~  
Find books on:
$topic_dis
at $bookstorename. ~; print qq~

Search

at $bookstorename
~; } else { print "\n"; } } # Feel free to edit the footer as you'd like, but we # would appreciate credit for the script *somewhere* # on your Website. Thanks! print $footer; print qq~

Personal Open Directory is open source software by J. Grohol & R. Faulds
Copyright 1999. v1.60n. All rights reserved.

~; } ## Routine fetches pages from Netscape with proper URLs sub get_first_page() { my $keyword = shift(@_); my $all = shift(@_); my $cat = shift(@_); my $dir = shift(@_); my $jsites = shift(@_); my $jstart = shift(@_); my $start = shift(@_); my $mcat = shift(@_); my $fo = shift(@_); my $so = shift(@_); my $co = shift(@_); my $cp = shift(@_); $keyword =~ s/ /+/g; if ((length($dir) < 4) && ($keyword) && (not($jstart)) && (!($mcat))) { $url = "http://search.netscape.com/cgi-bin/search\?search\=$keyword&all=$all&cat=$cat&morecat=$morecat"; } elsif (($jstart > 0) && (!($mcat))) { $url = "http://search.netscape.com/cgi-bin/search\?cp=$cp&search\=$keyword&jstart=$jstart"; } elsif ($mcat > 0) { $url = "http://search.netscape.com/cgi-bin/search\?search\=$keyword&morecat=$mcat"; } else { $url = $which_dir . $dir; if ($jsites) { $url = $url . "&jsites=$jsites"; } if ($jstart) { $url = $url . "&jstart=$jstart"; } if ($start) { $url = $url . "&start=$start"; } if ($fo) { $url = $url . "&fo=$fo"; } if ($so) { $url = $url . "&so=$so"; } if ($co) { $url = $url . "&co=$co"; } if ($keyword) { $url = $url . "&search=$keyword"; } if ($morecat) { $url = $url . "&morecat=$morecat"; } } # 1.60 my $ua = LWP::UserAgent->new(); # Create a request my $req = new HTTP::Request POST => $url; $req->content_type('application/x-www-form-urlencoded'); # Pass request to the user agent and get a response back my $res = $ua->request($req); # Check the outcome of the response if ($res->is_success) { $content = $res -> content(); } else { $res->error_as_HTML(); printf("

POD encountered the following error while trying to run:
%s\n",$res->status_line); printf("
Attempted retrieval URL: $url

\n\n"); } return $content; # 1.60 end } sub log_search { my $searchwords = shift(@_); my $ddj = shift(@_); $datej = `$ddj +"%-d %b %Y"`; chop($datej); open (WRITEIT, ">>$logdir/$logfile"); flock(WRITEIT, LOCK_EX); seek (WRITEIT, 0,2); print WRITEIT "$datej|$searchwords\n"; close(WRITEIT); } sub page_header{ open (READIT, "$templatedir/header.html"); read (READIT, $header, 20000,0); close (READIT); print $header; } sub page_footer{ open (READIT,"$templatedir/footer.html"); read (READIT, $footer, 20000,0); close (READIT); return $footer; } # Internationalization mod contributed by: # Scott Stevenson \@ 1999 extra_lovin\@yahoo.com sub international { if (($line =~ /%/) && ($line =~///; if ($line =~ /
  • //; print "
  • "; } else { print ""; } } # end of new internationlization section } 1;