#!/usr/bin/perl print "Content-type: text/html\n\n"; require 5.000; &ReadParse(*input); ### Subroutine ReadParse is part of cgi-lib.pl library ###----------------------------------------------------------------- ########################################################################## ################### Server Customization Variables ####################### ########################################################################## $server_address = 'www.caregivercompanion.com'; $catalog_home = '/'; #virtual path to location of search files (if root must be /) ex1: "/catalog/" ex2: "/" $scriptname ='/sitesearch.pl'; #must include full VIRTUAL path to script on server ex "/cgi-bin/search/sitesearch.pl" $create_search_log = 'no'; $catalog_directory = "/home/caregiver/caregivercompanion.com"; #full REAL path to directory of site (do NOT iunclude a trailing slash) ex "/home/user/whereever.com" $log_directory = $curr_dir . 'log'; #full path to where log for script is to be placed $cgi_prog_location = "$server_address"."$scriptname"; #==== To Add background image or change color =======# $background = ''; ### good1.jpg $image_location = ''; ##Virtual Path to image specified by $background $text_color = "green"; $background_color = "black"; ### white=#FFFFFF $link_color = ""; $vlink_color = ""; $alink_color = ""; #=======# custom images for buttons $button_image{'SEARCH'} = ''; $button_image{'SEARCH CATALOG'} = ''; #====================================================# $body = ""; if ($text_color ne "") { $body .= "text=\"$text_color\" ";} if ($background_color ne "") { $body .= "bgcolor=\"$background_color\" ";} if ($link_color ne "") { $body .= "link=\"$link_color\" ";} if ($vlink_color ne "") { $body .= "vlink=\"$vlink_color\" ";} if ($alink_color ne "") { $body .= "alink=\"$alink_color\" ";} if ($background ne "") { $body .= "background=\"$image_location/$background\" ";} #print "\n"; open htmlfile, "template-10search.htm"; @docu=; close htmlfile; foreach (@docu) { if ($_=~m/doit/) {$_=~s/doit// &dosearch(); } print $_; } exit; #------------------------------------------------------------------# sub dosearch { $action = $input{'ACTION'}; if ($action eq "") {&add_search_screen; #exit; } if (!($action eq "")) { $found = 0; $pattern = $input{'SEARCH STRING'}; if ($pattern eq "") { print "You did not enter a pattern to search for!"; &add_search_screen; #exit; } if (!($pattern eq "")){ if ($input{'REGEXP'} ne 'TRUE') {$pattern = "\Q$pattern\E";} if ($input{'MATCHWORD'} eq 'TRUE') {$pattern = '(^|\b)+' . $pattern . '($|\b)+';} if ($input{'MATCHCASE'} ne 'TRUE') {$pattern = '(?i)' . $pattern;} ### Match pattern only if it is not part of a valid HTML tag, ### ### then Remove all HTML tags from matched line ### $matches = 0; &matchfile($catalog_directory); if ($matches == 0) {print "

The pattern: \"$input{'SEARCH STRING'}\" was Not found!


";} else {print '
';} &add_search_screen; if ($create_search_log eq 'yes') {&create_log("Searches", $input{'SEARCH STRING'}, $matches );} }#edn of if pattern }#end of if action } #end of sub do search #############)_________#_#_#_#__#_#_# sub matchfile { local($_,$file); local(@list); FILE: while (defined ($file = shift(@_))) { if (-d $file) { if (!opendir(DIR, $file)) {next FILE;} @list = (); for (readdir(DIR)) { push(@list, "$file/$_") unless /^\.{1,2}$/; } closedir(DIR); &matchfile(@list); next FILE; } if (-B "$file") ### Don't binary files {next FILE;} #######non standred stuff if ($file=~m/_/) #skip if its a front page crap folder {#print "skiping $file
\n"; next FILE;} if ($file=~m/stats/) ## skip if it is the site stats dir {#print "skiping $file
\n"; next FILE;} if ($file=~m/sitesearch/) ## skip if it is the script {#print "skiping $file
\n"; next FILE;} if ($file=~m/template-10search/) ## skip if it is the template file {#print "skiping $file
\n"; next FILE;} #### end on non standared if (!open(FILE, $file)) {next FILE;} LINE: while () { if ( /((<([^A-Za-z]|[!\/]){1}?[^<]*?)|(^|>)[^<]*?)$pattern/o ) { if ($matches == 0) { #print "
Found!
"; print '
'; } while (m/
/){ s/
/_/;} s{<([A-Za-z]|[!\/]){1}?[^<]*?($|>)}{}gs; ### remove html tags s/$pattern/${SO}$&${SE}/go; ### highlight all matches on line #$filename = substr($file, rindex($file, '/') + 1); my $top=substr($catalog_directory,-5); $filename = substr($file, rindex($file, $top) + 6); while (m/_/){ s/_/
/;} print ""; $matches++; } else {next LINE;} if ($input{'MATCHALL'} ne 'TRUE') {next FILE;} } } continue { } } #------------------------------------------------------------------# sub create_log { my $logfile = shift(@_); my $TotalLockTime = 0; ### open the logfile for exclusive use, use a lock file as a semaphore, $locktitle = "$logfile.lock"; while (-e $locktitle) ### check if lock file is in currently in use, { sleep 1; ### (i.e. wait until lock file does not exist) $TotalLockTime++; if ($TotalLockTime > 20) {unlink $locktitle;last;} ### failsafe mechanism for stray lock files } #print "logfile: $logfile"; #print "
logfile dir $log_directory"; open (LOCKFILE, ">$locktitle"); ### if it doesn't exist, create it, thus locking the logfile exclusively. open(log_file, ">>$log_directory/$logfile") || &err_trap("Cannot open $log_file_name for writing\n"); ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); $mon++; while (defined ($loginfo = shift(@_))) {print(log_file "\"$loginfo\",");} print(log_file "\"$mon/$mday/$year\","); print(log_file "\"$ENV{'REMOTE_ADDR'}\"\n"); close log_file; close LOCKFILE; unlink $locktitle; ### now release the lock on the logfile. } #------------------------------------------------------------------# #------------------------------------------------------------------# sub add_search_screen { print "
\n"; print "Enter a word or phrase to search for in the box below.
"; print "
";
	print "
Search Pattern:   

";
	print '
Match Case?       

';
	print '
Exact Match?      

';
	print "
"; if ($button_image{'SEARCH CATALOG'} eq '') {print ""; print "
"; } else { print ""; print ""; } print ""; ### in case 'enter' pressed istead of submit button print ""; print "
"; #print "\n\n\n


"; } #------------------------------------------------------------------# # Perl Routines to Manipulate CGI input # S.E.Brenner@bioc.cam.ac.uk # $Header: /people/seb1005/http/cgi-bin/RCS/cgi-lib.pl,v 1.2 1994/01/10 15:05:40 seb1005 Exp $ # # Copyright Steven E. Brenner # Unpublished work. # Permission granted to use and modify this library so long as the # copyright above is maintained, modifications are documented, and # credit is given for any use of the library. # ReadParse # Reads in GET or POST data, converts it to unescaped text, and puts # one key=value in each member of the list "@in" # Also creates key/value pairs in %in, using '\0' to separate multiple # selections # If a variable-glob parameter (e.g., *cgi_input) is passed to ReadParse, # information is stored there, rather than in $in, @in, and %in. sub ReadParse { local (*in) = @_; local ($i, $loc, $key, $val); # Read in text if ($ENV{'REQUEST_METHOD'} eq "GET") { $in = $ENV{'QUERY_STRING'}; } elsif ($ENV{'REQUEST_METHOD'} eq "POST") { for ($i = 0; $i < $ENV{'CONTENT_LENGTH'}; $i++) { $in .= getc; } } else { exit; } @in = split(/&/,$in); foreach $i (0 .. $#in) { # Convert plus's to spaces $in[$i] =~ s/\+/ /g; # Convert %XX from hex numbers to alphanumeric $in[$i] =~ s/%(..)/pack("c",hex($1))/ge; # Split into key and value. $loc = index($in[$i],"="); $key = uc substr($in[$i],0,$loc); ### uc function added by E.T. $val = substr($in[$i],$loc+1); $in{$key} .= '\0' if (defined($in{$key})); # \0 is the multiple separator $in{$key} .= $val; } return 1; # just for fun } #------------------------------------------------------------------#
PagePattern
$filename$_