[BACK]Return to updateRS1.pl CVS log [TXT] [DIR] Up to [Local Repository] / db / prgsrc

Diff for /db/prgsrc/updateRS1.pl between versions 1.1 and 1.3

version 1.1, 2001/10/31 03:00:10 version 1.3, 2001/11/01 01:45:00
Line 1 Line 1
 #!/usr/local/bin/perl -w  #!/usr/bin/perl -w
   
 =head1 NAME  =head1 NAME
   
 updateRS.pl - Скрипт для занесения в таблицы русского поиска базы  updateRS.pl - Скрипт для занесения в таблицы русского поиска базы 
 B<$base> информации о вопросах  B<$base> информации о вопросах 
   
 =head1 SYNOPSIS  =head1 SYNOPSIS
   
 updateRS1.pl Questions_per_cicle cicles_number  updateRS1.pl Questions_per_cicle cicles_number
   
 updateRS.pl Questions_per_cicle  updateRS.pl Questions_per_cicle
   
 updateRS.pl  updateRS.pl
   
   
 =head1 DESCRIPTION  =head1 DESCRIPTION
   
 Скрипт ищет в таблице Questions вопросы с нулевым ProcessedBySearch,  Скрипт ищет в таблице Questions вопросы с нулевым ProcessedBySearch,
 добавляет информацию в таблицы word2question, nests, nf. Поле  добавляет информацию в таблицы word2question, nests, nf. Поле 
 ProcessedBySearch устанавливается в 1. Обрабатывает  ProcessedBySearch устанавливается в 1. Обрабатывает 
 Questions_per_cicle*cicles_number вопросов, сбрасывая  Questions_per_cicle*cicles_number вопросов, сбрасывая 
 информацию в базу каждые Questions_per_cicle вопросов.  информацию в базу каждые Questions_per_cicle вопросов.
 Значения по умолчанию:  Значения по умолчанию:
 Questions_per_cicle=500;  Questions_per_cicle=500;
 cicles_number=1.  cicles_number=1.
   
   
 =head1 AUTHOR  =head1 AUTHOR
   
 Роман Семизаров  Роман Семизаров
   
   
 =cut  =cut
   
   
 use locale;  use locale;
 use DBI;  use DBI;
 use POSIX qw (locale_h);  use POSIX qw (locale_h);
 use chgkfiles;  use lib "../lib";
 use dbchgk;  use chgkfiles;
 open (STDERR,">errors");  use dbchgk;
 my $initime=time;  open (STDERR,">errors");
 open TIME, ">time";  my $initime=time;
 do "common.pl";  open TIME, ">time"; 
 do "chgk.cnf";  do "common.pl";
   do "chgk.cnf";
 $qlimit=shift||500;  
 $times=shift||1;  $qlimit=shift||500;
   $times=shift||1;
 die "Undefined \$maxwsize! check your chgk.cnf" unless $maxwsize;  
   die "Undefined \$maxwsize! check your chgk.cnf" unless $maxwsize;
 require "check.pl";  
   require "check.pl";
 open (STDERR,">$stderr") if $stderr;  
   open (STDERR,">$stderr") if $stderr;
   
 open (UNKNOWN,">$unknown");  
   open (UNKNOWN,">$unknown");
   
            
 my $nf;            
   my $nf;
 #open WARN, ">$warnings";  
   #open WARN, ">$warnings";
 %forbidden=checktable('equalto')? getequalto : ();  
   %forbidden=checktable('equalto')? getequalto : ();
   
 if ((uc 'а') ne 'А') {die "!Koi8-r locale not installed!\n"};  
   if ((uc 'а') ne 'А') {die "!Koi8-r locale not installed!\n"};
 getquestions(QuestionId, Question, Answer, Comments, Authors, Sources,"ProcessedBySearch IS NULL");  
   getquestions(QuestionId, Question, Answer, Comments, Authors, Sources,"ProcessedBySearch IS NULL");
   
   
 print "Loading dictionaries\n";  
   print "Loading dictionaries\n";
 die "No dictionaries! Check your chgk.cnf" unless scalar @dictionaries;  
   die "No dictionaries! Check your chgk.cnf" unless scalar @dictionaries;
 foreach $d(@dictionaries)  
 {  foreach $d(@dictionaries)
      print "Loading $d\n";  {
      open (DICT, $d) || print "              Not found\n";       print "Loading $d\n";
      while ( <DICT> )       open (DICT, $d) || print "              Not found\n";
      {       while ( <DICT> )
         chomp;       {
         s/\s*$//;          chomp;
         ($aa,$b)=split(/\//);          s/\s*$//;
         $a= uc $aa;          ($aa,$b)=split(/\//);
         $words{$a}.=$b || "!";          $a= uc $aa;
      }          $words{$a}.=$b || "!";
      close(DICT);       }
 }       close(DICT);
   }
 die "No dictionaries found! Check your chgk.cnf" unless scalar keys %words;  
   die "No dictionaries found! Check your chgk.cnf" unless scalar keys %words;
   
 print "Getting words...\n";  
   print "Getting words...\n";
 print TIME "\t\t".(time-$initime)."\n";  
   print TIME "\t\t".(time-$initime)."\n";
 for my $commonI(1..$times)  
 {  for my $commonI(1..$times)
   {
   
 print "loading nests\n";  
   print "loading nests\n";
 %nf=getnests;  
   %nf=getnests;
 %nfnumber=getnfnumbers;  
   %nfnumber=getnfnumbers;
 print "Getting words...\n";  
   print "Getting words...\n";
 getquestions(QuestionId, Question, Answer, Comments, Authors, Sources,"ProcessedBySearch IS NULL");  
 $sch=0;  getquestions(QuestionId, Question, Answer, Comments, Authors, Sources,"ProcessedBySearch IS NULL");
 while ((++$sch<=$qlimit) && (($id, @ss) = getrow, $id))  $sch=0;
                              # берём по одному вопросу  while ((++$sch<=$qlimit) && (($id, @ss) = getrow, $id)) 
                              # и вешаем в массив, индексы которого -- словоформы,                               # берём по одному вопросу
                              # а значения -- списки вопросов.                               # и вешаем в массив, индексы которого -- словоформы,
 {                               # а значения -- списки вопросов. 
   {
    print "$sch $id\n" ;#unless (++$sch % 1);  
    searchmark($id);     print "$sch $id\n" ;#unless (++$sch % 1);
    if ($forbidden{$id}) {next};     searchmark($id);
    foreach $fieldnumber (0..$#ss) #перебираем поля     if ($forbidden{$id}) {next};
    {     foreach $fieldnumber (0..$#ss) #перебираем поля
       $text=$ss[$fieldnumber];     {
       next unless $text;        $text=$ss[$fieldnumber];
       $text=~tr/ёЁ/еЕ/;        next unless $text;
       $text=~s/(${RLrl})p(${RLrl})/$1p$2/gom;        $text=~tr/ёЁ/еЕ/;
       $text=~s/p(${RLrl})/р$1/gom;        $text=~s/(${RLrl})p(${RLrl})/$1p$2/gom;
       $text=~s/(${RLrl})p/$1р/gom;        $text=~s/p(${RLrl})/р$1/gom;
       $text=~s/\s+/ /gmo;        $text=~s/(${RLrl})p/$1р/gom;
       @list= $text=~m/(?:(?:${RLrl})+)|(?:[A-Za-z0-9]+)/gom;        $text=~s/\s+/ /gmo;
         @list= $text=~m/(?:(?:${RLrl})+)|(?:[A-Za-z0-9]+)/gom;
 foreach $wordnumber(0..$#list)  
       {  foreach $wordnumber(0..$#list)
            $word=uc $list[$wordnumber];        {
            next if length $word>$maxwsize;             $word=uc $list[$wordnumber];
            if (my $n=$nf{$word}||$newnf{$word})             next if length $word>$maxwsize;
            {             if (my $n=$nf{$word}||$newnf{$word}) 
                 @n= split ' ',$n;             {
                 $nfkvo{$_}++ foreach @n;                  @n= split ' ',$n;
                 $neww2k{$_}.=packword($fieldnumber, $id,$wordnumber%256)                  $nfkvo{$_}++ foreach @n;
                      foreach (@n);                  $neww2k{$_}.=packword($fieldnumber, $id,$wordnumber%256)
            }                       foreach (@n);
            else {             }
              if ($word=~/^${RLrl}+$/o){ # Русское слово             else {
             # проанализировать по таблице аффиксов,               if ($word=~/^${RLrl}+$/o){ # Русское слово
             # проверить наличие начальных форм в              # проанализировать по таблице аффиксов, 
             # nf, а если таких нет, то              # проверить наличие начальных форм в 
             # и по словарю.              # nf, а если таких нет, то 
                            # и по словарю. 
                $nf=&checkit(uc $word,\%words);                
                if (!$nf) {                 $nf=&checkit(uc $word,\%words);
                            $nf=(uc $word)."/!";                 if (!$nf) {
                            print UNKNOWN "$nf\n" if $unknown;                             $nf=(uc $word)."/!";
                          }                             print UNKNOWN "$nf\n" if $unknown;
                            }
               }  else {# нерусское слово  
                          $nf=(uc $word)."/!";                }  else {# нерусское слово
                          print UNKNOWN "$nf\n" if $unknown;                           $nf=(uc $word)."/!";
                       }                           print UNKNOWN "$nf\n" if $unknown;
                         }
                foreach $n (split ' ', $nf)  
                {                 foreach $n (split ' ', $nf)
                    ($f,$flag)=split '/', $n;                 {
                    if ($nfnumber=$nfnumber{$f})                     ($f,$flag)=split '/', $n;
                    {                     if ($nfnumber=$nfnumber{$f})
                        $newnf{$word}.=" $nfnumber";                     {
                        $nfkvo{$nfnumber}++;                         $newnf{$word}.=" $nfnumber";
                        $a=\$neww2k{$nfnumber};                         $nfkvo{$nfnumber}++;
                        $$a.=packword($fieldnumber, $id,$wordnumber);                         $a=\$neww2k{$nfnumber};
                        if (length $$a>100) {flushw2k($nfnumber)}                         $$a.=packword($fieldnumber, $id,$wordnumber);
                    }                         if (length $$a>100) {flushw2k($nfnumber)}
                    else                     }
                    {                     else 
                       $nfnumber=addnf(0, $f, $flag,1);                     {
                       $newnf{uc $word}.=" $nfnumber";                        $nfnumber=addnf(0, $f, $flag,1);
                       $neww2k{$nfnumber}.=packword($fieldnumber, $id,$wordnumber);                        $newnf{uc $word}.=" $nfnumber";
                    }                        $neww2k{$nfnumber}.=packword($fieldnumber, $id,$wordnumber);
                }                     }
            }                 }
              }
       }  
    }        }
      }
 }  
   }
   
 print "Filling word2question...\n";  
   print "Filling word2question...\n";
 foreach (keys %neww2k)  
 {  foreach (keys %neww2k)
    updateword2question($_,$neww2k{$_});  { 
    delete $neww2k{$_};     updateword2question($_,$neww2k{$_});
 }     delete $neww2k{$_};
   }
 %neww2k=();  
   %neww2k=();
 print "Filling nf...\n";  
 $sch=0;  print "Filling nf...\n";
   $sch=0;
 incnf($_,$nfkvo{$_})  foreach (keys %nfkvo);  
   incnf($_,$nfkvo{$_})  foreach (keys %nfkvo);
 %nfkvo=();  
   %nfkvo=();
 print "Filling nests...\n";  
 $sch=0;  print "Filling nests...\n";
   $sch=0;
   
 foreach $w (keys %newnf)  
 {  foreach $w (keys %newnf)
   print "$sch\n" unless (++$sch % 1000);  {
   @nf=split ' ',$newnf{$w};    print "$sch\n" unless (++$sch % 1000);
   addnest($w,$_) foreach @nf;    @nf=split ' ',$newnf{$w};
 }    addnest($w,$_) foreach @nf;
 print "$sch nests added\n";  }
   print "$sch nests added\n";
 print TIME "$commonI: \t$sch ";  
 print TIME "\t".(time-$initime)."\n";  print TIME "$commonI: \t$sch ";
 %newnf=();  print TIME "\t".(time-$initime)."\n";
   %newnf=();
 }  
   }
 sub flushw2k  
 {  sub flushw2k
    my ($n)=@_;  {
    updateword2question($n,$neww2k{$n});     my ($n)=@_;
    delete $neww2k{$_};     updateword2question($n,$neww2k{$n});
 }     delete $neww2k{$_};
   }
Removed from v.1.1  
changed lines
  Added in v.1.3

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