![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to updateRS3.pl CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Local Repository] / db / prgsrc|
Return to updateRS3.pl CVS log | Up to [Local Repository] / db / prgsrc |
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: хэшей, это означает, что при следующем запуске скрипт продолжит работу с места
1.2 roma7 30: остановки (обнулится только счётчик обработанных вопросов).
1.1 roma7 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;
1.4 ! boris 56: my $DUMPDIR = $ENV{DUMPDIR} || "../dump";
! 57: open (STDERR,">$DUMPDIR/errors");
1.1 roma7 58: my $initime=time;
1.4 ! boris 59: open TIME, ">$DUMPDIR/time";
1.1 roma7 60: do "common.pl";
61: do "chgk.cnf";
62:
63: use DB_File;
64:
65:
1.3 roma7 66: $stopslovo{'В'}=1;
67: $stopslovo{'С'}=1;
68: $stopslovo{'ИЗ'}=1;
69: $stopslovo{'НА'}=1;
70: $stopslovo{'И'}=1;
71: $stopslovo{'К'}=1;
1.1 roma7 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;
1.3 roma7 184: next if $stopslovo{$word};
1.1 roma7 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: