Return to updateRS3.pl CVS log

Up to [Local Repository] / db / prgsrc

Added $DUMPDIR

    1: #!/usr/bin/perl -w
    2: 
    3: =head1 NAME
    4: 
    5: updateRS.pl - Скрипт для занесения в таблицы русского поиска базы 
    6: B<$base> информации о вопросах. Использует DB_File.
    7: 
    8: =head1 SYNOPSIS
    9: 
   10: updateRS1.pl Questions_per_cicle cicles_number
   11: 
   12: updateRS.pl Questions_per_cicle
   13: 
   14: updateRS.pl
   15: 
   16: 
   17: =head1 DESCRIPTION
   18: 
   19: Скрипт ищет в таблице Questions вопросы с нулевым ProcessedBySearch,
   20: добавляет информацию в таблицы word2question, nests, nf. Поле 
   21: ProcessedBySearch устанавливается в 1. Обрабатывает 
   22: Questions_per_cicle*cicles_number вопросов, сбрасывая 
   23: информацию в базу каждые Questions_per_cicle вопросов.
   24: Значения по умолчанию:
   25: Questions_per_cicle=500;
   26: cicles_number=1.
   27: 
   28: Создание в рабочем каталоге файла RS_pause прерывает работу с сохранением 
   29: хэшей, это означает, что при следующем запуске скрипт продолжит работу с места
   30: остановки (обнулится только счётчик обработанных вопросов). 
   31: Продолжить крайне желательно, потому что у обработанные вопросах 
   32: уже установлен флаг ProcessedBySearch, но реально информация о них в базу
   33: ещё не занесена.
   34: 
   35: Создание в рабочем каталоге файла RS_stop инициирует процесс завершения 
   36: работы скрипта, с предварительным занесением информации об обработанных 
   37: вопросах в базу.
   38: 
   39: Оба файла убиваются по окончании работы.
   40: 
   41: =head1 AUTHOR
   42: 
   43: Роман Семизаров
   44: 
   45: 
   46: =cut
   47: 
   48: 
   49: 
   50: use locale;
   51: use DBI;
   52: use POSIX qw (locale_h);
   53: use lib "../lib";
   54: use chgkfiles;
   55: use dbchgk;
   56: my $DUMPDIR = $ENV{DUMPDIR} || "../dump";
   57: open (STDERR,">$DUMPDIR/errors");
   58: my $initime=time;
   59: open TIME, ">$DUMPDIR/time"; 
   60: do "common.pl";
   61: do "chgk.cnf";
   62: 
   63: use DB_File;
   64: 
   65: 
   66: $stopslovo{'В'}=1;
   67: $stopslovo{'С'}=1;
   68: $stopslovo{'ИЗ'}=1;
   69: $stopslovo{'НА'}=1;
   70: $stopslovo{'И'}=1;
   71: $stopslovo{'К'}=1;
   72: 
   73: 
   74: $qlimit=shift||500;
   75: $times=shift||1;
   76: 
   77: die "Undefined \$maxwsize! check your chgk.cnf" unless $maxwsize;
   78: 
   79: require "check.pl";
   80: 
   81: open (STDERR,">$stderr") if $stderr;
   82: 
   83: 
   84: open (UNKNOWN,">$unknown");
   85: 
   86: 
   87:           
   88: my $nf;
   89: 
   90: #open WARN, ">$warnings";
   91: 
   92: #%forbidden=checktable('equalto')? getequalto : ();
   93: 
   94: 
   95: if ((uc 'а') ne 'А') {die "!Koi8-r locale not installed!\n"};
   96: 
   97: getquestions(QuestionId, Question, Answer, Comments, Authors, Sources,"ProcessedBySearch IS NULL");
   98: 
   99: 
  100: 
  101: 
  102: tie %words, 'DB_File', 'words.tmp';
  103: 
  104: if (!(scalar keys %words))
  105: {
  106:    print "Loading dictionaries\n";
  107:    die "No dictionaries! Check your chgk.cnf" unless scalar @dictionaries;
  108:    foreach $d(@dictionaries)
  109:    {
  110:      print "Loading $d\n";
  111:      open (DICT, $d) || print "              Not found\n";
  112:      while ( <DICT> )
  113:      {
  114:      	chomp;
  115:      	s/\s*$//;
  116:        	($aa,$b)=split(/\//);
  117:        	$aa=~tr/ёЁ/еЕ/;
  118:     	$a= uc $aa;
  119:     	$words{$a}.=$b || "!";
  120:      }
  121:      close(DICT);
  122:   }
  123: }
  124: 
  125: die "No dictionaries found! Check your chgk.cnf" unless scalar keys %words;
  126: 
  127: 
  128: 
  129: print TIME "\t\t".(time-$initime)."\n";
  130: 
  131: for my $commonI(1..$times)
  132: {
  133: 
  134: 
  135: 
  136: 
  137: tie %nf, 'DB_File', 'nf.tmp';
  138: tie %nfnumber, 'DB_File', 'nfnumber.tmp';
  139: tie %newnf, 'DB_File', 'newnf.tmp';
  140: tie %neww2k, 'DB_File', 'neww2k.tmp';
  141: 
  142: 
  143: 
  144: if (!((scalar keys %nf)||(scalar keys %newnf)))
  145: {
  146:    print "loading nests\n";
  147:    %nf=getnests;
  148:    %nfnumber=getnfnumbers;
  149: }
  150:                    
  151: 
  152: 
  153: print "Getting words...\n";
  154: 
  155: getquestions(QuestionId, Question, Answer, Comments, Authors, Sources,"ProcessedBySearch IS NULL");
  156: $sch=0;
  157: while ((++$sch<=$qlimit) && (($id, @ss) = getrow, $id)) 
  158:                              # берём по одному вопросу
  159:                              # и вешаем в массив, индексы которого -- словоформы,
  160:                              # а значения -- списки вопросов. 
  161: {
  162: 
  163: 
  164:    if (-e "RS_pause") {unlink("RS_pause"); exit}
  165:    if (-e "RS_stop")  {unlink("RS_stop"); last}
  166:    print "$sch $id\n" ;#unless (++$sch % 1);
  167:    searchmark($id);
  168:    if ($forbidden{$id}) {next};
  169:    foreach $fieldnumber (0..$#ss) #перебираем поля
  170:    {
  171:       $text=$ss[$fieldnumber];
  172:       next unless $text;
  173:       $text=~tr/ёЁ/еЕ/;
  174:       $text=~s/(${RLrl})p(${RLrl})/$1p$2/gom;
  175:       $text=~s/p(${RLrl})/р$1/gom;
  176:       $text=~s/(${RLrl})p/$1р/gom;
  177:       $text=~s/\s+/ /gmo;
  178:       @list= $text=~m/(?:(?:${RLrl})+)|(?:[A-Za-z0-9]+)/gom;
  179: 
  180: foreach $wordnumber(0..$#list)
  181:       {
  182:            $word=uc $list[$wordnumber];
  183:            next if length $word>$maxwsize;
  184:            next if $stopslovo{$word};
  185:            if (my $n=$nf{$word}||$newnf{$word}) 
  186:            {
  187:                 @n= split ' ',$n;
  188:                 $nfkvo{$_}++ foreach @n;
  189:                 $neww2k{$_}.=packword($fieldnumber, $id,$wordnumber%256)
  190:                      foreach (@n);
  191:            }
  192:            else {
  193:              if ($word=~/^${RLrl}+$/o){ # Русское слово
  194:             # проанализировать по таблице аффиксов, 
  195:             # проверить наличие начальных форм в 
  196:             # nf, а если таких нет, то 
  197:             # и по словарю. 
  198:               
  199:                $nf=&checkit(uc $word,\%words);
  200:                if (!$nf) {
  201:                            $nf=(uc $word)."/!";
  202:                            print UNKNOWN "$nf\n" if $unknown;
  203:                          }
  204: 
  205:               }  else {# нерусское слово
  206:                          $nf=(uc $word)."/!";
  207:                          print UNKNOWN "$nf\n" if $unknown;
  208:                       }
  209: 
  210:                foreach $n (split ' ', $nf)
  211:                {
  212:                    ($f,$flag)=split '/', $n;
  213:                    if ($nfnumber=$nfnumber{$f})
  214:                    {
  215:                        $newnf{$word}.=" $nfnumber";
  216:                        $nfkvo{$nfnumber}++;
  217:                        $a=\$neww2k{$nfnumber};
  218:                        $$a.=packword($fieldnumber, $id,$wordnumber);
  219:                        if (length $$a>100) {flushw2k($nfnumber)}
  220:                    }
  221:                    else 
  222:                    {
  223:                       $nfnumber=addnf(0, $f, $flag,1);
  224:                       $newnf{uc $word}.=" $nfnumber";
  225:                       $neww2k{$nfnumber}.=packword($fieldnumber, $id,$wordnumber);
  226:                    }
  227:                }
  228:            }
  229: 
  230:       }
  231:    }
  232: 
  233: }
  234: 
  235: 
  236: print "Filling word2question...\n";
  237: 
  238: foreach (keys %neww2k)
  239: { 
  240:    updateword2question($_,$neww2k{$_});
  241:    delete $neww2k{$_};
  242: }
  243: 
  244: %neww2k=();
  245: 
  246: print "Filling nf...\n";
  247: $sch=0;
  248: 
  249: incnf($_,$nfkvo{$_})  foreach (keys %nfkvo);
  250: 
  251: %nfkvo=();
  252: 
  253: print "Filling nests...\n";
  254: $sch=0;
  255: 
  256: 
  257: foreach $w (keys %newnf)
  258: {
  259:   print "$sch\n" unless (++$sch % 1000);
  260:   @nf=split ' ',$newnf{$w};
  261:   addnest($w,$_) foreach @nf;
  262: }
  263: print "$sch nests added\n";
  264: 
  265: print TIME "$commonI: \t$sch ";
  266: print TIME "\t".(time-$initime)."\n";
  267: %newnf=();
  268: 
  269: }
  270: 
  271: &untieall;
  272: 
  273: unlink "words.tmp";
  274: unlink "newnf.tmp";
  275: unlink "neww2k.tmp";
  276: unlink "nfnumber.tmp";
  277: unlink "nf.tmp";
  278: 
  279: sub flushw2k
  280: {
  281:    my ($n)=@_;
  282:    updateword2question($n,$neww2k{$n});
  283:    delete $neww2k{$_};
  284: }
  285: 
  286: sub untieall
  287: {
  288:   untie %nf;
  289:   untie %nfnumber;
  290:   untie %newnf;
  291:   untie %neww2k;
  292:   untie %words;
  293:   
  294: }
  295: