CGI search script: Exclusion list

Perlwannabe has asked for the wisdom of the Perl Monks concerning the following question:

Hi everyone,

I'm not a Perl programmer at all. I have an elementary script to create a little search engine,and I would create a filter in order to prevent that certain terms are considered suitable for the search.This in order to avoid to get search results for common short words such as "any" "and" "for" and so on. The script provides a length filter that cuts off all typed words shorter than a certain length,but it can't work at all as there are,in my case,short terms that,instead are suitable for the search,such as "kit" or "cap" and so on...So I must give up this idea.

Alternatively,I could store these "stop words" in an external list and create a proper expression to handle them,so that they will be simply ignored for the search,but I have no idea about how to do.

I noticed that the script provides a smut filter that works with an exclusion list,censoring all the records containing smut words;I think this could work also for the "stop words",but I should modify the code in order to obtain that my "stop words" are simply ignored for the search,with no censor. Could anyone please help me to edit properly this code?

Any help will be very appreciated,thanks.

Here is the full script:

#!/usr/local/bin/perl



    $sitetitle = 'Your Search Engine Name';

# Change this to the url of your seach engine index page

    $searchurl = 'http://www.blabla.com/search/index.html';

# Change this to your e-mail address
# Depending on your version of PERL you may have to escape
# the @ sign like this \@
# At first try just entering your straight e-mail address

    $searchemail = 'you@youremail.com';

# You may not need to change the $mailprogram variable. 
# Try it as is first. If it doesn't work try putting a # in 
# front of the first line below and remove the # on the 
# second line. If that fails, try the removing the # on
# the third line and put a # in front of the other two. 
# If that fails, ask your administrator where the sendmail
# program is on your system. 

    $mailprogram = '/usr/sbin/sendmail';
    # $mailprogram = '/usr/lib/sendmail';
    # $mailprogram = '/usr/bin/sendmail';

# Change this to the PATH (not the URL) of the base.txt file 
# (include the filename)

    $base = '/home/bla/public_html/search/base.txt';

# Change this to the PATH (not the URL) of the head.txt file 
# (include the filename)

    $headfile = '/home/bla/public_html/search/head.txt';

# Change this to the PATH (not the URL) of the foot.txt file 
# (include the filename)

    $footfile = '/home/bla/public_html/search/foot.txt';

# Change this to the PATH (not the URL) of the respond.txt file 
# (include the filename)

    $respondfile = '/home/bla/public_html/search/respond.txt';


# Change this to the PATH (not the URL) of the smut.txt file
# Any word found in smut.txt is assumed to be adult material
# therefore you can control what is censored and what isn't 
# (include the filename)

    $smutfile = '/home/bla/public_html/search/smut.txt';

# Change this to the URL of this script 
# (include the filename)

    $scripturl = 'http://www.blabla.com/cgi-bin/easysearch.cgi';

# Edit this one to choose the font for the search results
# DO NOT use " or any special characters
# Use below for an example of what is allowed
# Also do not set a font size as the script does this automatically

    $font = 'FACE=arial,helvetica COLOR=000000';

# Change this to the minimum search word length
# This is to exclude searches for "the", "and", "a", etc.

    $minword = '3';

# Enter the maximum number of characters you want to allow for
# the 'title' field for new site submissions

    $maxtitle = '50';

# Enter the maximum number of characters you want to allow for
# the 'description' field for new site submissions

    $maxdescription = '150';

# Enter the maximum number of characters you want to allow for
# the 'keywords' field for new site submissions

    $maxkeywords = '50';

# How many URLs do you want displayed on the New URLs page

    $numnew = '3';

# If you want to use flock to avoid corrupt files by double access 
# leave this line as is...if you don't then change the 1 to a 0

    $uselock = '1';

# If you want to automatically send an autorespond e-mail to visitors
# who submit their URL to the database then leave this line as is
# If you don't, then change the 1 to a 0

    $userespond = '1';


# Get the form variables

    if ($ENV{'REQUEST_METHOD'} eq 'GET') {
            $buffer = $ENV{'QUERY_STRING'};
    }    
    else {
            read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
    }

# Break em up into a format the script can read

    @pairs = split(/&/, $buffer);
    foreach $pair (@pairs) {
            ($name, $value) = split(/=/, $pair);
            $value =~ tr/+/ /;
            $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/e
+g;
            $FORM{$name} = $value;
    }

# Get the heading information

    unless (open (DATA,"$headfile")) {die (&error);}
        if ($uselock eq '1') {
            flock DATA, 2;
            seek DATA, 0, 0;
        }
        @headinfo = <DATA>;
        if ($uselock eq '1') {
            flock DATA, 8;
        }
    close (DATA);
    foreach $headline (@headinfo){
        $heading = $heading.$headline;
    }

# Get the footer information

    unless (open (DATA,"$footfile")) {die (&error);}
        if ($uselock eq '1') {
            flock DATA, 2;
            seek DATA, 0, 0;
        }
        @footinfo = <DATA>;
        if ($uselock eq '1') {
            flock DATA, 8;
        }
    close (DATA);
    foreach $footline (@footinfo){
        $footer = $footer.$footline;
    }

<b># Get the smut filter information

    unless (open (DATA,"$smutfile")) {die (&error);}
        if ($uselock eq '1') {
            flock DATA, 2;
            seek DATA, 0, 0;
        }
        @smutinfo = <DATA>;
        if ($uselock eq '1') {
            flock DATA, 8;
        }
    close (DATA);
    foreach $smutline (@smutinfo){
        $smutfilter = $smutfilter.$smutline;
        @smutwords = split (/::/,$smutfilter);
    }</b>

# Determine what part of the script we need

    if ($FORM{'action'} eq "showadd") {
        &showadd;
    }

    if ($FORM{'action'} eq "addurl") {
        &addurl;
    }

    if ($FORM{'action'} eq "newurls"){
        &newurls;
    }

    if ($FORM{'action'} eq "randomurl"){
        &randomurl;
    }


# Assign shorter variable names 
# (Laziness on my part - but I find the longer 
# a script gets the more work typing long 
# variable names becomes.)

    $position = $FORM{'code'};
    $addshow = 0;
    $noshow = 0;
    $match = 0;
    if ($FORM{'safe'} ne "on") {
        $safekey = "off";
    } else {
        $safekey = "on";
    }

# Begin the search process and output the results

    unless (open (DATA,"$base")) {die (&error);}
    if ($uselock eq '1') {
        flock DATA, 2;
        seek DATA, 0, 0;
    }
    @input = <DATA>;
    if ($uselock eq '1') {
        flock DATA, 8;
    }
    close (DATA);

<b># Routine for 'words' search

    if ($FORM{'mode'} eq "words") {
        $searchstring=$FORM{'keywords'};
        @words = split (/ /,$searchstring);
        foreach $word (@words) {
            $wordlength = length($word);
            if ($wordlength < $minword) {
                &stringshort;
            }
        }
        &heading;
        $entries = @input;
        if ($position == 0) {
            $currentline = $entries;    
        } else {
            $currentline = $position;
        }
        $found="0";
        print "<CENTER><FONT $font SIZE=3><B>Search Results : </B>'$FO
+RM{'keywords'}'<P></FONT></CENTER>";
        print "<HR WIDTH=400>";
        print "<FONT $font SIZE=2>";
        until ($found > 9 || $currentline == 0) {
            foreach $word (@words) {
                if ($input[$currentline] =~ /$word/i) {
                    @data = split (/::/,$input[$currentline]);
                    if ($data[4] ne "") {
                        if ($safekey eq "on" && $match == 0) {
                            foreach $smutword (@smutwords) {
                                if ($input[$currentline] =~ /$smutword
+/i) {
                                    $smut = 1;
                                }
                            }    
                            unless ($smut == 1) {
                            print "<A HREF=\"$data[0]\"><B>$data[1]</B
+></A><BR>";
                                        print "$data[4]<BR>";
                            print "<I>$data[0]</I><P>";
                            ++$found;
                            ++$match;
                        }
                        $smut = 0;
                    }
                        if ($safekey eq "off" && $match == 0) {
                            print "<A HREF=\"$data[0]\"><B>$data[1]</B
+></A><BR>";
                                        print "$data[4]<BR>";
                            print "<I>$data[0]</I><P>";
                            ++$found;
                            ++$match;
                        }
                    }
                }
            }
            --$currentline;
            $match = 0;
        }  
    }</b>

# Routine for 'phrases' search

    if ($FORM{'mode'} eq "phrases") {
        $searchstring=$FORM{'keywords'};
            $wordlength = length($FORM{'keywords'});
            if ($wordlength < $minword) {
                &phrase;
            }
        &heading;
        $entries = @input;
        if ($position == 0) {
            $currentline=$entries;    
        } else {
            $currentline = $position;
        }
        print "<CENTER><FONT $font SIZE=3><B>Search Results : </B>'$FO
+RM{'keywords'}'<P></FONT></CENTER>";
        print "<HR WIDTH=400>";
        print "<FONT $font SIZE=2>";
        until ($found > 9 || $currentline == 0) {
            if ($input[$currentline] =~ /$FORM{'keywords'}/i) {
                @data = split (/::/,$input[$currentline]);
                if ($data[4] ne "") {
                    if ($safekey eq "on") {
                            foreach $smutword (@smutwords) {
                                if ($input[$currentline] =~ /$smutword
+/i) {
                                    $smut = 1;
                                }
                            }                    
                            unless ($smut == 1) {
                            print "<A HREF=\"$data[0]\"><B>$data[1]</B
+></A><BR>";
                                        print "$data[4]<BR>";
                            print "<I>$data[0]</I><P>";
                            ++$found;
                        }
                        $smut = 0;
                    }
                    if ($safekey eq "off") {
                        print "<A HREF=\"$data[0]\"><B>$data[1]</B></A
+><BR>";
                                    print "$data[4]<BR>";
                        print "<I>$data[0]</I><P>";
                        ++$found;
                    }
                }
            }
            --$currentline;
        }  
    }
    print "</FONT>"; 
    &footer;

#################   SUBROUTINES   ######################

sub heading {
    print "Content-type: text/html\n\n";
    print "$heading";
}

sub footer {
    $keyencode=$FORM{'keywords'};
    $keyencode =~ tr/ /+/;
    if ($found > 9) {
        $position=$currentline;
        print "<CENTER><FONT $font size=3><A HREF=\"$scripturl?keyword
+s=$keyencode&code=$position&mode=$FORM{'mode'}&safe=$safekey \"><B>Mo
+re Results</B></A><BR><HR WIDTH=400></FONT></CENTER>";
    }
    else {
        unless ($addshow == 1) {
            print "<CENTER><FONT $font SIZE=2><B>End of Results.</B><B
+R><HR WIDTH=400></FONT></CENTER>\n";
        }
    }
    unless ($noshow == 1) {
        unless ($addshow == 1) {
            print "<CENTER><P><FORM METHOD=post ACTION=$scripturl><TAB
+LE><TR><TD VALIGN=TOP><FONT $font SIZE=3><B>Search For :</B></FONT></
+TD><TD><INPUT TYPE=TEXT NAME=keywords SIZE=25 VALUE=\"$FORM{'keywords
+'}\"><BR><FONT $font SIZE=2><B>Mode :</B><INPUT TYPE=\"radio\" NAME=\
+"mode\" VALUE=\"words\" CHECKED>Words<INPUT TYPE=\"radio\" NAME=\"mod
+e\" VALUE=\"phrases\">Phrase<BR><B>Safe : </B><INPUT TYPE=\"checkbox\
+" NAME=\"safe\" CHECKED>Omit Offensive Slang</FONT></TD><TD VALIGN=TO
+P ALIGN=CENTER WIDTH=60><INPUT TYPE=SUBMIT VALUE=\"Search!\"></TD></T
+R></TABLE></FORM><p></CENTER>\n";
        }
        if ($FORM{'keywords'} ne "") {
            print "<CENTER><FONT $font size=2><B>Search for \"$FORM{'k
+eywords'}\" in these search engines...<br><A HREF=\"http://www.altavi
+sta.com/cgi-bin/query?pg=q&what=web&q=$keyencode\">AltaVista</A> <A H
+REF=\"http://search.dejanews.com/dnquery.xp?query=$keyencode&defaultO
+p=AND&svcclass=dncurrent&maxhits=20\">DejaNews</A> <A HREF=\"http://s
+earch.excite.com/search.gw?search=$keyencode\">Excite</A> <A HREF=\"h
+ttp://guide-p.infoseek.com/Titles/?qt=$keyencode\">GO Network</A> <A 
+HREF=\"http://www.hotbot.com/?MT=$keyencode&SM=MC&DV=0&LG=any&DC=10&D
+E=2&_v=2&OPs=MDRTP&Search.x=38&Search.y=15\">HotBot</A> <A HREF=\"htt
+p://www.lycos.com/cgi-bin/pursuit?query=$keyencode&maxhits=20\">Lycos
+</A> <A HREF=\"http://www.webcrawler.com/cgi-bin/WebQuery?searchText=
+$keyencode&maxHits=20\">WebCrawler</A> <A HREF=\"http://search.yahoo.
+com/bin/search?p=$keyencode\">Yahoo!</A></B><P></CENTER>\n";
        }
    }
    &generate;
    print "$footer";
    exit;
}

sub error {    
    $noshow = 1;
    &heading;
    print "<CENTER><FONT $font><h2>File Access Error</h2><P><B>You hav
+e an error in your PATH configuration variables in the $ENV{'SCRIPT_N
+AME'} file.</B><P>Your server reports that your BASE path is : $ENV{'
+DOCUMENT_ROOT'}<BR>Note that this is reported as your BASE path, not 
+the FULL path to your files.<P>If you require help installing this sc
+ript please consider purchasing the professional version of this scri
+pt. Your purchase includes full tech support and installation.<P><B>G
+et it at : <A HREF=http://www.getperl.com/easysearch/>http://www.getp
+erl.com/easysearch/</A></B></FONT></CENTER><P>\n";
    &footer;
}

sub stringshort {
    $noshow = 1;
      print "Content-type: text/html\n\n";
    &heading;
      print "<CENTER><FONT $font><h2>Word Too Short</h2><P><B>Sorry...
+each word must be at least $minword characters long.</B></FONT></CENT
+ER><P>\n";
    &footer;
}

sub phrase {
    $noshow = 1;
      print "Content-type: text/html\n\n";
    &heading;
      print "<CENTER><FONT $font><h2>Phrase Too Short</h2><P><B>Sorry.
+..your phrase must be at least $minword characters long.</B></FONT></
+CENTER><P>\n";
    &footer;
}

sub generate {
    print "<HR WIDTH=400>\n";
    print "<FONT $font SIZE=2><CENTER><P>Powered by : <A HREF=\"http:/
+/www.getperl.com/\"><B>EasySearch</B></A> - Copyright 1999 by Thomas 
+J. Delorme</CENTER></FONT><P>\n";
    print "<HR WIDTH=400>\n";
}

sub showadd {
    &heading;
    $addshow = 1;
    print "<CENTER><FONT $font SIZE=3><B>Add URL</B></FONT><HR WIDTH=4
+00>\n";
    print "<FONT $font SIZE=2>Please fill out the following informatio
+n and press the SUBMIT button.<BR>\n";
    print "<B>Please note that all fields are required</B>.</FONT><P>\
+n";
    print "<FORM METHOD=post ACTION=$scripturl>\n";
    print "<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=5>\n";
    print "<TR><TD ALIGN=RIGHT><B><FONT $font SIZE=2>E-mail :</FONT></
+B></TD><TD><INPUT NAME=email TYPE=text SIZE=35><BR></TD></TR>\n";
    print "<TR><TD ALIGN=RIGHT><B><FONT $font SIZE=2>Site Title : </FO
+NT></B></TD><TD><INPUT NAME=title TYPE=text SIZE=35 MAXLENGTH=$maxtit
+le><BR></TD></TR>\n";
    print "<TR><TD ALIGN=RIGHT><B><FONT $font SIZE=2>Url : </FONT></B>
+</TD><TD><INPUT NAME=url TYPE=text SIZE=35 value=http://><BR></TD></T
+R>\n";
    print "<TR><TD ALIGN=RIGHT><B><FONT $font SIZE=2>Description : </F
+ONT></B></TD><TD><INPUT NAME=description TYPE=text SIZE=35 MAXLENGTH=
+$maxdescription><BR></TD></TR>\n";
    print "<TR><TD VALIGN=TOP ALIGN=RIGHT><FONT $font SIZE=2><B>Keywor
+ds : </B><BR><I>(Commas, no spaces)</I></FONT></TD><TD VALIGN=TOP><IN
+PUT NAME=keywords TYPE=text SIZE=35 MAXLENGTH=$maxkeywords><BR></TD><
+/TR>\n";
    print "</TABLE>\n";
    print "<INPUT TYPE=checkbox NAME=send CHECKED><FONT $font SIZE=2> 
+I would like to receive occassional news from $sitetitle.</FONT><P>\n
+";
    print "<INPUT TYPE=hidden NAME=action VALUE=addurl>\n";
    print "<INPUT TYPE=submit VALUE=Submit> <INPUT TYPE=reset VALUE=Cl
+ear></FORM></CENTER>\n";
    &footer;
}

sub addurl {
    &heading;
    $noshow = 1;
    unless ($FORM{'url'} =~ /http:\/\//) {
        &submiterror;
    }

    if ($FORM{'url'} eq "" || $FORM{'title'} eq "" || $FORM{'email'} e
+q "" || $FORM{'description'} eq "" || $FORM{'keywords'} eq "") {
        &empty;
    }

    unless (open (DATA,"$base")) {die (&error);}
    if ($uselock eq '1') {
        flock DATA, 2;
        seek DATA, 0, 0;
    }
    @input = <DATA>;
    if ($uselock eq '1') {
        flock DATA, 8;
    }
    close (DATA);
    $entries = @input;

    $urlsearch = "$FORM{'url'}"."::";
    $urltemp = $FORM{'url'};
    chomp($urltemp);
    chop($urltemp);
    $urlsearchtwo = "$urltemp"."::";
    $urlsearchthree = "$FORM{'url'}"."/::";
    $currentline = 0;
    until ($currentline == $entries) {
        if ($input[$currentline] =~ /$urlsearch/i) {
            &exists;
        }
        if ($input[$currentline] =~ /$urlsearchtwo/i) {
            &exists;
        }
        if ($input[$currentline] =~ /$urlsearchthree/i) {
            &exists;
        }
        ++$currentline;
    }  

    $testline = $input[$currentline-1];
    $testline2 = $input[$currentline-2];
    $testline3 = $input[$currentline-3];
    $testline4 = $input[$currentline-4];
    $testline5 = $input[$currentline-5];
    $testline6 = $input[$currentline-6];
    $testline7 = $input[$currentline-7];
    $testline8 = $input[$currentline-8];
    $testline9 = $input[$currentline-9];
    $testline10 = $input[$currentline-10];

    if ($testline =~ /$FORM{'description'}/) {
        &samestuff;
    }

    if ($testline =~ /$FORM{'title'}/) {
        &samestuff;
    }

    if ($testline =~ /$FORM{'keywords'}/) {
        &samestuff;
    }

    if ($testline =~ /$FORM{'email'}/i || $testline2 =~ /$FORM{'email'
+}/i || $testline3 =~ /$FORM{'email'}/i || $testline4 =~ /$FORM{'email
+'}/i || $testline5 =~ /$FORM{'email'}/i || $testline6 =~ /$FORM{'emai
+l'}/i || $testline7 =~ /$FORM{'email'}/i || $testline8 =~ /$FORM{'ema
+il'}/i || $testline9 =~ /$FORM{'email'}/i || $testline10 =~ /$FORM{'e
+mail'}/i) {
        &justsubmitted;
    }

    $newemail = $FORM{'email'};
    if ($FORM{'send'} ne "on") {
        $newemail = "X"."$newemail"."X";    
    }
    $newtitle = substr($FORM{'title'},0,$maxtitle);
    $newdesc = substr($FORM{'description'},0,$maxdescription);
    $newkeywords = substr($FORM{'keywords'},0,$maxkeywords);
    $line = join ("::","$FORM{'url'}","$newtitle","$newkeywords","$new
+email","$newdesc");

    unless (open (DATA,">>$base")) {die (&error);}
        if ($uselock eq '1') {
            flock DATA, 2;
            seek DATA, 0, 2;
        }
        print DATA "$line\n";
        if ($uselock eq '1') {
            flock DATA, 8;
        }
    close (DATA);

    print "<center><HR WIDTH=400><FONT $font SIZE=3><b>Submission Rece
+ived</b></font><p>\n";
    print "<FONT $font SIZE=2><B>The following submission has been rec
+eived by $sitetitle :</B></font><br>\n";
    print "<table width=400><tr><td align=right><FONT $font SIZE=2><B>
+URL :</B></font></td>\n";
    print "<td><a href=\"$FORM{'url'}\"><FONT $font SIZE=2><b>$FORM{'u
+rl'}</b></font></a></td></tr>\n";
    print "<tr><td align=right><FONT $font SIZE=2><B>Title :</B></font
+></td><td><FONT $font SIZE=2> $FORM{'title'}</td></tr>\n";
    print "<tr><td align=right><FONT $font SIZE=2><B>Keywords :</B></f
+ont></td><td><FONT $font SIZE=2> $FORM{'keywords'}</td></tr>\n";
    print "<tr><td align=right><FONT $font SIZE=2><B>Description :</B>
+</font></td><td><FONT $font SIZE=2> $FORM{'description'}</td></tr>\n"
+;
    print "<tr><td align=right><FONT $font SIZE=2><B>E-mail :</B></fon
+t></td><td><FONT $font SIZE=2> $FORM{'email'}</font></td></tr></table
+></center><p>\n";

    if ($userespond eq '1') {
        unless (open (DATA,"$respondfile")) {die (&error);}
            if ($uselock eq '1') {
                flock DATA, 2;
                seek DATA, 0, 0;
            }
            @respondinfo = <DATA>;
            if ($uselock eq '1') {
                flock DATA, 8;
            }
        close (DATA);
        foreach $respondline (@respondinfo){
            $respondmessage = $respondmessage.$respondline;
        }

        open (MAIL, "|$mailprogram -t");
        print MAIL "To: $FORM{'email'}\n";
        print MAIL "From: $searchemail\n";
        print MAIL "Subject: Got it!\n\n";
        print MAIL "Welcome to $sitetitle!\n";
        print MAIL "We are located at $searchurl\n\n";
        print MAIL "YOUR SUBMISSION:\n";
        print MAIL "--------------------------------------------------
+----------------\n";
        print MAIL "URL : $FORM{'url'}\n"; 
        print MAIL "Title : $FORM{'title'}\n";
        print MAIL "Description : $FORM{'description'}\n";
        print MAIL "Keywords : $FORM{'keywords'}\n";
        print MAIL "E-mail : $FORM{'email'}\n";
        print MAIL "--------------------------------------------------
+----------------\n\n";
        print MAIL "$respondmessage";
        print MAIL "--------------------------------------------------
+----------------\n\n";
        print MAIL "Thanks again,\n";
        print MAIL "---------------------------------------------\n";
        print MAIL "$sitetitle\n";
        print MAIL "$searchemail\n";
        print MAIL "$searchurl\n";
        print MAIL "---------------------------------------------\n";
        print MAIL "Powered by :\n";
        print MAIL "EasySearch - Copyright 1999\n";
        print MAIL "http://www.getperl.com\n";
        print MAIL "---------------------------------------------\n";
        close (MAIL);
    }
    &footer;
}

sub exists {
    $noshow = 1;
      print "<CENTER><FONT $font SIZE=2><h2>URL Already Exists</h2><BR
+>$FORM{'url'}<HR WIDTH=400><B>Sorry...Each URL is only allowed one en
+try.</B><P>\n";
    &footer;
}

sub samestuff {
    $noshow = 1;  
      print "<CENTER><FONT $font SIZE=2><h2>Recent URL Submission</h2>
+<HR WIDTH=400><TABLE WIDTH=400><TR><TD><B>You have recently submitted
+ an URL with either the exact same title, description, or keywords. S
+ince this is a different URL, please change your title, description a
+nd keywords to match this new page.</B></TD></TR></TABLE><P>\n";
    &footer;
}

sub justsubmitted {
    $noshow = 1;
      print "<CENTER><FONT $font SIZE=2><h2>Recent URL Submission</h2>
+<HR WIDTH=400><B>In order to avoid domain name overflow on the Newest
+ URLs page,<BR> we ask that you try your submission again later.</B><
+P>\n";
    &footer;
}


sub empty {
    $noshow = 1;
      print "<CENTER><FONT $font SIZE=2><h2>Field Empty</h2><HR WIDTH=
+400><B>Please make sure that you have filled in all fields on the for
+m.</B><P>\n";
    &footer;
}

sub submiterror {
    $noshow = 1;
      print "<CENTER><FONT $font SIZE=2><h2>Invalid URL</h2><HR WIDTH=
+400><B>Please make sure that your URL contains <B>http://</B> and is 
+correct.</B><P>\n";
    &footer;
}

sub newurls {
    &heading;
    unless (open (DATA,"$base")) {die (&error);}
    if ($uselock eq '1') {
        flock DATA, 2;
        seek DATA, 0, 0;
    }
    @input = <DATA>;
    if ($uselock eq '1') {
        flock DATA, 8;
    }
    close (DATA);
    $entries = @input;
    print "<FONT $font SIZE=3><CENTER><B>Newest URLs : </B><HR WIDTH=4
+00></CENTER></FONT>";
    $currentline = $entries;
    print "<FONT $font SIZE=2>";
    $count = 0;
    until ($count == $numnew) {
        @data = split (/::/,$input[$currentline]);
            if ($data[4] ne "") {
            foreach $smutword (@smutwords) {
                if ($input[$currentline] =~ /$smutword/i) {
                    $smut = 1;
                }
            }
            unless ($smut == 1) {
                print ("<a href=\"$data[0]\"><B>$data[1]</B></a><br>")
+;
                        print ("$data[4]<br>");
                    print ("<I>$data[0]</I><P>");
                ++$count;
            }
            $smut = 0;
        }
        --$currentline;
    }
    print "</FONT>";
    &footer;
}

sub randomurl {
    &heading;
    unless (open (DATA,"$base")) {die (&error);}
    if ($uselock eq '1') {
        flock DATA, 2;
        seek DATA, 0, 0;
    }
    @input = <DATA>;
    if ($uselock eq '1') {
        flock DATA, 8;
    }
    close (DATA);
    $entries = @input;
    print "<FONT $font SIZE=3><CENTER><B>Random URL : </B><HR WIDTH=40
+0></CENTER></FONT>";
    $count=0;
    while ($count != 1)  {
        srand (time + $$);
        $currentline = int( rand ($entries));
        print "<FONT $font SIZE=2>";
        @data = split (/::/,$input[$currentline]);
        foreach $smutword (@smutwords) {
            if ($input[$currentline] =~ /$smutword/i) {
                $smut = 1;
            }
        }
        unless ($smut == 1) {
            if ($data[4] ne "") {
                            print "<A HREF=\"$data[0]\"><B>$data[1]</B
+></A><BR>";
                            print "$data[4]<BR>";
                    print "<I>$data[0]</I></FONT><P>";
                $count=1;
            }
        }
        $smut = 0;
    }
    &footer;
}
[download]

Edit: g0n - readmore tags

Comment on CGI search script: Exclusion list Download Code

Replies are listed 'Best First'.
Re: CGI search script: Exclusion list by Corion (Patriarch) on Mar 25, 2006 at 14:35 UTC
Please do not put this script online. It will allow sending emails with arbitrary content to arbitrary recipients and thus be an open gate to spammers all over the world. The cause for this is that the form parameters are not cleaned or validated in any way and thus `$FORM{email}` can contain newlines which will be passed on to your mailer verbatim. Also, the general code quality of this script is very low, so I'm not sure there aren't other problems with this code. If you are no Perl programmer and want to keep with this script, my best advice is to get somebody who is a Perl programmer to fix this script for you. The better approach is to use the Simple Search engine of the NMS Project. These are especially geared towards simple, stand-alone scripts.	[reply] [d/l]
Re: CGI search script: Exclusion list by timos (Beadle) on Mar 25, 2006 at 10:26 UTC
I don't want to read through all that code right now, but the basic idea for your stop-words is: `$serach = "any foo and bar not frob"; #your search-string open STOP, stopwords.txt; while (<STOP>) { chomp; $search=~/$_//g; } close STOP;` [download] If your stoplist and/or searchstring are so large that this is too slow, ask again for faster solutions.	[reply] [d/l]
Re^2: CGI search script: Exclusion list by graff (Chancellor) on Mar 26, 2006 at 02:07 UTC
This really isn't very good advice. First, you have the procedure the wrong way around: normally, the stopword list is fairly short and is held in memory, while the "search-string" data can be really huge, and is processed a line at a time. But your regex substitution is actually kind of insidious. The deletion of stop words needs to be anchored to word boundaries. If the stop word list included "me or and a", your approach would reduce the word "memoranda" to just "m". In general, the best approach is: store the stop words as hash keys, read the input text and tokenize it into words (being careful to remove punctuation as well as whitespace), then for each word, if it exists as a hash key, skip it.	[reply]