$title

#!/usr/bin/perl use strict; use locale; use POSIX qw (locale_h); setlocale(LC_CTYPE, 'ru_RU.cp1251'); use CGI qw(:param); #use utf8towin; use menu; #print $0; exit; my $patt = param("patt"); my $case = param("case"); my $order = param("order"); my $word = param("word"); my $pagesize = param("pagesize"); my $page = param("page"); my $areal = param("areal"); my $regexp = param("regexp"); my $lang = param("lang"); $areal ||= "bible"; $pagesize ||= 20; $page ||= 1; my ($lang) = split(/_/, $lang); $lang||= "RU"; $lang eq "UC" and $lang = "CS"; my $select_lang; my $QUERY = $ENV{QUERY_STRING} ; $QUERY=~ s/\&lang=\w+//i; $QUERY=~ s/lang=\w+//i; if ($lang eq "RU") {$select_lang= qq! (Рус. / Ц.С.) ! } else {$select_lang= qq! (Рус. / Ц.С.) ! } $patt = utf2win($patt); my $zapros = $patt; $zapros=~ s/^\s+//; $zapros=~ s/\s+$//; my $title = "Поиск в Библии"; $title = "$zapros - $title" if $zapros; print < $title Библия - $select_lang - Поиск - Справка

HT1 (my $zvalue = $patt) =~ s/\"/\"/g; #print "$_ => $ENV{$_}
\n" for keys %ENV; print <

Различать регистр
Фраза
Только целые слова
FORM # Результатов на странице # Страница #Регулярные выражения
if ($zapros) { #open P, ">>log.txt"; #print P qq!$zapros\n!; #close P; $_ = $zapros; s#\\\\#\x00b#g; s#\\\*#\x00z#g; s#\\\.#\x00t#g; s#\\\^#\x00k#g; s#\\{#\x001#g; s#\\}#\x002#g; s#\\_#\x00s#g; s#\\@#\x00a#g; s#\\%#\x00p#g; s#\\\|#\x00d#g; s#([\\.&"`?$()\[\]])#\\$1#g; s#{#$#g; s#}#$#g; s#\*#\\S*#g; # * => \S* s#\+#\.*?#g; # + => .*? s#\^#\\W+#g; # ^ => \W+ s#%#\\w*#g; # % => \w* s#@#\\w#g; # @ => \w s#_+#\\s+#g; # _ => s+ s/\s+/\\W+/g if $order; s#\x00z#\\\*#g; s#\x00b#\\\\#g; s#\x00t#\\\.#g; s#\x00k#\\\^#g; s#\x001#{#g; s#\x002#}#g; s#\x00s#_#g; s#\x00a#@#g; s#\x00p#%#g; s#\x00d#\\\|#g; $zapros = $_; my @reg_Y = grep { !/^~/ and !/^\.\*\?$/ } split(/\s+/, $zapros); my @reg_N = grep { s/^~// } split(/\s+/, $zapros); if ( $word ) { $_ = qq!\\b$_\\b! for (@reg_Y, @reg_N ) }; if ( $case ) { $_= qr/$_/ for( @reg_Y, @reg_N ) } else { $_= qr/$_/i for( @reg_Y, @reg_N ) } #print qq!

@reg_Y

!; my %SN = (); my %FN = (); open I, "$lang/index.txt"; while () { chomp; /^\w/ or next; my ($n, $sn, $fn) = split("\t"); $SN{$n} = $sn; $FN{$n} = $fn; } close I; #my $TXT = "RU"; opendir D, $lang; my @files = sort grep { /^\d\d\d\.txt$/i } readdir D; print "

\n"; undef $/; my $count; #my $RESULT = ''; my $TX; my $res_page; R: while (1) { $count = 0; $TX= ''; F: for my $f (@files) { open S, "$lang/$f"; my $text= ; close S; $f=~ /^(\d\d\d)\.txt$/i; my $kn = $1; $areal eq "nz" and $kn=~ /^0/ and next F; $areal eq "vz" and $kn=~ /^1/ and next F; my @lines = split("\n", $text); my $gl=0; my $st=0; my $tx=''; L: for (@lines) { if ( /^(?:Глава|Псалом)\s+(\d+)\s*$/ ) { $gl = $1; } elsif ( /^(\d+)\s+(.+)$/ ) { ($st, $tx)= ($1, $2); $tx=~ /$_/ or next L for @reg_Y; $tx=~ /$_/ and next L for @reg_N; $count++; use integer; my $tek_page = ($count-1)/$pagesize + 1 ; if ($tek_page==$page) { $tx=~ s!($_)!$1!g for @reg_Y ; $tx=~ s!(\s*)!$1!g; $TX.= qq! ($SN{$kn}.$gl:$st)\t$tx

\n! ; } } } } # F: for my $f (@files) use integer; $res_page = ($count-1)/$pagesize + 1 ; if ($page > $res_page) { $page= $res_page; redo R; } else { last R; } } # R: while (1) print qq!\nНайдено стихов: $count.
!; ( my $QUERY = $ENV{QUERY_STRING} ) =~ s/\&page=\d+//gi; print qq! << ! if $page>1; print qq!Страница: $page из $res_page! if $count>0; print qq! >> ! if $page<$res_page; print qq!

!; print qq!$TX\n
\n! if $TX; print < FORM print menu ( $page, $res_page, qq! !, qq! %s !); print qq!!; } # if ( $zapros ) print < HT2