спасибо за ответ BlackLFL! Извини, но я как бы недосказал, что все это нужно для армянских строк в кодировке UTF-8. Здесь просто есть старый скрипт на языке PERL, который производит поиск по ключевому слову, введенному в HTML форму. Далее программа открывает соответствующую директорию и пробегает по файлам, просто анализируя строку с соответствующим маркером. Я прог. на С++ и PERL не знаю, хотя по аналогии английской и русской версии модифицировал скрипт и для армянской версии. Осталось только решить проблему case_incensitive. Если интересно и есть время для всего этого, пожалуйста просмотри програму, а форма поиска на http://www.spyur.am/htmfix/main_a.htm - (пробная версия) Помоему програму писал хороший специалист, может кое что пригодится и тебе. | Код |
#!/usr/bin/perl
$|=1;
# Config these parameters
$logo='Spyur database search engine';
############### site dependent parameters
$HOST='ARMINCO'; # default host
foreach (`hostname`){
if (/^\S+\.acc\.am$/) { $HOST='ACC'; last};
if (/^song$/) { $HOST='SONG'; last};
}
if ($HOST eq "ACC"){
$base_dir='/home/spyur/public_html';
$base_url = 'http://spyur.acc.am';
@tmpldir=("/home/spyur/");
$sort_file='/home/spyur/sort.txt';
$debug=0;
} elsif ($HOST eq "SONG"){
$base_dir='/home/sevinian/spyur/public_html';
@tmpldir=("$base_dir/../");
$base_url = 'http://www.spyur1.am';
$sort_file='/home/sevinian/spyur/sort.txt';
$debug=1;
} else { # ARMINCO
$base_dir='/home/spyur/public_html';
$base_url = 'http://www.spyur.am';
@tmpldir=("$base_dir/");
$sort_file='/home/spyur/sort.txt';
$debug=0;
}
############### end of site dependent parameters
# debug 2 -> keyword =gind in rus
if ($debug){ open(FD ,">/tmp/cgi.deb"); print FD "\n-----------\n";}
$subdirs = "yes"; # allow to search in subdirectories of the above directories?
# what types of files do you want to search in? note that
# htm works for htm, html, phtml, shtml, etc...
@searchtypes = ('htm');
############ proccessing sort.txt #######################
$MAXPLACE=3500000; # bigger then total amount of spyur's clients
$SORTING=1;
open(SF, "$sort_file") or $SORTING=0 ; #Ïðèçíàê ñîðòèðîâêè: åñëè íåò ôàéëà ñîðòèðîâêè òî 0
$the_place=1;
while (<SF>){
next if /^\s*#.*$/;
next if !/^\s*(\d+).*$/;
$HoPlace{$1}=$the_place;
$the_place++;
}
# all other clients should have default place eq $MAXNUM (v konec spiska)
############################################################
use CGI qw(:standard);
$search = new CGI;
$result_num =100000;
$show_search = 'no'; # esli yes to vivodit poiskovoje menu --> type=hidden name=show_search value=no
$show_summary= $search->param('show_summ') eq "1" ? '1': '0'; # pokazat' sovpadenia type=checkbox name=show_summ value=1 checked
$keyword = $search->param('keyword'); # klu4evoe slovo
$page = $search->param('page'); # netu ni4evo v forme
$connector= $search->param('conn') eq "1" ? "and": "or"; # sovpadenie vsex slov type=checkbox name=conn value=1 checked
$case = "insensitive"; # neizvesnii zv
$lang = $search->param('lang'); # type=hidden name=lang value=arm
if ($lang ne "eng" && $lang ne "rus" && $lang ne "arm") { $lang = "eng" } ; #default language
$URL_SPSR="$base_url/spsr$lang.html";
$STR1='<BR>';
$STR5="<BR>\n";
$OTSTUP= '  ';
$OTSTUP= ' ';
# I #
$OTSTUP1="<LI>";
use POSIX qw(locale_h);
use locale ;
if ($lang eq "rus"){
if ($HOST eq 'ARMINCO'){
$CONVERT2KOI8=1; # set 1 and path/name if arminco will provide locales
}
if ($HOST eq 'ACC' || $HOST eq 'SONG' ){
$CONVERT2KOI8=1;
}
$CONVERT2KOI8=1;
setlocale(LC_ALL,"ru_RU.KOI8-R") if $HOST eq 'ACC'; # on FreeBSD
setlocale(LC_ALL,"ru_RU.KOI8-R" ) if $HOST eq 'SONG'; # on my Linux
setlocale(LC_ALL,"ru_RU.KOI8-R") if $HOST eq 'ARMINCO'; # ARMINCO
$URL_MAIN="$base_url/spyurru.htm";
$lng_switch="rus";
$STR2='Êëþ÷åâîå ñëîâî:';
$STR3='Êîëè÷åñòâî íàéäåííûõ îáúåêòîâ:';
$STR4="Åñëè ðåçóëüòàò ïîèñêà Âàñ íå óäîâëåòâîðèë, òî íàæìèòå íà <B>Back</B>, è ïîâòîðèòå ïîèñê, âûáðàâ áîëåå òî÷íûå êëþ÷åâûå ñëîâà è/èëè ïàðàìåòðû ïîèñêà.";
}
if ($lang eq "arm") {
$URL_MAIN="$base_url/spyuram.htm";
$lng_switch="arm";
$STR2='(ARM)Keyword(s):';
$STR3='(ARM)Organizations found:';
$STR4="Didn't find what You were looking for? Please go <B>Back</B> and try again with more precise keywords and search parameters.";
$CONVERT2KOI8=0; # do not use locale for english
}
else {
$URL_MAIN="$base_url/spyure.htm";
$lng_switch="eng";
$STR2='Keyword(s):';
$STR3='Organizations found:';
$STR4="Didn't find what You were looking for? Please go <B>Back</B> and try again with more precise keywords and search parameters.";
$CONVERT2KOI8=0; # do not use locale for english
}
LOOP1: foreach $ttt (@tmpldir){
foreach $ext (".html",".htm"){
$FTMPL = $ttt."tmpl".$lang.$ext;
if ( -f $FTMPL) {
last LOOP1;
};
}
}
$URL_LNG_SWITCH="$base_url/spsr$lng_switch.html";
$skpart = 0; # skip partial matching taxi-taxing
$skpart = $search->param('skpart'); # to4noe sovpadenie slov
@p_arr=(P08, P20, P07, P49, P48, P04, P05, P03, C01);
foreach $p (@p_arr){
if ($p eq "P08"){$HoSkip{$p}=0; $HoSearch{$p}= 0; $HoOut{$p}=0; $HoDetail{$p}=0};
if ($p eq "P20"){$HoSkip{$p}=0; $HoSearch{$p}=-1; $HoOut{$p}=0; $HoDetail{$p}=0};
if ($p eq "P07"){$HoSkip{$p}=0; $HoSearch{$p}=-1; $HoOut{$p}=0; $HoDetail{$p}=0};
if ($p eq "P49"){$HoSkip{$p}=1; $HoSearch{$p}=-1; $HoOut{$p}=0; $HoDetail{$p}=0};
if ($p eq "P48"){$HoSkip{$p}=0; $HoSearch{$p}= 0; $HoOut{$p}=0; $HoDetail{$p}=0};
if ($p eq "P04"){$HoSkip{$p}=0; $HoSearch{$p}= 0; $HoOut{$p}=0; $HoDetail{$p}=0};
if ($p eq "P05"){$HoSkip{$p}=0; $HoSearch{$p}= 0; $HoOut{$p}=0; $HoDetail{$p}=0};
if ($p eq "P03"){$HoSkip{$p}=0; $HoSearch{$p}= 0; $HoOut{$p}=0; $HoDetail{$p}=0};
if ($p eq "C01"){$HoSkip{$p}=0; $HoSearch{$p}= 0; $HoOut{$p}=0; $HoDetail{$p}=0};
}
foreach $p (@p_arr){
$HoOut{$p}=$HoDetail{$p} if $show_summary;
if ($HoSearch{$p} != -1 && $search->param($p)==1) {$HoSearch{$p}=1};
if ($HoSearch{$p} <= 0 && $HoOut{$p} == 0 ) { $HoSkip{$p}=1 };
}
# the directories you want to search in, note the trailing "/"
# you cannot search only '' as a directory and expect it to
# search all of your directories if you have $subdirs set to
# yes... you must specify directories
@dirs =();
if ($lang eq 'rus') {push @dirs, 'rus/'};
if ($lang eq 'eng') {push @dirs, 'eng/'};
if ($lang eq 'arm') {push @dirs, 'arm/'};
############################################################
@keywords_tmp = split(/\s+/,$keyword); # Ìàññèâ êëþ÷åâûõ ñëîâ ïîèñêà
if ($lang eq "rus") {
foreach (@keywords_tmp){
s/%([a-f0-9]{2})/pack("C", hex($1))/egi;
tr/\xFE\xE0\xE1\xF6\xE4\xE5\xF4\xE3\xF5\xE8 -\xEF\xFF\xF0-\xF3\xE6\xE2\xFC\xFB\xE7\xF8\xFD\xF9\xF7\xFA\xDE\xC0\xC1\xD6\xC4\xC5\xD4\xC3\xD5\xC8 -\xCF\xDF\xD0-\xD3\xC6\xC2\xDC\xDB\xC7\xD8\xDD\xD9\xD7\xDA/\xC0-\xFF/
if $CONVERT2KOI8;
push @keywords, $_;
}
}
else { @keywords=@keywords_tmp;}
if ($lang eq "rus" && $debug == 2) {
@keywords=();
@keywords_tmp=("Ãèíä"); # Gind in win
foreach (@keywords_tmp){
tr/\xFE\xE0\xE1\xF6\xE4\xE5\xF4\xE3\xF5\xE8-\xEF\xFF\xF0 -\xF3\xE6\xE2\xFC\xFB\xE7\xF8\xFD\xF9\xF7\xFA\xDE\xC0\xC1\xD6\xC4\xC5\xD4\xC3\xD5\xC8 -\xCF\xDF\xD0-\xD3\xC6\xC2\xDC\xDB\xC7\xD8\xDD\xD9\xD7\xDA/\xC0-\xFF/
if $CONVERT2KOI8;
push @keywords, $_;
}
}
foreach $wdir (@dirs)
{
chomp($wdir);
$dir = "$base_dir/$wdir";
chdir($dir);
opendir (DIR, $dir) || &cgiError ("Opening $dir Failed:", "$!");
@allfiles = readdir(DIR);
$totalnum=@allfiles;
closedir (DIR);
foreach $file (@allfiles)
{
if (-d $file)
{
push (@dirs,"$wdir$file/") if ($file ne "." && $file ne ".." && $wdir ne "" && $subdirs eq "yes");
}
if (-f $file)
{
($filename,$ext) = split(/\./, $file);
foreach $searchtype (@searchtypes)
{
if ($ext =~ /$searchtype/i)
{
@search=();
open (SEARCH,"$file") || &cgiError ("Open $file Failed:", "$!");
while (<SEARCH>)
{
next unless /^<!-- (\w)(\d\d) --> (.*)/ ; # vikinut' non-searchable
if ("$1$2" eq "P03"){$temp_head=$3}; # zapomni nazvanije firmi aka header
next if $HoSkip{"$1$2"}==1; # sejchas vikinut' nenuzhnije poka no searchable voobse govorja
$text=$3;
if ($lang eq "rus")
{
$text =~ tr/\xFE\xE0\xE1\xF6\xE4\xE5\xF4\xE3\xF5\xE8-\xEF\xFF\xF0 -\xF3\xE6\xE2\xFC\xFB\xE7\xF8\xFD\xF9\xF7\xFA\xDE\xC0\xC1\xD6\xC4\xC5\xD4\xC3\xD5\xC8-\xCF\xDF\xD0 -\xD3\xC6\xC2\xDC\xDB\xC7\xD8\xDD\xD9\xD7\xDA/\xC0-\xFF/
if $CONVERT2KOI8;
}
push @search, $text ;
};
close(SEARCH);
$temp_file = "$wdir$file";
$temp_strs = "";
%temp_founds=();
$wcount=0;
$nkey=@keywords; #3#
foreach $word (@keywords)
{
$wfoundflag=0;
foreach $text (@search)
{
chomp($text);
$text =~ s/<([^>]|\n)*>//g;
$text =~ s/&([^;])*;//g;
if ($text =~ /$word/i)
{
if ($skpart && $text !~ /(?:\s|\A)$word\s/i ){next};
$wfoundflag=1;
if (!$temp_founds{$text})
{
$temp_strs .= " %1% $text %2% "
};
$temp_founds{$text}=1;
}
else
{
$match = 0;
};
};
if ($wfoundflag == 1)
{
$wcount++;
if ($connector eq "or") {last};
}
};
if ($connector eq "and" && ($wcount == $nkey))
{
$all_found=1
}
else
{
$all_found=0
};
if (( $connector eq "or" && $wcount > 0 ) || ( $connector eq "and" && $all_found ) )
{
# Esli mnogo keywordsov to videljat' cvetom nado vse ili nichego :(
# v tom chisle i v header-e
foreach $word (@keywords)
{
if ($skpart==1)
{
$temp_strs =~ s|(\s$word\s)|<FONT COLOR=#993300 FACE=ARIAL AMU>$1</FONT>|gi;
}
else
{
$temp_strs=~ s|($word)|<FONT COLOR=#993300>$1</FONT>|gi;
}
if ($flotstup==1)
{
$temp_strs = $OTSTUP1.$temp_strs.'<BR>'
};
}
$temp_strs =~s/%1%/$OTSTUP1/g ;
$temp_strs =~s/%2%/<BR>/g ;
if ($lang ="rus")
{
$temp_strs =~tr/\xC0-\xFF/\xFE\xE0\xE1\xF6\xE4\xE5\xF4\xE3\xF5\xE8-\xEF\xFF\xF0 -\xF3\xE6\xE2\xFC\xFB\xE7\xF8\xFD\xF9\xF7\xFA\xDE\xC0\xC1\xD6\xC4\xC5\xD4\xC3\xD5\xC8-\xCF\xDF\xD0 -\xD3\xC6\xC2\xDC\xDB\xC7\xD8\xDD\xD9\xD7\xDA/
if $CONVERT2KOI8;
};
$matches_str {$temp_file} = $temp_strs;
$matches_head{$temp_file} = $temp_head;
};
}
}
} #if ( -f $file)
} #for (@allfiles
} # foreach $wdir
if ($SORTING==1){
####### Assign default $MAXPLACE if not listed in sort.txt
foreach $i (keys %matches_str ) {
$pure_code = $i;
$pure_code =~ s/^(eng||rus||arm)\/(\d+)\.htm$/$2/;
$HoPlace{$pure_code}= $MAXPLACE if $HoPlace{$pure_code} eq undef;
$HoPrefix{$pure_code}=$1; # prefix is eng or rus, suffix is always htm
push (@pure_codes, $pure_code);
}
@sorted_codes= sort statisticaly @pure_codes;
foreach $i (@sorted_codes) {
push(@matches,"$HoPrefix{$i}/$i.htm");
push(@summary,$matches_str{"$HoPrefix{$i}/$i.htm"});
}
} else { # do not do sorting according to sort.txt
foreach $key (sort(keys %matches_str)) {
# sample: key=eng/3209.htm
push(@matches,$key);
push(@summary,$matches_str{$key});
}
}
$total = @matches; $real_total = $total;
$totalnum = int(($total + $result_num)/ $result_num);
$liststart = 0; $listend = $total;
$first = ($liststart + 1); $last = $listend;
if ($listend <= $result_num && $end <= $result_num) { $last = $total; }
open (FT, "$FTMPL");
print "Content-type: text/html\n\n";
while(<FT>){
if (/^(.*)<!--\s+BASE_URL\s+-->(.*)$/) { print $1.$base_url.$2; next } ;
if (/^.*<!--\s+KEY\s+-->.*$/) { print $keyword; next } ;
if (/^.*<!--\s+NRES\s+-->.*$/) { print $real_total; next } ;
if (/^.*<!--\s+RESULT\s+-->.*$/){ &print_res; next } ;
print;
}
sub print_res {
if ($total eq "0"){
print "$STR5\n\n";
} else {
if ($liststart eq "$listend") { $liststart-- ; }
# I #
print "<OL>";
for($liststart; $liststart < $listend; $liststart++) {
if ($matches[$liststart]) {
$match = $matches[$liststart];
$summary = $summary[$liststart];
# I #
print "<LI>";
print "<b><a href=\"$base_url/$match\" TARGET=\"\_top\">$matches_head{$match}</a></b><br>\n";
# I #
print "<UL>";
print "$summary<br>" if $show_summary;
# I #
print "</UL>";
print "\n\n";
}
}
# I #
print "</OL>";
}
}
################
# sub routines #
################
sub print_header {
my $lng= $_[0];
if ($lng eq "rus"){
$TITLE='<TITLE>ÑÏÞÐ / Ðåçóëüòàòû ïîèñêà</TITLE>';
$MAIN_STR0="Ðåçóëüòàòû ïîèñêà â ";
$MAIN_STR='Èíôîðìàöèîííîé áàçå ÑÏÞÐ';
$LNG_SWITCH_STR="Search in english";
$CHARSET='charset=windows-1251';
$SPSR_STR="Ïîèñêîâàÿ ñòðàíèöà";
}
if ($lng eq "arm"){
$TITLE='<TITLE>(ARM)Spyur / Search results</TITLE>';
$MAIN_STR0="(ARM)Search results in ";
$MAIN_STR="(ARM)Spyur Data Base";
$LNG_SWITCH_STR="(ARM)Search in russian";
$SPSR_STR="(ARM)Search page";
$CHARSET='charset=utf-8';
}
else{
$TITLE='<TITLE>Spyur / Search results</TITLE>';
$MAIN_STR0="Search results in ";
$MAIN_STR="Spyur Data Base";
$LNG_SWITCH_STR="Search in russian";
$SPSR_STR="Search page";
$CHARSET='';
}
$TD1="<TD> <CENTER>";
$TR1="<TR valign=\"TOP\">";
print "Content-type: text/html\n\n";
print <<EOF;
<HTML>
<HEAD>
<style type="text/css">
<!--
A:link {text-decoration: none}
A:visited {text-decoration: none; color: blue;}
A:active {text-decoration: none}
A:link {color: blue;}
A:hover {color: red;}
-->
</style>
<meta http-equiv="Content-Type" content="text/html; $CHARSET">
$TITLE
<target="_top">
</HEAD>
<BODY BGCOLOR="#F6F6E0">
EOF
# <META HTTP-EQUIV="pragma" CONTENT="no-cache">
print "<TABLE width=\"100\% border=2 cellpadding=8 cellspacing=0>";
print $TR1;
print "<TD ALIGN=LEFT> $MAIN_STR0<A HREF=\"$URL_MAIN\">$MAIN_STR</A></TD>";
print "<TD ALIGN=CENTER> <A HREF=\"$URL_SPSR\">$SPSR_STR</A></TD>\n";
print "<TD ALIGN=RIGHT> <A HREF=\"$URL_LNG_SWITCH\">$LNG_SWITCH_STR</A></TD>\n";
print "</TR></TABLE><HR>";
}
sub statisticaly{
return ( $HoPlace { $a } <=> $HoPlace { $b });
}
sub cgiError
{
my ($error_cause,$error) = @_;
if ($error_cause eq "") { $error_cause = "Error:"; }
if ($error eq "") { $error = "The script encountered problems and terminated"; }
print "<h3>$error_cause</h3>$error<br><br>";
exit;
}
close FD if $debug;
exit;
|
|
Юникод (UTF-8) в PERL, Преобразование регистра строки UTF-8 
Загрузка ...
