#!/usr/bin/perl -w
=head1 NAME
updateRS.pl - Скрипт для занесения в таблицы русского поиска базы
B<$base> информации о вопросах
=head1 SYNOPSIS
updateRS.pl QuestionNumber
updateRS.pl
=head1 DESCRIPTION
Скрипт ищет в таблице Questions вопросы с нулевым ProcessedBySearch,
добавляет информацию в таблицы word2question, nests, nf. Поле
ProcessedBySearch устанавливается в 1. Обрабатывает QuestionNumber
вопросов. Если параметр QuestionNumber не указан, работает пока не
обработает все вопросы.
=head1 AUTHOR
Роман Семизаров
=cut
use locale;
use DBI;
use POSIX qw (locale_h);
use lib "../lib";
use chgkfiles;
use dbchgk;
do "common.pl";
do "chgk.cnf";
require "check.pl";
open (STDERR,">$stderr") if $stderr;
open (UNKNOWN,">$unknown");
$qlimit=shift||500000;
my $nf;
#open WARN, ">$warnings";
%forbidden=checktable('equalto')? getequalto : ();
if ((uc 'а') ne 'А') {die "!Koi8-r locale not installed!\n"};
getquestions(QuestionId, Question, Answer, Comments, Authors, Sources,"ProcessedBySearch IS NULL");
print "Loading dictionaries\n";
die "No dictionaries! Check your chgk.cnf" unless scalar @dictionaries;
foreach $d(@dictionaries)
{
print "Loading $d\n";
open (DICT, $d) || print " Not found\n";
while ( <DICT> )
{
chomp;
s/\s*$//;
($aa,$b)=split(/\//);
$a= uc $aa;
$words{$a}.=$b || "!";
}
close(DICT);
}
die "No dictionaries found! Check your chgk.cnf" unless scalar keys %words;
print "Getting words...\n";
$sch=0;
while ((++$sch<=$qlimit) && (($id, @ss) = getrow, $id))
{
# if ($forbidden{$id}) {next};
print "\n$id ";
foreach $fieldnumber (0..$#ss) #перебираем поля
{
$text=$ss[$fieldnumber];
next unless $text;
$text=~tr/ёЁ/еЕ/;
$text=~s/(${RLrl})p(${RLrl})/$1p$2/gom;
$text=~s/p(${RLrl})/р$1/gom;
$text=~s/(${RLrl})p/$1р/gom;
$text=~s/\s+/ /gmo;
@list= $text=~m/(?:(?:${RLrl})+)|(?:[A-Za-z0-9]+)/gom;
foreach $wordnumber(0..$#list)
{
$word=$list[$wordnumber];
if (@n=knownword(uc $word))
{
incnf($_) foreach @n;
updateword2question($_,packword($fieldnumber, $id,$wordnumber),1)
foreach (@n);
print ".";
}
else {
if ($word=~/^${RLrl}+$/o){ # Русское слово
# проанализировать по таблице аффиксов,
# проверить наличие начальных форм в
# nf, а если таких нет, то
# и по словарю.
$nf=&checkit(uc $word,\%words);
print "!";
if (!$nf) {
$nf=(uc $word)."/!";
print UNKNOWN "$nf\n" if $unknown;
}
} else {# нерусское слово
$nf=(uc $word)."/!";
print UNKNOWN "$nf\n" if $unknown;
}
foreach $n (split ' ', $nf)
{
($f,$flag)=split '/', $n;
if ($nfnumber=knownnf($f))
{
addnest(uc $word,$nfnumber);
incnf($nfnumber);
updateword2question($nfnumber,packword($fieldnumber,
$id,$wordnumber),1)
}
else
{
$nfnumber=addnf(0, $f, $flag,1);
addnest(uc $word,$nfnumber);
updateword2question($nfnumber,packword($fieldnumber,
$id,$wordnumber),0)
}
}
}
}
}
searchmark($id);
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>