#!/usr/bin/perl
#
# mein 1stes Perl-script:
# schnelle kleine Volltext-Suchmaschine mit optionalem Wort-Index-File
# (gut genug für Sites mit 'n paar hundert Seiten)
# entwickelt unter Windoof mit "Active Perl", getestet unter Linux mit Apache
#
# © Günter Laudenklos 04/2000
# lastchange 02/2002 - "&start=nn" and "&range=nn" parms added
# http://www.purpurhain.de/
# mailto guenter@laudenklos.de
#

$baseurl = 'http://enius.de/';                       # Deine home-URL (nur für Referenzierung bei der Suchausgabe)
$basedir = '../';                                            # relative Homepage Directory (zurück von cgi-bin)
$parmfile = 'sdata/parmfile_.txt';                           # parmfile "_" char wird mit "opt=xx" Wert ersetzt.

# ab hier muß normalerweise nichts mehr geändert werden,
# aber falls Du wissen willst was hier noch abgeht ... kannste mal nachlesen ...

$Mode = 0;                                                   # real Production Mode - muss für WEBuse 0 sein
if($^O =~ /MSWin32/o && !$ENV{'REMOTE_ADDR'})                # der switch ist nur für meine Entwicklungsumgebung
{                                                            # ich habe ihn dringelassen, falls jemand selbst unter Windoof (ohne CGI!) rumspielen will
	$Mode = 1;                                               # lokaler test								
    $baseurl = 'E:/users/testusr/html/purpur/';     	    # lokale home-dir
    $hfile = 'sdata/output.html';                            # HTML output - Test mode only
	#@parms = ('search=werbung "coca cola"');              	 # nonCGI testparms
    @parms = ('mode=update','password=','passnew=bimbesbirne');
}

($lockshr,$lockexc,$locktst,$lockrel) = (1,2,4,8);           # Konstanten fuer flock()
&get_parms;                                                  # Liest & interpretiert die übergebenen Parameter
&get_template;                                               # Liest das Ausgabe template(=Muster)-File
if ($FORM{'search'})                                         # Suchst Du jetzt (z.Bsp.) "Ärger"?
{
    &get_files;                                              # Dann les' mal die Files, bzw. das Volltext-Index File
    &search;                                                 # & seh' mal nach
    &header;                                                 # & lass' Dir sagen,
    &result;                                                 # ob Du welchen gefunden hast ... hmmm ...
}
else
{
    &header;                                                 # Ohne Suchbegriff
    &prompt;                                                 # gibt's nur ein leeres Eingabe Feld
    &tipps;                                                  # mit Suchtipps für Wissbegierige ...
}
&trailer;                                                    # Und das 
close $HTML;                                                 # war's denn schon ...
exit 0;                                                      # 	...    isch habbe fertigg!!!

#
# Nun kommen nur noch die "kleinen" Unterroutinen ...
# Und (fast) der ganze Rest der spärlichen Kommentare ist in
# meinem "programmers-bad-pidgin-english-style" gehalten  ;-)
# (fällt mir nach über 25 Jahren DV-Docus-lesen/schreiben leichter beim "kommentieren")
#

sub get_parms
{

	if($Mode)
	{
		$HTML = 'HTML';
		open($HTML,">$basedir$hfile");
	}
	else
	{
		$HTML = 'STDOUT';
		open($HTML);

		if($ENV{'REQUEST_METHOD'} eq "GET")				# entspricht ?Text=Hallo+dies+ist+ein+Test&Zeichen=%25
		{ $buffer = $ENV{'QUERY_STRING'}; } 
		else
		{ read(STDIN,$buffer,$ENV{'CONTENT_LENGTH'}); }	# input via forms

		$buffer =~ tr/+/ /;
		@parms = split(/&/,$buffer);
		$Mode = (substr($ENV{'SERVER_ADDR'},0,3) eq '127') ? 1 : 0;
	}

	foreach $parm (@parms)
	{
		$parm =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;		# replace %xx characters with ASCII
		$parm =~ s/([\&;\`'\\\|"*?~<>^\(\)\[\]\{\}\$\n\r])/\\$1/g;		# mask unwanted special characters =phrack.com-55 recommandation
																		# refer to http://www.phrack.com/search.phtml?view&article=p55-7
		($name,$value) = split(/=/,$parm);								# initial parsing routine
		$name = lc($name);												# lowercase all names
		$FORM{$name} = $value;
	}

	foreach $name ('mode','opt','password','passnew')
	{ $FORM{$name} =~ s/\s+//g if($FORM{$name}); }						# remove all blanks

	$option = $FORM{'opt'};												# save option
	$dbmode = substr(lc($FORM{'mode'}).'r',0,1);						# take 1st char of mode-param only
	$parmfile =~ s/_/$option/o;
	&bad_base unless (-e $basedir);
	chdir($basedir);													# point to BaseDir

	open(PARMS,"$parmfile") or die(&bad_opt);							# read parmfile
	flock(PARMS,$lockshr) unless($Mode);
	@LINES = <PARMS>;
	flock(PARMS,$lockrel) unless($Mode);
	close(PARMS);
	
	foreach $string (@LINES)											# common  parsing routine
	{
		@parms = split(/#/,$string);									# remove comment chars
		$parms[0] =~ s/\s+//g;											# remove all blanks
		if($parms[0])													# anything left?
		{
			($name,@value) = split(/=/,$parms[0]);
			$name = lc($name);											# lowercase all names
			$suffix = substr($name,0,1);								# xtract name-suffix
			if($suffix eq 'w')											# num-style keywords
			{
				$value[0] =~ s/\D//g;									# remove all chars except 0-9
				$value[0] = 1*$value[0];								# get realvalue
				next if(!$value[0] || $value[0] < 1 || $value[0] > 9);
			}
			if($FORM{$name} && ($suffix eq 'f' || $suffix eq 'x')) { $FORM{$name} .= ",$value[0]"; }
			else { $FORM{$name} = $value[0]; }
		}
	}

	$nfile = $FORM{'nfile'};													# allnames
	$ofile = $FORM{'ofile'};													# output template
	$sfile = $FORM{'sfile'};													# summary file (=audit)
	$dfile = $FORM{'dfile'};													# alldata word-index file
	$dpassw = $FORM{'dpassw'};													# stored password for dfile
	$passwd = reverse(crypt("$FORM{'password'}",'GL')) if($FORM{'password'});	# current password
	$npassw = reverse(crypt("$FORM{'passnew'}",'GL')) if($FORM{'passnew'});		# new password
	$wname = ($FORM{'wname'}) ? $FORM{'wname'} : 2;								# filenames ranking value
	$wtitle = ($FORM{'wtitle'}) ? $FORM{'wtitle'} : 3;							# titles ranking value
	$wkeyword = ($FORM{'wkeyword'}) ? $FORM{'wkeyword'} : 4;					# keywords ranking value
	$wdescription = ($FORM{'wdescription'}) ? $FORM{'wdescription'} : 2;		# descriptions ranking value
	$keepit .= $FORM{'keep'};													# keep alt & title strings ?

	if($dbmode ne 'u')
	{
		$listfrdoc = &set_numval($FORM{'start'},0);								# start at page n
		$listrange = &set_numval($FORM{'range'},99999999);						# list n pages/search-request
		$listrange = 1 unless($listrange);										# must be > 0
	}

	if($npassw)															# new password specified ?
	{
		&illegal_pw if($dpassw ne $passwd);								# then validate old password

		foreach $string (@LINES)
		{ $string =~ s/dpassw=$dpassw/dpassw=$npassw/igo; }				# & store new password

		open(PARMS,">$parmfile") or die(&bad_chmod("$parmfile"));		# rewrite parmfile
		flock(PARMS,$lockexc) unless($Mode);
		print PARMS @LINES;
		flock(PARMS,$lockrel) unless($Mode);
		close(PARMS);
	}

	if($dbmode eq 'u')													
	{
		&illegal_pw if($dpassw ne $passwd);								# validate password for dfile creation
		$FORM{'search'} = '\*';											# simulate search over all files	
	}
}


sub set_numval
{
	my($value,$defval) = (shift,shift);
	$value =~ s/\D//go;
	$value = ($value ne '') ? 1*$value : $defval;
	return $value;
}


sub get_template
{
	open(TEMPLATE,"$ofile") or die(&bad_chmod("$ofile"));
	 {
		local $/ = undef;
		$string = <TEMPLATE>;
	}
	close(TEMPLATE);
	
	$string =~ s/<!--<(.*?)>-->/\x01/sgo;

	($_,$header,$prompt1,$prompt2,$tipps,$forms1,$forms2,$trailer,$match,$nomatch) = split(/\x01/,$string);

	$form_hidden = '<input type=hidden name="opt" value="'.$option.'">';	# save option-value for reuse
}


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


sub prompt
{
	print $HTML $prompt1;
	print $HTML $form_hidden;
	print $HTML $prompt2;
}


sub tipps
{
	print $HTML $tipps;
}


sub trailer
{
	print $HTML $trailer;
}


sub get_files
{
	if($dbmode eq 'r')
	{
		$nfile = $dfile;									# get data from full-indexed dbfile
	}
	else													# full-indexed dbfile creation ?
	{
		($string = $FORM{'xtextp'}) =~ s/'//go;
		@xtextp = &setvars('x',split(/,/,$string));			# parse defined xtextp defs
	}

	if($nfile)
	{
		open(ALLNAMES,"$nfile") or die(&bad_chmod("$nfile"));
		flock(ALLNAMES,$lockshr) unless($Mode);
		if($dbmode eq 'r')
		{
			{
				local $/ = undef;
				$string = <ALLNAMES>;						# slurp in!
			}
			($string,@FILES) = split(/\x01\x02/,$string);
		}
		else
		{
			@LINES = <ALLNAMES>;
			foreach $string (@LINES)						# namefiles parsing routine
			{
				$string =~ s/^\s+//go;						# remove prefixing blanks
				@parms = split(/^#/,$string);				# & ignore comments
				$parms[0] =~ s/\s+/ /go;					# & compress
				$parms[0] =~ s/ $//go;						# & remove trailing blanks
				push(@FILES,$parms[0]) if($parms[0]);		# anything left?
			}
		}
		flock(ALLNAMES,$lockrel) unless($Mode);
		close(ALLNAMES);
		return;
	}

	$dbmode =~ tr/r/f/;										# switch dbmode
	($string = $FORM{'finc'}) =~ s/'//go;
	@include = &setvars('f',split(/,/,$string));			# parse defined finc defs
	($string = $FORM{'fexc'}) =~ s/'//go;
	@exclude = &setvars('f',split(/,/,$string));			# parse defined fexc defs
	($string = $FORM{'fjoin'}) =~ s/'//go;
	@joins = split(/,/,$string);							# take defined fjoin defs
	
	my($dlevel,@dlevel);
	&getnames('');											# retrieve all matching dir_s & file_s
	foreach $subdir (@SUBDIRS)								# doit in this way, cause my WIN98 doesn't know "LS"
	{
		@dlevel = split('/',$subdir);
		foreach $dlevel (@dlevel)							# do chdir step by step (otherwise MSWIN is a stupid-liar)
		{ chdir("$dlevel") or die "invalid chdir ".$subdir."\n"; }

		&getnames($subdir.'/');								# retrieve all matching dir_s & file_s

		foreach $dlevel (@dlevel)							# return to basedir level (reasons see above)
		{ chdir('../'); } 
	}
	@SUBDIRS = (sort @SUBDIRS) if(@SUBDIRS);				# sort directories by name
	@FILES = (sort @FILES) if(@FILES);						# sort files by name
}


sub setvars
{
	my $type = shift;
	my(@setvars,@cnt,$tmp);

	foreach $tmp (@_)
	{
		if($tmp)
		{
			if($type eq 'f')
			{
				@cnt = split('/',$tmp.' ');					# count defined "/" = subdir-levels
				$tmp = @cnt.',°'.$tmp.'°';
			}
			$tmp =~ s/\$/\\\$/go;							# convert "$" to "\$"
			$tmp =~ s/\./\\./go;							# convert "." to "\."
			$tmp =~ s/\?/\.{1}/go;							# convert "?" to ".{1}"
			$tmp =~ s/\*/\.\*\?/go;							# convert "*" to ".*?"
			push(@setvars,$tmp);
		}
	}
	return (@setvars);
}


sub getnames
{
	my($cpath,$entry,$rc) = (shift,'',0);

	opendir(DIR,'.');										# open current directory

	while ($entry = readdir DIR)
	{
		next if($entry =~ /^\./);

		if(-d "$entry")										# & filter subdir names
		{
			$entry = $cpath.$entry;
			$rc = &match('d',0,1,'°'.$entry.'/°',@include);
			$rc = &match('d',1,0,'°'.$entry.'/°',@exclude) unless ($rc);
			push(@SUBDIRS,$entry) unless ($rc);
			next;
		}

		$entry = $cpath.$entry;								# & filter file names
		$rc = &match('f',0,1,'°'.$entry.'°',@include);
		$rc = &match('f',1,0,'°'.$entry.'°',@exclude) unless ($rc);		
		push(@FILES,$entry) unless ($rc);
	}
	closedir DIR;
}


sub match
{
	my($type,$rc0,$rc1,$entry,,$cnt2,$matchs) = (shift,shift,shift,shift,0,'');
	my @cnt = split('/',$entry);
	my $cnt = @cnt;
	foreach $_ (@_)											# power filter :)
	{
		($cnt2,$matchs) = split(',',$_,2);

		if($type eq 'd' && $rc1)
		{
			$matchs = substr($matchs,0,rindex('/'.$matchs,'/')).'°';
		}

		return $rc0 if($entry =~ /$matchs/i && $cnt == $cnt2 );
	}
	return $rc1;
}


sub joinmatch
{
	my($fjoin,$file,@files);

	foreach $fjoin (@joins)										# search for joinfile match
	{
		($file,@files) = split(/\+/,$fjoin);
		if($FILE eq $file)
		{
			($FILE = $fjoin) =~ tr/\+/ /;
			last;
		}
	}
}


sub search
{
	%conva = ('&Auml;'=>'Ä','&Ouml;'=>'Ö','&Uuml;'=>'Ü','&auml;'=>'ä','&ouml;'=>'ö','&uuml;'=>'ü','&szlig;'=>'ß');
	%convb = ('Ä'=>'&Auml;','Ö'=>'&Ouml;','Ü'=>'&Uuml;','ä'=>'&auml;','ö'=>'&ouml;','ü'=>'&uuml;','ß'=>'&szlig;','"'=>'&quot;');
	%convc = ('Ä'=>'Ae','Ö'=>'Oe','Ü'=>'Ue','ä'=>'ae','ö'=>'oe','ü'=>'ue','ß'=>'ss');
	%convd = ('Ae'=>'Ä','Oe'=>'Ö','Ue'=>'Ü','ae'=>'ä','oe'=>'ö','ue'=>'ü','ss'=>'ß');

	&setup_search unless($dbmode eq 'u');					# parse & setup search strings
	
	my @usedFILES = () if($dbmode eq 'u');

	GET_FILE: foreach $FILE (@FILES)
	{
		if($dbmode eq 'r') 									# read existing full-index file
		{ ($FILE,$title,$description,$keywords,$stringa,$string) = split(/\x01/,$FILE); }
		else
		{
			my $rc = &get_filedata;							# read files & do the full-index-job again & again & ...
			next unless($rc);								# 0 = robots-noindex, 1 = index,

			if($dbmode eq 'u')
			{
				push (@usedFILES,$FILE);
				($string = "\x01\x02$FILE\x01$title\x01$description\x01$keywords\x01$stringa\x01$string\x01") =~ s/\s+/ /go;
				push(@ALLDATA,"$string\n");					# build up dbase string
				next;
			}
		}

		$dbstring = $string;								# save pure word-part
		$string .= " $title" x $wtitle;						# and add titles, description etc..
		$string .= " $description" x $wdescription;			# 	  due to their ranking weight-factors
		$string .= " $keywords" x $wkeyword;
		$string .= " $FILE" x $wname;
		$string = "\x01 ".$string.$stringa." \x01";			# add junk to prevent an 1match search-split

		($stringx = $string) =~ tr/'\"\&,:;-!()\[\]\*\?\+\./ /;	# blank some unwanted chars
		($stringlc = $stringx) =~ tr/[A-Z]ÄÖÜ/[a-z]äöü/;		# convert to lowercase
		($title{$FILE},$description{$FILE},$keywords{$FILE},$weight{$FILE}) = ($title,$description,$keywords,0);

		# 1st step: check for optional terms:
		if(@optional)
		{
			foreach $search (@optional)
			{
				$weight{$FILE} += &search_term($search);
			}
			next unless ($weight{$FILE});
		}

		# 2nd step: check for required terms:
		if(@required)
		{
			foreach $search (@required)
			{
				$word_count = &search_term($search);
				next GET_FILE unless($word_count);
				$weight{$FILE} += $word_count;
			}
		}

		# 3rd step: check for forbidden terms:
		if(@forbidden)
		{
			foreach $search (@forbidden)
			{
				next GET_FILE if(&search_term($search));
			}
		}

		$hitcount++;

		$w100 = $weight{$FILE} if($weight{$FILE} > $w100);
		$wf00 = $weight{$FILE} if($weight{$FILE} > $wf00);

		$key = sprintf("%.3f",($weight{$FILE}/1000)).(99999999 - $hitcount);
		$Match{"$key"} = "$FILE";

		@words = split(/\s+/,$dbstring);
		for($i=0;$i<40;$i++)
		{ $twords{$FILE} .= " $words[$i]"; }
		$twords{$FILE} .= "...";
	}
	
	@FILES = @usedFILES if($dbmode eq 'u');
}


sub setup_search
{
	$string = &convert($FORM{'search'});
	$string =~ s/\\\(/\(/go;
	$string =~ s/\\\)/\)/go;
	$string =~ s/\\\~/\~/go;
	@terms = split(/\\\"/,$string);

	$string = '';
	my($toggle,$matchm) = (0,0);

	foreach $term (@terms)
	{
		$toggle = ($toggle) ? 0 : 1;
		$term =~ tr/ \*\?\+-/\x01\x02\x03\x04\x05/ unless $toggle;
		$string .= $term;
	}
	# blank reserved ~char, convert multiple blank spaces to single spaces:
	$string =~ s/\s+/ /go;
	$string = " $string ";

	# correct GET-passed wildcards
	$string =~ s/\\\*/\*/oig;

	# convert NOT statements to minus signs:
	$string =~ s/ not |- |-/ -/oig;

	# convert AND statements to plus signs:
	$string =~ s/ and |\+ |\+/ \+/oig;

	# strip OR statements (OR is the default):
	$string =~ s/ or / /oig;

	@search = split(/ /,$string);
	$x01 = "\\\x01";										# lateron translated as \W
	foreach $search (@search)
	{
		next if($search eq '');								# skip null entries (first and last)

		if($search =~ /^~|^\+~|^-~/)						# search for ~near terms
		{
			$matchm = 1;
			$search =~ s/~//o;
		}
		else { $matchm = 0; }

		$search =~ tr/\x01\x02\x03\x04\x05/ \*\?\+-/;		# retranslate grouped terms

		if ($search =~ /^\+/)
		{
			$search =~ s/\+//o;
			$search = $x01 . $search. $x01 unless ($search =~/\?|\*/);
			$search = &testnear($search) if($matchm);
			push(@required0,$search);
			push(@required,&addlc_search($search));
		}
		elsif ($search =~ /^-/)
		{
			$search =~ s/-//o;
			$search = $x01 . $search. $x01 unless ($search =~/\?|\*/);
			$search = &testnear($search) if($matchm);
			push(@forbidden0,$search);
			push(@forbidden,&addlc_search($search));
		}
		else
		{
			$search = $x01 . $search. $x01 unless ($search =~/\?|\*/);
			$search = &testnear($search) if($matchm);
			push(@optional0,$search);
			push(@optional,&addlc_search($search));
		}
	}

	$w100 = $wname + $wtitle + $wkeyword + $wdescription;	# this is the default 100% weight-value
	($wf00,$hitcount) = (0,0);
}


sub addlc_search
{
	$search =~ tr/'\"\&,:;-!()\[\]\+\./ /;				# blank some unwanted chars
	if($search =~ /\?|\*/)								# set blank delimiters for wildcard-search
	{
		$search = ' '.$search unless (substr($search,0,1) =~ /\*| /);
		$search = $search.' ' unless (substr(reverse($search),0,1) =~ /\*| /);
	}
	$search =~ s/\?/\.{1}/go;							# convert "?" to ".{1}"
	$search =~ s/\*/\(\.\*\?\)/go;						# convert "*" to "(.*?)"
	$search =~ s/\$/\\\$/go;							# convert "$" to "\$"
	($lowercase = $search) =~ tr/[A-Z]ÄÖÜ\x01/[a-z]äöüW/;
	$search =~ tr/\x01/W/;
	$search .= "\x01".$lowercase;
}


sub search_term
{
	my($search,$lowercase) = split(/\x01/,shift);

	@search = split(/~/,$search);
	@lowercase = split(/~/,$lowercase);

 	if($search[0] eq '(.*?)')							# unspecific "*" ?
	{ return 1; }

	for($i=0; $i<@search; $i++)
	{
		@_ = ($search[$i] eq $lowercase[$i]) ? split(/$search[$i]/,$stringlc) : split(/$search[$i]/,$stringx);
		$_ = @_ -1;
		return $_ if($_);
	}
	return 0;
}


sub get_filedata
{
	($title,$description,$keywords,$string,$string2,$stringa) = ('','','',' ',' ',' ');

	&joinmatch if(!$nfile && @joins);					# no nfile & join definitions found ?
	($FILE, @files) = split(/ /,$FILE);
	push(@joins,$FILE.'+'.join('+',@files)) if($nfile && @files);

	foreach $file (@files)
	{
		if(stat($file))
		{
			open(FILE,"$file");
			@LINES = <FILE>;
			close(FILE);
			$string2 .= &remove_trash(join(' ',@LINES));	# remove unwanted data-trash
			$string2 =~ s/<([^>]|\n)*>//go;					# remove rest of the "Fest"
		}
	}

	return 0 unless stat($FILE);

 	open(FILE,"$FILE");
	@LINES = <FILE>;
	close(FILE);
	$string .= &remove_trash(join(' ',@LINES));			# remove unwanted data-trash

	# xtract the robots-order, if there is one:
	if($string =~ /<meta\s+name="robots"\s+content="(.*)>/i)
	{
		@cut = split(/\">/,$1);
		return 0 if($cut[0] =~ /noindex/i);
	}

	$string .= ' <BODYdummy> '.$string2;				# add pseudo <BODY..> Tag
	$string =~ tr/\x01\x02/ /;							# remove any for internal-use-only chars
	$string = &convert($string);
	$string =~ s/&nbsp;/ /go;
	$string =~ s/<br>/ /go;
	$string .= " \x01 ";								# set internal end-delim
	
	# xtract the title, if there is one:
	if($string =~ /<title>(.*)<\/title>/i)
	{
		$title = $1;
	}
	$title = $FILE unless $title;
	
	# xtract the description, if there is one:
	if($string =~ /<meta\s+name="description"\s+content="(.*)>/i)
	{
		@cut = split(/\">/,$1);
		$description = $cut[0];
	}
	$description = $title unless $description;

	# xtract the keywords, if they exist:
	if($string =~ /<meta\s+name="keywords"\s+content="(.*)>/i)
	{
		@cut = split(/\">/,$1);
		$cut[0] =~ tr/,/ /;
		$cut[0] =~ s/\s+/ /go;
		$keywords = $cut[0];
	}
	$keywords = $FILE unless $keywords;

	$stringa = &convert($stringa);			# these are the xtracted alt/title contents
	$stringa =~ s/&nbsp;/ /go;
	$stringa =~ s/\s+/ /go;

	$string =~ s/<BODY/\x01<body/oi;		# set start marker (one body-tag always requested)
	$string =~ s/<([^>]|\n)*>//go;			# remove rest of the "Fest"
	$string =~ s/\s+/ /go;					# compress multiple blanks
	$string =~ s/&quot;/\"/go;				# save space & convert doublequotes
	@cut = split(/\x01/,$string);			# xtract used string text
	$string = $cut[1];						# looks fulltext-index alike
}


sub remove_trash
{
	my($xtextp,$xtanf,$xtend,$itag);
	($_ = shift) =~ s/[\n\t]/ /go;

	if(@xtextp)
	{	
		foreach $xtextp (@xtextp)			# parse defined xtextp defs & remove ignorable string definitions
		{
			($xtanf,$xtend) = split(/\.\*\?/,$xtextp);

       		$_ =~ s { $xtanf				# Match the opening delimiter.
       				  .*?					# Match a minimal number of characters.
       				  $xtend				# Match the closing delimiter.
    				} []igsx;				# doit case insensitive
		}
	}

	if($keepit)								# keep for alt & title defined ?
	{
		while($_ =~ /<[^>]+?\s+(?:alt|title)=\"(.*?)\"[^>]*>/igo) { $stringa .= "$1 " if($1); }
	}

	return $_;
}


sub result
{
	if($dbmode eq 'u')						# create/replace fullindex datafile, locking done
	{
		open(ALLDATA,">$dfile") or die(&bad_chmod("$dfile"));
		flock(ALLNAMES,$lockexc) unless($Mode);
		print ALLDATA @ALLDATA;
		flock(ALLNAMES,$lockrel) unless($Mode);
		close(ALLDATA);

		# list index summary for the webmaster
		print $HTML '<h3>Das Index-File <tt><big>'.$dfile.'</big></tt> wurde erstellt &nbsp;&nbsp;<small>- Size '.sprintf("%.2f",length(join('',@ALLDATA))/1024).'KB</small>.</h3>Folgende Files sind erfasst:<br><br><blockquote><ol>';
		foreach $subdir (@SUBDIRS)			# list matching subdirs
		{
			print $HTML "\n<li>Dir=$subdir<br>";
		}
		print $HTML "\n</ol><br><ol>";
		foreach $FILE (@FILES)				# list matching filenames
		{
			&joinmatch;
			print $HTML "\n<li>File=$FILE<br>";
		}
		print $HTML "\n</ol></blockquote><br>\n";
	}
	else
	{
		# create a summary for the webmaster (=auditfile) and the visitor
		if($hitcount > 1)
			{ $string = "$hitcount Dokumente"; }
		elsif ($hitcount == 1)
			{ $string = "Ein Dokument"; }
		else
			{ $string = "Keine Dokumente"; }
	
		$summary = "<h3>Suchergebnis: $string gefunden</h3><blockquote>\n<pre>";
		$summary .= &set_summary("\n Optionale Begriffe:  ",@optional0) if(@optional0);
		$summary .= &set_summary("\nGeforderte Begriffe:  ",@required0) if(@required0);
		$summary .= &set_summary("\n Verbotene Begriffe:  ",@forbidden0) if(@forbidden0);
		$summary .= "\n</pre></blockquote>\n";
	
		&search_stat if($sfile);						# give webmaster an audit-file (optional)
	
		print $HTML "$summary\n";						# proudly presents: the results for the visitor:
	
		if ($hitcount > 0)
		{
			if($hitcount>$listrange)
			{
				$cpage = 1*sprintf("%d",(1+$listfrdoc/$listrange));
				$lpage = 1*sprintf("%d",(1+$hitcount/$listrange));
				$lpage -- if($hitcount==($lpage-1)*$listrange);		
				print $HTML  "<br><small>Ergebnis-Seite:</small> <b>$cpage</b> <small>von</small> <b>$lpage</b><br>\n";
			}

			print $HTML '<ol start='.(1+$listfrdoc).">\n";

			$ranking = '';
			$w100 = $wf00 if($w100 > $wf00);
			$match =~ tr/\$/\x01/;
			$cix = 0;
			foreach $key (reverse sort keys %Match)
			{
				if($cix >= $listfrdoc && $cix < $listfrdoc+$listrange)
				{
					$FILE = $Match{$key};
					$title = &reconvert($title{$FILE});
					$description = &reconvert($description{$FILE});
					$keywords = &reconvert($keywords{$FILE});
					$textwords = &reconvert($twords{$FILE});
					$ranking = sprintf("%.2f",((100000*substr($key,0,5))/$w100)).'%' if($w100);
					($string = $match) =~ s/\x01file/$FILE/ig;
					$string =~ s/\x01basedir/$basedir/ig;
					$string =~ s/\x01baseurl/$baseurl/ig;
					$string =~ s/\x01title/$title/ig;
					$string =~ s/\x01description/$description/ig;
					$string =~ s/\x01keywords/$keywords/ig;
					$string =~ s/\x01ranking/$ranking/ig;
					$string =~ s/\x01textwords/$textwords/ig;
					$string =~ tr/\x01/\$/;
					print $HTML '<br><li>'.$string.'<br>';
				}
				$cix++;
			}
			print $HTML "\n</ol>";
			print $HTML &set_pagelinks if($hitcount>$listrange);
		}
		else
		{
			print $HTML "<ol>\n$nomatch";
			&tipps;
		}
	}
	print $HTML $forms1;
	print $HTML $form_hidden;
	print $HTML $forms2;
}


sub set_pagelinks
{
	my $string = "\n<br><br><small>Ergebnis-Seiten:</small> &nbsp;";
	my $href = 'http://'.$ENV{'SERVER_NAME'}.$ENV{'SCRIPT_NAME'}.'?opt='.&reset_form($FORM{'opt'}).'&search='.&reset_form($FORM{'search'});

	$string .= '<a href="'.$href.'&start='.(($cpage-2)*$listrange).'"><big>&#171;Zur&uuml;ck</big></a> &nbsp;' if($cpage>1);

	for($i=1;$i<$lpage+1;$i++)
	{
		$string .= ($i==$cpage) ? '<b>'.$cpage.'</b>&nbsp;&nbsp;' : '<a href="'.$href.'&start='.(($i-1)*$listrange).'">'.$i.'</a> &nbsp;';
	}

	$string .= '<a href="'.$href.'&start='.($cpage*$listrange).'"><big>Vorw&auml;rts&#187;</big></a>' if($cpage<$lpage);

	return "$string<br>\n";
}


sub reset_form
{
	my $form = shift;

	$form =~ s/\\([\&;\`'\\\|"*?~<>^\(\)\[\]\{\}\$\n\r])/$1/g;
	$form =~ s/([^a-zA-Z0-9-_\s]|\n)/uc sprintf("%%%02x",ord($1))/eg;
	$form =~ tr/ /+/;

	return $form;
}


sub set_summary
{
	($string,$i) = (shift,0);
	foreach $_ (@_)
	{
		$i++;
		$_ =~ s/ /&nbsp;/go;
		$_ = &reconvert($_);
		$_ = "<i>$_</i>" unless ($_ =~ /^\\\x01/);
		$_ =~ s/\\\x01//go;
		$string .= "$_";
		$string .= ", " unless ($i == @_);
	}
	return $string;
}


sub convert
{
	$_ = shift;
	$_ =~ s/(&((A|O|U|a|o|u)uml|szlig);)/$conva{$1}/go;
	return $_;
}


sub reconvert
{
	$_ = shift;	
	$_ =~ s/(Ä|Ö|Ü|ä|ö|ü|ß|\")/$convb{$1}/go;
	$_ =~ s/^\s+//go;

	return $_;
}


sub testnear
{
	$_ = shift;
	my($search,$search2,$search3) = ($_,$_,$_);

	$search2 =~ s/(Ä|Ö|Ü|ä|ö|ü|ß)/$convc{$1}/go;
	$search3 =~ s/(Ae|Oe|Ue|ae|oe|ue|ss)/$convd{$1}/go;

	$_ .= "~".$search2 if($search ne $search2);
	$_ .= "~".$search3 if($search ne $search3);

	return $_;
}


sub search_stat
{	
	my($datum,$zeit,$sstring);
	my($sek,$minute,$stunde,$tag,$monat,$jahr,$wtag,$ytag,$isdst) = localtime(time);

	$monat++;
	$jahr = $jahr + 1900 if($jahr < 1900);
	$tag = '0'.$tag if($tag<10);
	$monat = '0'.$monat if($monat<10);
	$stunde = ($stunde<10) ? '0'.$stunde.':' : $stunde.':'; 
	$minute = ($minute<10) ? '0'.$minute.':' :  $minute.':';
	$sek = '0'.$sek if($sek < 10);

	$datum = "$tag.$monat.$jahr";
	$zeit = $tag.'.'.$monat.'.'.$jahr.' - ';
	($string = $summary) =~ s'<h3>|</h3>'<br>'igo;
	$string = "aufgerufen am ".$zeit.$stunde.$minute.$sek." von HOST=".$ENV{'REMOTE_HOST'}." Referrer=".$ENV{'HTTP_REFERER'}." REMOTE-User=".$ENV{'REMOTE_USER'}." HTTP-User-Agent=".$ENV{'HTTP_USER_AGENT'}." Server-Name=".$ENV{'SERVER_NAME'}." Remote-Address=".$ENV{'REMOTE_ADDR'}.$string;

	open(STATS,">>$sfile") or die(&bad_chmod("$sfile"));	# give webmaster a STATS-stats file
	flock(STATS,$lockexc) unless($Mode);
	print STATS "\n$0 $string<br>\n";
	flock(STATS,$lockrel) unless($Mode);
	close(STATS);
}


sub bad_base
{
	print "Content-type: text/html\n\n";
	print "<body><h1 align=center>Fehlende oder unfg&uuml;ltige BaseDir Definition</h2>\n";
	print "<blockquote>BASEDIR=<pre>$basedir</pre></blockquote>\n";
	print "wurde nicht im System gefunden. <b>:((</b></body></html>\n";
	exit;
}


sub bad_opt
{
	print "Content-type: text/html\n\n";
	print "<body><h1 align=center>Fehlender oder ung&uuml;ltiger OPT Parameter .</h1>\n";
	print "<blockquote>OPT=<pre>$FORM{'opt'}</pre></blockquote></body></html>\n";
	exit;
}


sub bad_chmod
{
	$_ = shift;
	print "Content-type: text/html\n\n";
	print "<body><h1 align=center>Fehlende Datei oder falsche Authorisierung (CHMOD not 666).</h1>\n";
	print "<blockquote>FILE=<pre>$_</pre></blockquote></body></html>\n";
	exit;
}


sub illegal_pw
{
	print "Content-type: text/html\n\n";		# password validation failed :(((
	print "<body><h1 align=center>Du B&ouml;sewicht, das darfst Du nicht!</h1></body></html>\n";
	exit;
}