Return to updateRS.pl CVS log

Up to [Local Repository] / db / prgsrc

*** empty log message ***

#!/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);
}