Return to updateRS.pl CVS log

Up to [Local Repository] / db / prgsrc

Annotation of db/prgsrc/updateRS.pl, revision 1.2

1.2     ! boris       1: #!/usr/bin/perl -w
        !             2: 
        !             3: =head1 NAME
        !             4: 
        !             5: updateRS.pl - Скрипт для занесения в таблицы русского поиска базы 
        !             6: B<$base> информации о вопросах 
        !             7: 
        !             8: =head1 SYNOPSIS
        !             9: 
        !            10: updateRS.pl QuestionNumber
        !            11: 
        !            12: updateRS.pl 
        !            13: 
        !            14: 
        !            15: =head1 DESCRIPTION
        !            16: 
        !            17: Скрипт ищет в таблице Questions вопросы с нулевым ProcessedBySearch,
        !            18: добавляет информацию в таблицы word2question, nests, nf. Поле 
        !            19: ProcessedBySearch устанавливается в 1. Обрабатывает QuestionNumber
        !            20: вопросов. Если параметр QuestionNumber не указан, работает пока не 
        !            21: обработает все вопросы.
        !            22: 
        !            23: 
        !            24: 
        !            25: =head1 AUTHOR
        !            26: 
        !            27: Роман Семизаров
        !            28: 
        !            29: 
        !            30: =cut
        !            31: 
        !            32: 
        !            33: use locale;
        !            34: use DBI;
        !            35: use POSIX qw (locale_h);
        !            36: use chgkfiles;
        !            37: use dbchgk;
        !            38: 
        !            39: 
        !            40: do "common.pl";
        !            41: do "chgk.cnf";
        !            42:                require "check.pl";
        !            43: 
        !            44: open (STDERR,">$stderr") if $stderr;
        !            45: 
        !            46: 
        !            47: open (UNKNOWN,">$unknown");
        !            48: 
        !            49: $qlimit=shift||500000;
        !            50: 
        !            51:           
        !            52: my $nf;
        !            53: 
        !            54: #open WARN, ">$warnings";
        !            55: 
        !            56: %forbidden=checktable('equalto')? getequalto : ();
        !            57: 
        !            58: 
        !            59: if ((uc 'а') ne 'А') {die "!Koi8-r locale not installed!\n"};
        !            60: 
        !            61: getquestions(QuestionId, Question, Answer, Comments, Authors, Sources,"ProcessedBySearch IS NULL");
        !            62: 
        !            63: 
        !            64: 
        !            65: print "Loading dictionaries\n";
        !            66: 
        !            67: die "No dictionaries! Check your chgk.cnf" unless scalar @dictionaries;
        !            68: 
        !            69: foreach $d(@dictionaries)
        !            70: {
        !            71:      print "Loading $d\n";
        !            72:      open (DICT, $d) || print "              Not found\n";
        !            73:      while ( <DICT> )
        !            74:      {
        !            75:        chomp;
        !            76:        s/\s*$//;
        !            77:                ($aa,$b)=split(/\//);
        !            78:        $a= uc $aa;
        !            79:        $words{$a}.=$b || "!";
        !            80:      }
        !            81:      close(DICT);
        !            82: }
        !            83: 
        !            84: die "No dictionaries found! Check your chgk.cnf" unless scalar keys %words;
        !            85: 
        !            86: 
        !            87: print "Getting words...\n";
        !            88: 
        !            89: 
        !            90: $sch=0;
        !            91: while ((++$sch<=$qlimit) && (($id, @ss) = getrow, $id)) 
        !            92: {
        !            93:    if ($forbidden{$id}) {next};
        !            94:    print "\n$id ";
        !            95:    foreach $fieldnumber (0..$#ss) #перебираем поля
        !            96:    {
        !            97:       $text=$ss[$fieldnumber];
        !            98:       next unless $text;
        !            99:       $text=~tr/ёЁ/еЕ/;
        !           100:       $text=~s/(${RLrl})p(${RLrl})/$1p$2/gom;
        !           101:       $text=~s/p(${RLrl})/р$1/gom;
        !           102:       $text=~s/(${RLrl})p/$1р/gom;
        !           103:       $text=~s/\s+/ /gmo;
        !           104:       @list= $text=~m/(?:(?:${RLrl})+)|(?:[A-Za-z0-9]+)/gom;
        !           105: 
        !           106:       foreach $wordnumber(0..$#list)
        !           107:       {
        !           108:            $word=$list[$wordnumber];
        !           109: 
        !           110:            if (@n=knownword(uc $word)) 
        !           111:            {
        !           112:                 incnf($_) foreach @n;
        !           113:                 updateword2question($_,packword($fieldnumber, $id,$wordnumber),1)
        !           114:                      foreach (@n);
        !           115: print ".";
        !           116:            }
        !           117:            else {
        !           118:              if ($word=~/^${RLrl}+$/o){ # Русское слово
        !           119:             # проанализировать по таблице аффиксов, 
        !           120:             # проверить наличие начальных форм в 
        !           121:             # nf, а если таких нет, то 
        !           122:             # и по словарю. 
        !           123:               
        !           124:                $nf=&checkit(uc $word,\%words);
        !           125: print "!";
        !           126:                if (!$nf) {
        !           127:                            $nf=(uc $word)."/!";
        !           128:                            print UNKNOWN "$nf\n" if $unknown;
        !           129:                          }
        !           130: 
        !           131:               }  else {# нерусское слово
        !           132:                          $nf=(uc $word)."/!";
        !           133:                          print UNKNOWN "$nf\n" if $unknown;
        !           134:                       }
        !           135: 
        !           136:                foreach $n (split ' ', $nf)
        !           137:                {
        !           138:                    ($f,$flag)=split '/', $n;
        !           139:                    if ($nfnumber=knownnf($f))
        !           140:                    {
        !           141:                        addnest(uc $word,$nfnumber);
        !           142:                        incnf($nfnumber);
        !           143:                        updateword2question($nfnumber,packword($fieldnumber,
        !           144:                           $id,$wordnumber),1)           
        !           145:                    }
        !           146:                    else 
        !           147:                    {
        !           148:                       $nfnumber=addnf(0, $f, $flag,1);
        !           149:                       addnest(uc $word,$nfnumber);
        !           150:                       updateword2question($nfnumber,packword($fieldnumber,
        !           151:                           $id,$wordnumber),0)           
        !           152:                    }
        !           153:                }
        !           154:            }
        !           155: 
        !           156:       }
        !           157:    }
        !           158:    searchmark($id);
        !           159: }
        !           160: 
        !           161: 
        !           162: