Return to updateRS3.pl CVS log

Up to [Local Repository] / db / prgsrc

Added $DUMPDIR

#!/usr/bin/perl -w

=head1 NAME

updateRS.pl - Скрипт для занесения в таблицы русского поиска базы 
B<$base> информации о вопросах. Использует DB_File.

=head1 SYNOPSIS

updateRS1.pl Questions_per_cicle cicles_number

updateRS.pl Questions_per_cicle

updateRS.pl


=head1 DESCRIPTION

Скрипт ищет в таблице Questions вопросы с нулевым ProcessedBySearch,
добавляет информацию в таблицы word2question, nests, nf. Поле 
ProcessedBySearch устанавливается в 1. Обрабатывает 
Questions_per_cicle*cicles_number вопросов, сбрасывая 
информацию в базу каждые Questions_per_cicle вопросов.
Значения по умолчанию:
Questions_per_cicle=500;
cicles_number=1.

Создание в рабочем каталоге файла RS_pause прерывает работу с сохранением 
хэшей, это означает, что при следующем запуске скрипт продолжит работу с места
остановки (обнулится только счётчик обработанных вопросов). 
Продолжить крайне желательно, потому что у обработанные вопросах 
уже установлен флаг ProcessedBySearch, но реально информация о них в базу
ещё не занесена.

Создание в рабочем каталоге файла RS_stop инициирует процесс завершения 
работы скрипта, с предварительным занесением информации об обработанных 
вопросах в базу.

Оба файла убиваются по окончании работы.

=head1 AUTHOR

Роман Семизаров


=cut



use locale;
use DBI;
use POSIX qw (locale_h);
use lib "../lib";
use chgkfiles;
use dbchgk;
my $DUMPDIR = $ENV{DUMPDIR} || "../dump";
open (STDERR,">$DUMPDIR/errors");
my $initime=time;
open TIME, ">$DUMPDIR/time"; 
do "common.pl";
do "chgk.cnf";

use DB_File;


$stopslovo{'В'}=1;
$stopslovo{'С'}=1;
$stopslovo{'ИЗ'}=1;
$stopslovo{'НА'}=1;
$stopslovo{'И'}=1;
$stopslovo{'К'}=1;


$qlimit=shift||500;
$times=shift||1;

die "Undefined \$maxwsize! check your chgk.cnf" unless $maxwsize;

require "check.pl";

open (STDERR,">$stderr") if $stderr;


open (UNKNOWN,">$unknown");


          
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");




tie %words, 'DB_File', 'words.tmp';

if (!(scalar keys %words))
{
   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(/\//);
       	$aa=~tr/ёЁ/еЕ/;
    	$a= uc $aa;
    	$words{$a}.=$b || "!";
     }
     close(DICT);
  }
}

die "No dictionaries found! Check your chgk.cnf" unless scalar keys %words;



print TIME "\t\t".(time-$initime)."\n";

for my $commonI(1..$times)
{




tie %nf, 'DB_File', 'nf.tmp';
tie %nfnumber, 'DB_File', 'nfnumber.tmp';
tie %newnf, 'DB_File', 'newnf.tmp';
tie %neww2k, 'DB_File', 'neww2k.tmp';



if (!((scalar keys %nf)||(scalar keys %newnf)))
{
   print "loading nests\n";
   %nf=getnests;
   %nfnumber=getnfnumbers;
}
                   


print "Getting words...\n";

getquestions(QuestionId, Question, Answer, Comments, Authors, Sources,"ProcessedBySearch IS NULL");
$sch=0;
while ((++$sch<=$qlimit) && (($id, @ss) = getrow, $id)) 
                             # берём по одному вопросу
                             # и вешаем в массив, индексы которого -- словоформы,
                             # а значения -- списки вопросов. 
{


   if (-e "RS_pause") {unlink("RS_pause"); exit}
   if (-e "RS_stop")  {unlink("RS_stop"); last}
   print "$sch $id\n" ;#unless (++$sch % 1);
   searchmark($id);
   if ($forbidden{$id}) {next};
   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=uc $list[$wordnumber];
           next if length $word>$maxwsize;
           next if $stopslovo{$word};
           if (my $n=$nf{$word}||$newnf{$word}) 
           {
                @n= split ' ',$n;
                $nfkvo{$_}++ foreach @n;
                $neww2k{$_}.=packword($fieldnumber, $id,$wordnumber%256)
                     foreach (@n);
           }
           else {
             if ($word=~/^${RLrl}+$/o){ # Русское слово
            # проанализировать по таблице аффиксов, 
            # проверить наличие начальных форм в 
            # nf, а если таких нет, то 
            # и по словарю. 
              
               $nf=&checkit(uc $word,\%words);
               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=$nfnumber{$f})
                   {
                       $newnf{$word}.=" $nfnumber";
                       $nfkvo{$nfnumber}++;
                       $a=\$neww2k{$nfnumber};
                       $$a.=packword($fieldnumber, $id,$wordnumber);
                       if (length $$a>100) {flushw2k($nfnumber)}
                   }
                   else 
                   {
                      $nfnumber=addnf(0, $f, $flag,1);
                      $newnf{uc $word}.=" $nfnumber";
                      $neww2k{$nfnumber}.=packword($fieldnumber, $id,$wordnumber);
                   }
               }
           }

      }
   }

}


print "Filling word2question...\n";

foreach (keys %neww2k)
{ 
   updateword2question($_,$neww2k{$_});
   delete $neww2k{$_};
}

%neww2k=();

print "Filling nf...\n";
$sch=0;

incnf($_,$nfkvo{$_})  foreach (keys %nfkvo);

%nfkvo=();

print "Filling nests...\n";
$sch=0;


foreach $w (keys %newnf)
{
  print "$sch\n" unless (++$sch % 1000);
  @nf=split ' ',$newnf{$w};
  addnest($w,$_) foreach @nf;
}
print "$sch nests added\n";

print TIME "$commonI: \t$sch ";
print TIME "\t".(time-$initime)."\n";
%newnf=();

}

&untieall;

unlink "words.tmp";
unlink "newnf.tmp";
unlink "neww2k.tmp";
unlink "nfnumber.tmp";
unlink "nf.tmp";

sub flushw2k
{
   my ($n)=@_;
   updateword2question($n,$neww2k{$n});
   delete $neww2k{$_};
}

sub untieall
{
  untie %nf;
  untie %nfnumber;
  untie %newnf;
  untie %neww2k;
  untie %words;
  
}