#!/usr/bin/perl ################################################################################# # DON'T CHANGE ANYTHING AFTER THIS LINE ################################################################################# # Copyright 2003 Brent Maurer # http://BibleDatabase.org # All rights reserved ################################################################################ # Advanced Online Bible Search Tool # ################################################################################ use CGI qw(:all); use locale; use strict; ################################################################################ our $bib_dir; #/module/ directory our $sysdef_dir; #/sysdefs/ dir our $html_dir; #/html/ Directory our $index_dir; #/index/ directory our $name_dir; #biblical names our $parts_dir; #parts of the Bible our $TITLE_BIB; #META title our $charset; #charset to use our $DEFAULT_CHARSET; #default. Make same as $charset; our $MAX_LOG; #the max size the log file can grow to our $debug; #IMPORTANT SET $debug=0 once script works. our $MAX; #max search results our $FONTNAME; #font Name to use our $FONTSIZE; #Font size to use our $BG_COLOR; #Background color our $FORE_COLOR; #text color our $BLANK_SEARCH; #default text box message our $DEF_BIB; #default Bible. Must be EXACTLY as in TL.TXT!!!!! our $DEF_LANG; #default language our $START_BOOK; #"1 GENESIS" = genesis our $DEF_CHAP; #not applicable when not in Read mode "N/A" our $OUT_OF_RANGE; #out of range our $T_BIB; #heading for drop down box our $T_BOOK; #heading for drop down box our $T_CHAP; #heading for drop down box our $T_SEARCH; #heading for text box our $T_CASE; #Ignore case or not our $T_HILITE; #hilite our $T_RAD; #choose your weapons our $T_RAD_EXACT; #exact our $T_RAD_IGNORE; #ignore order our $T_RAD_ANY; #any words our $T_RAD_READ; #read bible our @HILITE_1; our $ALLOW_ADMIN; #allow script admin options? For security reasons we recommend you leave it at 0. Change to 1 to allow our $DEF_RESTART; #make matthew the default book when wrong read mode parameter selected our $site_copyright; #copyright holder for this website our @valid_referrer; our $allow_remote_calling; #Allow script to be called from another domain our $dictionary_script_name; our $name_script_name; our $link; our $vlink; our $alink; our $font_weight; our $font_style; our $double_space; our $admin_email; our $uc; ################################################################################# print "Content-type: text/html\n\n"; #print header eval { require 5.6.0; # Make sure we have at least perl 5.6.0. require 'config.cfg'; #get the include file. } or &err($@); #-------------------------------------------------------------------------------- my $BOOK_LIMIT = 72; #for future use. DO NOT CHANGE my $bible = ""; #list of bibles my $curr_bible = ""; #the current Bible my $books = ""; #all books my $book_no = 0; #the book number (range) my $results = ""; #search results my $built = ""; #the output list when we build the Bible my $admin_mode = 0; #are we in admin mode? my $MAX_HILITE = 6; #max hilite terms in unique colors is 6 my $FOUND = 0; #How many results did this search yeild my $IDX = 0; #the main index my %BOOK_S = (); #SHORT Books of the Bible my %BOOKS_L = (); #long books of the Bible my %TL_LANG = (); #TL.TXT - languages my %TL_BIB = (); #TL.TXT - Bible Names my %TL_FN = (); #TL.TXT - File Names my %NAMES = (); #defs for def => narration my $disabled_text = ""; #what to say when the script is disabled my $ver = "2.0.2"; my $CR=1; my $submit; my $search; my $book; my $chap; my $radio; my $case; my $hilite; my $first; my $language; my $chap_no; my $curr_lang; my $LogBible; my $c; #-------------------------------------------------------------------------------- sub init{ #Initialize my $year; ($year)=(localtime)[5]+1900; if ($year != 2002){$year="2002-" . $year;} if ($double_space){$double_space="

"}else{$double_space="
"} $c = qq|

Licensed to $site_copyright. All Rights reserved. (Script Ver $ver)
© $year. Powered by BibleDatabase

|; $search = param("SEARCH")||""; #000000 $submit = param("SUBMIT"); #000000 $book = param("BOOK"); #000000 $chap = param("CHAP"); #000000 $bible = param("BIBLE"); #000000 $radio = param("R1"); #000000 $case = param("CASE"); # $hilite = param("HILITE"); # $first = param("FIRST"); # #$LA = param("LA") || 0; # # if ($search eq ""){ $first = ""; $radio = ""; $bible = ""; $language = ""; $book = ""; $chap = ""; $case = ""; $hilite = ""; } $search = &delete_single_chars($search);# $search = &uniques_only_a($search); # $search = $search || $BLANK_SEARCH; $submit = $submit || "NONE"; $book = $book || $START_BOOK; $DEF_CHAP = ""; $chap = $chap || $DEF_CHAP; $chap_no = $chap; # $language = $language || $DEF_LANG; $curr_lang = $language; $bible = $bible || $DEF_BIB; $case = $case || " "; ($book_no) = $book; # $search = &escape($search); # $search = &trim($search); # if ($ALLOW_ADMIN){ if ($search =~ m/^\.\./){&check_build_pass;} # elsif ($search !~ /^[^\^\\\.\|\(\)\`\=\@\#\}\{\$]+$/)# { $search = "Error. Invalid search string"; } # } elsif ($search !~ /^[^\^\\\.\|\(\)\`\=\@\#\}\{\$]+$/) { $search = "Error. Invalid search string"; } # $radio = $radio || "I"; # $bible = &escape($bible); # } sub err{ # my $msg=shift; my (undef,undef,$line)=caller(); unless (defined($debug)){$debug=1}; if ($debug){ print""; print "
An Error has occured.Script will close.

"; print "Error: $msg
"; print "Error occured in line $line of $ENV{\"SCRIPT_NAME\"}.

"; print qq|

Before requesting help, please make sure of the following:

  1. Have you checked that the file or directory the script is complaining about exists?

  2. Have you set the rights to this file or directory correctly?

  3. Has the file been uploaded to the server in the right format? (binary or ASCII as applicable)

  4. Did you change the DEFAULT_BIBLE or any of the other variables? If so check your spelling, case etc. These must be exactly as in TL.TXT

  5. Did you enable the Bible you installed? If you didn't, the script will not work.

  6. VERY IMPORTANT NOTE: We recommend you install the script without changing anything at first. (Install the b_kjv.txt as the script is set up etc). Once you get it working, then make changes. If you do not do this you won't know (and neither will we!!) where to start looking for the problem.

  7. If you get the Error "Error: Cannot open BOOKS_ txt" this often means the script is not reading the file TL.TXT correctly or that you have installed a Bible but not enabled it. This also sometimes happens when your server is running mod_perl or full blown UNIX or if your FTP client added additional CR sequences to the file. For more information on this, please see This Thread on the Message Board for a fix for this.

NOTE: Please Describe your problem in detail when requesting tech support. We cannot help you if we don't understand the problem.

|; print "Additional Miscellaneous information about your server

"; print "Perl Version: $]
\n"; foreach my $key(keys %ENV){ print"$key : $ENV{$key}
\n"; } print qq|

Warning!!! Do not leave the Script in this mode if you plan on having a server tomorrow.
Hackers will have an open day on your server!
Change debug=1;  to debug=0;

|; print "$c"; exit; } else { print""; print "
An Error has occured.Script will close.
"; print "If it persists, please contact the administrator of this site at $admin_email"; die($msg); } } sub disabled{ # my $sep = "spudmonkey\t"; my $disabled = 0; if (&exist ("","status",".dat")){ open A, "; foreach my $line (@s){ if ($line =~ /^$sep/){(my $x, $disabled) = split(/$sep/,$line);} else {$disabled_text .= $line;} } close A; } my $q = qq| BibleDatabase Bible Search |; $disabled_text =~ s/\n/
\n/g; $disabled_text = $q . "

" . $disabled_text . "

"; return $disabled; } sub get_uptime_info { # my ($uptime,$load,$users,$res,@buf,$buf); if ($^O=~ /win/i) { # $uptime=$load=$users='ERROR'; # } else { # eval {$res=`uptime`;}; if (($@) || ($res eq '') ) { # $uptime=$load=$users='Not Applicable'; # } else { # chomp($res); # if ($res=~ s/\,*\s*load\s*averages*\s*\:*\s*(.*)//i) { $buf=$1; # $buf=~ s/^\s+//; # @buf=split(/,*\s+/,$buf); # $load="
60 Sec: " . ($buf[0] * 100) . "%
5 min: " . ($buf[1] * 100) . "%
15 min: " . ($buf[2] * 100) # } else { $load='Not Detected'; } if ($res=~ s/\,*\s*(\d+)\s+user\(*s*\)*//i) { # $users=$1; # } else { # $users='Not Detected'; # } if ($res=~ /up\s*\:*\s*(.*)\,*/) { $uptime=$1; # $uptime=~ s/day/day/igs; # $uptime=~ s/min/minute/igs; # # $uptime=~ s/(\d+)\:(\d+)/$1 hour\(s\) $2 minute(s)/igs; } else { $uptime='Not Detected'; } } } return ($uptime,$load,$users); # } sub check_build_pass{ # my $PASS = 0; my $s = ""; my $pass = ""; my @pass_arr = (); my $w_count = 0; $w_count = (@pass_arr = split(/ /, $search)); # $pass = $pass_arr[$PASS]; # $pass = substr($pass, 2, length($pass)-2); # $admin_mode = 1; # if (exist ($sysdef_dir, "pass", "") == 0){ # $pass = crypt($pass,2); # open (A, ">" . $sysdef_dir . "pass"); print A $pass; $built = "

Admin Password created.
Kep it safe!
Password set to: " . substr($search, 2, length($search)-2) . "

"; close A; } else { open (A, "<" . $sysdef_dir . "pass"); # $s = ; # close A; chomp($s); if (crypt($pass,2) eq $s){ # if ($w_count == 1){ # if ($radio eq "N") { &create_all_modules; }} # if (($radio eq "A") and ($w_count > 1)) # { &show_log(@pass_arr); } } else { $built = "

Password Error

"; } # } } sub valid_int { # my $test = shift; if ($test =~ /^-?\d+$/) # { return(1); } else { return(0); } } sub show_log { # my @p = @_; my $terms = @p; my $term = ""; my $lines = 0; my $s = ""; my @file = (); my @line = (); my $start = 0; my $i = 0; my $col = 0; my $MC = 12; # my ($DA, $IP, $LA, $BI, $BK, $HI, $CA, $RA, $CH, $SE) = ""; my $table = qq| |; if (&valid_int($p[1])){ # open (A, "; # close A; # if ($lines > $p[1]){$start = $lines - $p[1];} # else {$start = 0;} # if ($p[1] == 0){$start = 0;} # $results .= $table; # for ($i = $start; $i <= $lines; $i++){ # chomp($file[$i]); # @line = split(/\t/, $file[$i]); # for ($col = 0;$col <= $MC;$col++){ # if ($col == 0){$results .= "";} # if ($col == $MC){$results .= "";} # if (($col == $MC - 3 ) and ($line[$col] =~ m/^\.\./)){ # $line[$col] = "" . $line[$col] . "" ;} # if ($line[0] ne ""){$results .= "";} # } } $results .= "
Date IP LANG BIBLE BOOK HILITE CASE RADIO CHAP SEARCH FOUND LOAD
" . $line[$col] . "

Last " . ($lines - $start) . " record(s) displayed.";# } elsif (uc($p[1]) eq "KILL"){ # unlink("log.log"); # $results = "

Log File Deleted.

"; # } } sub hilight{ # my $s = shift; my $out = ""; my $count = 0; my @TMP;# # @TMP = ($s =~ /$search/gi); # $out = "$TMP[0]"; $count = ($s =~ s/$search/$out/gi); #} # #else { $count = ($s =~ s/$search/$out/g);} # if ($count > 1){$s .= " (Count: " . $count . ")";}# return($s); } sub name_find{ # my $input = shift; # my $out = $input; # my $word = ""; my $append = ""; my $ta = 0; my $i = 0; if (($TL_LANG{$IDX} eq "ENGLISH") and (&exist($name_dir,"b_names",".txt"))) { $input =~ s/<[^>]*>//gs; # my @t = split(/ /, $input); # my @words = &uniques_only(@t); # # foreach $word(@words){ # $word =~ tr/\'\",|;|:|[0-9]|\.//d; # $words[$i] = $word; # $i++; # } @words = &uniques_only(@words); # $append .= "


Meaning of Names found in this text:
\n"; $append .= "\n"; @words = sort (@words); # foreach $word(@words){ # if ((exists($NAMES{$word})) and ($word ne "")){# if ($ta % 2){ # $append .= "\n"; } else{ $append .= "\n"; } $ta++; # } } if (!$ta){$append = "";} # $append .= "
" . $word . " " . $NAMES{$word} . "
" . $word . " " . $NAMES{$word} . "
"; # $append .= "
Bible Names
"; } return $out . $append; # } sub do_search { # my $count = 0; my $tmp = ""; my ($id, $bk, $ch, $vs, $N) = ""; # my $file = $parts_dir . $book_no . "_" . $curr_bible . ".dat"; my $s = " "; my $caption = $BOOKS_L{$book_no}; my $bib = $TL_BIB{$IDX}; my $norm_search = $search; $caption =~ s/(\w+)/\u\L$1/g; # unless (open( A, lc($file))) {&err("Could not open $file
$!"); } # else { while ($s ne "") { $s= ; # chomp($s); # ($id, $bk, $ch, $vs, $N) = split(/\t/, $s); # if ($case eq "ON") { # $tmp = lc($N); $search = lc($search); } else { $tmp = $N; } #CASE SENSITIVE if ($tmp =~ /$search/) { # if ($MAX > $count) { if ($hilite eq "ON") {$N = &hilight($N);} $results .= $BOOK_S{$bk} . " " . $ch . ":" . $vs . " " . $N . "$double_space\n"; # } $count++; } } close A; $results = &name_find($results); $results .= "
" . $count . " verses found. \n"; } if ($count == 0 ) {&show_help_screen("search_help.htm");} elsif ($MAX > $count) { $results .= $count; } else { $results .= $MAX; } $results .= " returned.\n"; $results = "

" . &char_set . $bib . ", " . $caption . ": " . $search . "

" . $results; # $search = $norm_search; $FOUND = $count; $language = ""; } sub trim{ # my $s = shift; $s =~ s/^\s+//; $s =~ s/\s+$//; return $s; } sub escape { #Defunkify web stuff my $s = shift; $s =~ tr/+/ /; # $s =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; # return ( $s ); } sub get_lang { # my $curr_lang = $language; # my $s = " "; my $i = 1; my ($id, $y, $z) = 0; my $count = 0; my $tmp = 0; my @lst = (); open ( A, $sysdef_dir . "BOOKS_" . $TL_LANG{$IDX} . ".txt") or &err("Cannot open BOOKS_$TL_LANG{$IDX} txt
$!");# do { # $s = ; # ($id, $y, $z) = split(/\t/, uc($s))if $uc; # ($id, $y, $z) = split(/\t/, $s) if !$uc; # $BOOK_S{$id} = $y; # $BOOKS_L{$id} = $z; # if ($i <= $BOOK_LIMIT) { #Book limit = 71 prevents whole Bible search if ($i == $book_no) # { $books .= "
\n"; } else { $books .= "
\n"; } $i++; } } until ($s eq ""); $book = $books; close A; } sub print_form { # my ($s, $header, $footer, $CASE) = " "; my ($N, $I, $A, $R); if ($radio eq "I") {$I = "checked";} elsif ($radio eq "A") {$A = "checked";} elsif ($radio eq "R") {$R = "checked";} else {$N = "checked";} if ($case eq "ON") {$CASE = "checked";} if ($hilite eq "ON") {$hilite = "checked";} else {$hilite = "";} if ($search eq $BLANK_SEARCH){ $CASE = "checked"; $hilite = "checked" } if (!$CR){$c = '';} open (A, "<" . $html_dir . "header.html"); # while ($s ne "") { $s = ; $header = $header . $s; } close A; $s = " "; open (A, "<" . $html_dir . "footer.html"); # while ($s ne "") { $s = ; $footer = $footer . $s; } print qq| $TITLE_BIB $header

$T_SEARCH $T_BIB $T_BOOK $T_CHAP
$T_CASE
$T_HILITE

$T_RAD

$T_RAD_EXACT $T_RAD_IGNORE $T_RAD_ANY $T_RAD_READ

$results $built
$c $footer |; } sub get_bible_list{ # my $keys = ""; my $value = ""; my $key = ""; my $i = 0; my @list = (); my $cnt; #19022003 while (($key, $value) = each(%TL_BIB)){ # $list[$i] = $value; $i++ } @list = sort(@list); for ($cnt = 0; $cnt < $i; $cnt++){ if ($list[$cnt] eq $TL_BIB{$IDX}){$bible .= ""; } else { $bible .= "";} } } sub exist { # my ( $path, $file, $extension ) = @_; unless ( open( A, "<" . $path . $file . $extension ) ) { return (0); } # else { return (1); } # close A; } sub build_chapters { # my ($id, $bk, $ch, $vs, $i, $tmp, $old_chap) = 0; my ($s, $narr, $bib, $o) = " "; my ($t_book, $t_chap) = 0; if (($book_no > 0) and ($book_no < 67)){ # $bib = uc($curr_bible . ".INDEX"); if ((&exist($index_dir, $bib, ""))){ # $chap = ""; # open (A, "<" . $index_dir . $bib) or # err("Cannot open $index_dir " . "$bib
$!"); while ($s ne ""){ # $s = ; # ($bk, $ch ) = split(/\t/, $s); #get book # if ($bk == $book_no){ #if we have the book # if ($chap_no > $ch){$chap_no = 1;} # for ($i = 1; $i <= $ch; $i++){ # if ($i == $chap_no) { # $chap .= "
"; } else { $chap .= "
"; # } } } } close A; } else{err("Cannot open $index_dir " . "$bib
$!");} print $o; } else # { $chap = ""; $results = "

Invalid Book selection. You must select a single Book" . " of the Bible in Read mode. E.g GENESIS

"; } } sub build_modules_range { # my $range = shift; my ($id, $bk, $ch, $vs, $which) = 0; my $n = ""; my $s = " "; my $start = 0; my $end = 0; my $opened = 0; if ($range == 67) {$start = 1; $end = 5;} elsif ($range == 68) {$start = 1; $end = 39;} elsif ($range == 69) {$start = 40; $end = 66;} elsif ($range == 70) {$start = 40; $end = 43;} elsif ($range == 71) {$start = 40; $end = 42;} elsif ($range == 72) {$start = 1; $end = 66;} open(IN, "<" . $bib_dir . "b_" . lc($curr_bible) . ".txt"); while ($s ne ""){ $s = ; # chomp($s); # ($id,$bk,$ch,$vs,$n)=split(/\t/, $s); # if (($bk >= $start) and ($bk <= $end)){ if ($opened == 0){ # open(OUT, ">" . $parts_dir . $range . "_" . lc($curr_bible) . ".dat"); # $opened = 1; # } print OUT $id . "\t" . $bk . "\t". $ch . "\t" . $vs . "\t". $n . "\n"; # } } $built .= "
Built file: " . $parts_dir . $range . "_" . $curr_bible . ".dat"; # close IN; close OUT; } sub build_modules{ # my ($id, $bk, $ch, $vs) = 0; my $which = 0; my $n = ""; my $s = " "; $built .= "

The following sub-modules for the " . $curr_bible . " Module were successfully built


"; open(IN, "<" . $bib_dir . "b_" . lc($curr_bible) . ".txt"); while ($s ne ""){ $s = ; # chomp($s); # ($id,$bk,$ch,$vs,$n)=split(/\t/, $s); # if (($bk != $which) and ($bk > 0) and ($bk < 67)){ # if ($which != 0){ close OUT; $built .= "
Built file: " . $parts_dir . $which . "_" . lc($curr_bible) . ".dat"; # } $which = $bk; # open(OUT, ">" . $parts_dir . $bk . "_" . lc($curr_bible) . ".dat"); # print OUT $id . "\t" . $bk . "\t". $ch . "\t" . $vs . "\t". $n . "\n"; # } else { print OUT $id . "\t" . $bk . "\t". $ch . "\t" . $vs . "\t". $n . "\n"; # } } $built .= "
Built file: " . $parts_dir . $which . "_" . $curr_bible . ".dat"; # close OUT; close IN; # } sub create_all_modules { # &build_modules; # &build_modules_range(67); # &build_modules_range(68); # &build_modules_range(69); # &build_modules_range(70); # &build_modules_range(71); # &build_modules_range(72); # } sub read_mode{ # my ($id, $bk, $ch, $vs, $n); my $s = " "; my $OK = 0; my $bib = ""; if ($book_no > 66) { # $book_no = $DEF_RESTART; # $book = $BOOKS_L{$DEF_RESTART};# &get_lang; # &build_chapters # } my $caption = $BOOKS_L{$book_no}; my $file = $parts_dir . $book_no . "_" . $curr_bible . ".dat"; $caption =~ s/(\w+)/\u\L$1/g; # if (! &valid_int($chap_no)) {$chap_no = 1;} # if (($book_no >= 1) and ($book_no <= 66 )) { # unless (open( A, lc($file))) {&err("Could not open $file
$!"); }# else { $bib = $TL_BIB{$IDX}; while ($s ne "") { $s= ; # chomp($s); # ($id, $bk, $ch, $vs, $n) = split(/\t/, $s); # if (($bk == $book_no) and ($chap_no == $ch)){ # $results .= $vs . " " . $n . "$double_space"; # } } close A; #15/12/02 } } $results = &name_find($results); $results = "

" . $bib . " " . $caption . " " . $chap_no . "

" . $results; # } sub do_search_any_order{ # my @s_terms = split(/ /, $search); my $term_count = @s_terms; my $i = 0; my ($id, $bk, $ch, $vs, $n) = ""; my $s = " "; my $tracker = 0; my $file = $parts_dir . $book_no . "_" . $curr_bible . ".dat"; my $tmp = ""; my @out = (); my $cnt = 0; my $h = -1; my $bib = $TL_BIB{$IDX}; my @NEW; #19022003 my $pre_result = "

" . &char_set . $bib . ", " . $BOOKS_L{$book_no} . ": "; # if ($case eq "ON"){ for ($i = 0; $i <= ($term_count -1) ; $i++){ $s_terms[$i] = lc($s_terms[$i]); } } for ($i = 0; $i <= ($term_count -1) ; $i++){ if ($i > $MAX_HILITE) {$h = $i - $MAX_HILITE - 1;} else {$h = $i;} $out[$i] = "$s_terms[$i]"; if ($hilite eq "ON") {$pre_result .= $out[$i] . " ";} else {$pre_result .= $s_terms[$i] . " ";} } unless (open( A, lc($file))) {&err("Could not open $file
$!"); } # else { while (($s ne "") and ($MAX > $cnt)){ # $s = ; $tracker = 0; chomp($s); ($id, $bk, $ch, $vs, $n) = split(/\t/, $s); # $tmp = $n; if ($case eq "ON") {$tmp = lc($tmp);} # for ($i = 0; $i <= ($term_count -1) ; $i++){ # if ($tmp =~ m/$s_terms[$i]/){ # $tracker++; # if ($tracker == $term_count){ # for ($i = 0; $i <= ($term_count -1) ; $i++){ # @NEW = ($n =~ /$s_terms[$i]/gi); # if ($hilite eq "ON"){ # if ($i > $MAX_HILITE) {$h = $i - $MAX_HILITE - 1;} else {$h = $i;} # $NEW[0] = "$NEW[0]"; # } $n =~ s/$s_terms[$i]/$NEW[0]/ig; # } $cnt++; # $results .= $BOOK_S{$bk} . " " . $ch . ":" . $vs . " " . $n . "$double_space\n"; # } } } } } close A; $results = &name_find($results); $results = $pre_result . "

" . $results; if ($cnt == $MAX){$results .= "
There were more than $MAX verses.";} elsif ($cnt == 0) {{&show_help_screen("search_help.htm");}} else {$results .= "
$cnt verses found.";} $FOUND = $cnt; } sub delete_single_chars { # my @words = split(/ /, shift); my $NEW = ""; my $new = 0; foreach my $word(@words){ $word = trim($word); if (length($word) > 1){ $NEW .= $word . " "; $new++; } } return($NEW); } sub uniques_only_a { # my @list = split(/ /,shift); my %seen = (); my $item = ""; my $unique = ""; my $t = ""; foreach $item(@list){ $t = $item; if ($case eq "ON") {$item = uc($item);} unless ( $seen{$item} ){ $seen{$item} = 1; $unique .= $t ." "; } } return($unique); } sub uniques_only { # my @list = @_; my %seen = (); my $item = ""; my @unique = (); foreach $item(@list){ unless ( $seen{$item} ){ $seen{$item} = 1; push(@unique, $item); } } return(@unique); } sub do_search_any_words{ # my $fn = $parts_dir . $book_no . "_" . $curr_bible . ".dat"; # my ($id, $bk, $ch, $vs, $n) = ""; # my @words = split(/ /, $search); # my @TMPW = (); my $tmpw = ""; my $word = ""; my $OK = 0; my $cnt = 0; my %HL = (); my $bib = $TL_BIB{$IDX}; my $s; #19022003 foreach $word(@words){ if ($hilite eq "ON"){ my $x .= ""; # #"$word"; # $results .= $x . "$word "; # if ($case eq "ON") # {$HL{uc($word)} = $x;} # else # {$HL{$word} = $x;} # } else {$results .= $word . " ";} # $OK++; } $results .= "
"; unless (open( A, lc($fn))) {&err("Could not open $fn
$!");} # else{ # do{ # $OK = 0; $s = ; # chomp($s); # ($id, $bk, $ch, $vs, $n) = split(/\t/, $s); # if ($case eq "ON"){ # foreach $word(@words){ if ($n =~ /$word/i){ # @TMPW = ($n =~ /$word/ig); # @TMPW = &uniques_only(@TMPW); # foreach my $t(@TMPW){ # my $x = $t . ""; # $n =~ s/$t/$HL{uc($t)}$x/g; # } $OK++; } } } else # { foreach $word(@words){ # if ($n =~ /$word/){ # @TMPW = ($n =~ /$word/g); # my $tmp = $TMPW[0]; # if ($hilite eq "ON"){ # my $x = $word . ""; $n =~ s/$tmp/$HL{$tmp}$x/g; # } $OK++; # } } } if ($OK){ $OK = 0; $results .= $BOOK_S{$bk} . " " . $ch . ":" . $vs . " " . $n . "$double_space"; $cnt++; } } # until (($n eq "")or ($cnt >= $MAX)); # } $results = &name_find($results); $results = "

" . &char_set . $bib . ", " . $BOOKS_L{$book_no} . ": " . $results; # close A; if ($cnt == $MAX){$results .= "
There were more than $MAX verses.";} elsif ($cnt == 0) {{&show_help_screen("search_help.htm");}} else {$results .= "
$cnt verses found.";} $FOUND = $cnt; } sub show_help_screen{ # my $file = "<" . $html_dir . shift; unless ( open( A, $file ) ) { &err("Could not open $file
$!") } # else { my @s = ; my $file = join("",@s); $file =~ s/(\$\w+)/$1/gee; $results .= $file; close A; } } sub log { # my @LOAD; $DEF_CHAP =~ s/<[^>]*>//gs; # @LOAD = &get_uptime_info; if ($radio eq "R"){ # $FOUND = "-"; $hilite = "-"; $search = "-"; $case = "-"; } if ($case eq ' '){$case = "-";} # if ($case eq lc("checked")) {$case = "ON";} # if ($hilite eq ""){$hilite = "-";} # if ($radio eq "A"){$radio = "ANY ORD";} if ($radio eq "I"){$radio = "IGNORE";} if ($radio eq "N"){$radio = "DEFAULT";} if (($radio eq "R")and ($book_no < 67)) {$radio = "READ";} elsif (($radio eq "R") and ($book_no > 66)) {$radio = "RD ERR";} if ($hilite eq lc("checked")) {$hilite = "ON";} if ($chap_no eq $DEF_CHAP){$chap_no = "-";} $books = $BOOKS_L{$book_no}; chomp($books); open ( A, ">>log.log" ); print A localtime() . "\t" . $ENV{'REMOTE_ADDR'} . "\t" . $curr_lang . "\t" . $LogBible . "\t" . $books . "\t" . $hilite . "\t" . $case . "\t" . $radio . "\t" . $chap_no . "\t" . $search . "\t " . $FOUND . "\t" . $LOAD[0] . $LOAD[1] . $LOAD[2] . "\n"; close A; } sub load_names{ # my $fn = shift; my ($s, $id, $short, $long); open A, "<" . $name_dir . $fn . ".txt"; do{ $s = ; ($id,$short,$long) = split(/\t/,$s); $NAMES{$short} = $long; } until(! $id); close A; } sub get_TL{ # my $s; unless (open A, "<" . $sysdef_dir . "TL.TXT" ) {&err("Could not open TL.TXT
$!");} else { do{ $s = ; chomp($s); my ($OK, $LANG, $ID, $FN, $NAR) = split(/\t/, $s); if (($OK) and ($ID < 1000)) {$TL_LANG{$ID} = $LANG;} if (($OK) and ($ID < 1000)) {$TL_BIB{$ID} = $NAR;} if (($OK) and ($ID < 1000)) {$TL_FN{$ID} = $FN;} if ($ID == 1500){ if (&exist($name_dir,$FN, ".txt")){&load_names($FN)} } if ($NAR eq $bible){ $IDX = $ID; $curr_bible = $FN; if ($FN =~ /utf8/) { $charset = "utf-8"; } } # } until($s eq ""); close A; } } sub trim_log{ my @file; my $cnt; my $stop; my $log_size = -s 'log.log'; if ($log_size > $MAX_LOG){ open LOG, "<" . 'log.log'; my $lines = @file = ; close LOG; $stop = int($lines/2); open LOG, ">" . 'log.log'; for ($cnt=0;$cnt <$stop;$cnt++){ print LOG $file[($stop-1)+$cnt]; } close LOG; } } sub char_set{ # if ($charset ne $DEFAULT_CHARSET){ return "(" . uc($charset) . ") "; } } sub validate_referrer{ #1=OK 0=BAD my $Fvalid_referrer=0; if (!$allow_remote_calling){ foreach my $referrer(@valid_referrer){ if ($ENV{"REMOTE_ADDR"} =~ /$referrer/){$Fvalid_referrer=1;} if ($ENV{"HTTP_REFERER"} =~ /$referrer/){$Fvalid_referrer=1;} } if ((!$debug)and (!$Fvalid_referrer)){ print"

Click here to try again.

" } if(!$Fvalid_referrer){&err("Invalid referrer. " . "Script was called from =>
$ENV{\"HTTP_REFERER\"} or $ENV{\"REMOTE_ADDR\"}. " . "
Found instead " . "@valid_referrer specified in \"valid_referrer\"."); exit; } } } &init; # &validate_referrer; if (!&disabled){ $LogBible = $bible; &get_TL; # &get_bible_list; # if (($first eq "OK") and ($radio eq "R")) {&build_chapters} else {$chap = $DEF_CHAP}; #Build the .INDEX file as well as populate the chapters &get_lang; # if (($first ne "OK") and ($admin_mode == 0)) {&show_help_screen("help.htm");} if (($first eq "OK") and ($admin_mode == 0) and ($radio eq "N")) {&do_search;} # if (($first eq "OK") and ($admin_mode == 0) and ($radio eq "I")) {&do_search_any_order;} if (($first eq "OK") and ($admin_mode == 0) and ($radio eq "A")) {&do_search_any_words;} if (($first eq "OK") and ($radio eq "R")) {&read_mode} $first = $first || "OK"; # &print_form; &log; &trim_log; } else {print $disabled_text;}