Annotation of db/prgsrc/updateRS.pl, revision 1.1
1.1 ! boris 1: #!/usr/local/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:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>