&parse_form;
print "Content-Type: text/html\n\n";
if ( !open( FL, $page_model ) ) { print "Couldn't open page model\n"; exit(1); }
read FL, $model, -s $page_model;
close FL;
( $model_top, $model_bot ) = split /#####/, $model;
$extra = '';
$title = '';
@words = ();
if ( exists $form{'words'} ) {
$search_words = $form{'words'};
if ( $form{'wt'} eq 'be' ) { $search_wb = ' checked'; $search_ew = ''; }
else { $search_wb = ''; $search_ew = ' checked'; }
if ( $form{'bl'} eq 'an' ) {
$search_bAND = ' checked';
$search_bOR = '';
$search_bPHR = '';
}
elsif ( $form{'bl'} eq 'ph' ) {
$search_bAND = '';
$search_bOR = '';
$search_bPHR = ' checked';
}
else { $search_bAND = ''; $search_bOR = ' checked'; $search_bPHR = ''; }
$wl = lc $search_words;
$wl =~ tr/a-z0-9/ /c;
$wl =~ s/(\A\s+)|(\s+\Z)//g;
@words = split /\s+/, $wl;
if ( $wl eq '' || $#words < 0 ) {
$extra =
"Please enter some words in the search box.
";
@words = ();
}
else {
$title = join ' ', 'Search results for', @words;
}
$search_q = $ENV{'QUERY_STRING'};
$search_q =~ s/\&pg=\d+//;
}
else {
$search_words = '';
$search_wb = ' checked';
$search_ew = '';
$search_bAND = '';
$search_bOR = ' checked';
$search_bPHR = '';
}
if ( $title ne '' ) {
$model_top =~ s~
(.+?)~$title~si;
}
print $model_top;
if ( $#words >= 0 ) {
%pages = ();
$go = 1;
for ( $word = 0 ; $word <= $#words && $go ; $word++ ) {
( $i, $gs ) = split //, $words[$word], 3;
$g = $grains[ ord($gs) ];
if ( open( FL, "$index_loc/$i.$g" ) ) {
$found = 0;
$pat = "\\A$words[$word]";
if ( $search_wb eq '' ) {
$pat .= '\\s';
}
%pages2 = ();
while () {
if (m/$pat/) {
$found = 1;
( $wd, $pg ) = split / /, $_, 2;
@vp = split /#/, $pg;
$mul = ( $#words + 1 ) - $word;
if ( $word > 0 && $search_bOR eq '' ) {
for (@vp) {
/\A(.+):(\d+?)\Z/;
if ( exists $pages{"I$1"} ) {
$pages2{"I$1"} = $pages{"I$1"} * ( $2 * $mul );
}
}
}
else {
for (@vp) {
/\A(.+):(\d+?)\Z/;
if ( exists $pages{"I$1"} ) {
$pages{"I$1"} *= ( $2 * $mul );
}
else {
$pages{"I$1"} = ( $2 * $mul );
}
}
}
}
}
if ( $word > 0 && $search_bOR eq '' ) {
%pages = %pages2;
%pages2 = ();
}
close FL;
}
else {
if ( $search_bAND ne '' || $search_bPHR ne '' ) {
$pages = ();
$go = 0;
}
}
}
if ( $search_bPHR ne '' && $#words > 0 ) {
if ( $search_wb ne '' ) {
$pat = '\b' . join( '\w*?\s+', @words );
}
else {
$pat = '\b' . join( '\s+', @words ) . '\b';
}
@ps = keys %pages;
for $pg (@ps) {
if ( $pg =~ m/I(.+)/ ) {
if ( open FL, "$docroot_disc/$1" ) {
read FL, $pt, -s "$docroot_disc/$1";
close FL;
$pt =~ s/<.+?>//gs;
if ( !( $pt =~ m/$pat/gis ) ) {
delete $pages{$pg};
}
}
else {
delete $pages{$pg};
}
}
}
}
@pages = sort { $pages{$b} <=> $pages{$a} } keys %pages;
$found = $#pages + 1;
$page_begin = 0;
$this_page = 0;
if ( $res_per_page != -1 ) {
$end = ( $res_per_page - 1 );
if ( exists $form{'pg'} ) {
$this_page = $form{'pg'};
$this_page =~ tr/0-9//cd;
if ( $this_page eq '' ) { $this_page = 0 }
$page_begin = $this_page * $res_per_page;
$end = ( $page_begin + $res_per_page - 1 );
}
if ( $end > $#pages ) { $end = $#pages }
@pages = @pages[ $page_begin .. $end ];
}
$shown = $#pages + 1;
if ($high_results) {
$disp_root = "$page_script?$search_q&d=";
}
else {
$disp_root = $docroot_web;
}
if ( $#pages >= 0 ) {
print
"Search results ($found found, $shown shown)
\n";
$n = $page_begin + 1;
for $pg (@pages) {
if ( $pg =~ m/(\w)(.+)/ ) {
if ( $1 eq 'I' ) {
$fn = $2;
if ( open FL, "$docroot_disc/$fn" ) {
read FL, $pt, 1024;
close FL;
if ( $pt =~ m~(.+?)~gis ) { $title = $1 }
else { $title = '(no title)' }
print
qq~$n - $title
\n~;
}
}
else {
print "(result type not known)
\n";
}
}
$n++;
}
print "\n";
}
else {
print "No matching pages found.\n";
}
if ( $res_per_page != -1 ) {
if ( $found != $shown ) {
$pages = int( ( $found / $res_per_page ) + 1 );
print "$pages pages : \n";
if ( $this_page != 0 ) {
$p = $this_page - 1;
print
qq~ <
~;
}
else {
print "< ";
}
for ( $p = 0 ; $p < $pages ; $p++ ) {
$n = $p + 1;
if ( $p == $this_page ) {
print " $n ";
}
else {
print
qq~ $n
~;
}
}
if ( $this_page != ( $pages - 1 ) ) {
$p = $this_page + 1;
print
qq~ >
\n~;
}
else {
print " >\n";
}
}
else {
print "1 page of results only\n";
}
}
}
print <<__EOF;
__EOF
print $model_bot;
exit(0);
sub parse_form {
%form = ();
my $buffer;
if ( $ENV{'REQUEST_METHOD'} eq 'POST' ) {
read( STDIN, $buffer, $ENV{'CONTENT_LENGTH'} );
}
else {
$buffer = $ENV{'QUERY_STRING'};
}
@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))/eg;
$form{$name} = $value;
}
}