Annotation of db/prgsrc/updateRS3.pl, revision 1.1

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>