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

Diff for /db/prgsrc/updateRS.pl between versions 1.1 and 1.4

version 1.1, 2001/10/31 03:00:10 version 1.4, 2002/06/15 02:55:01
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
   
 updateRS.pl QuestionNumber  updateRS.pl QuestionNumber
   
 updateRS.pl  updateRS.pl 
   
   
 =head1 DESCRIPTION  =head1 DESCRIPTION
   
 Скрипт ищет в таблице Questions вопросы с нулевым ProcessedBySearch,  Скрипт ищет в таблице Questions вопросы с нулевым ProcessedBySearch,
 добавляет информацию в таблицы word2question, nests, nf. Поле  добавляет информацию в таблицы word2question, nests, nf. Поле 
 ProcessedBySearch устанавливается в 1. Обрабатывает QuestionNumber  ProcessedBySearch устанавливается в 1. Обрабатывает QuestionNumber
 вопросов. Если параметр QuestionNumber не указан, работает пока не  вопросов. Если параметр QuestionNumber не указан, работает пока не 
 обработает все вопросы.  обработает все вопросы.
   
   
   
 =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;
   use dbchgk;
   
 do "common.pl";  
 do "chgk.cnf";  do "common.pl";
                require "check.pl";  do "chgk.cnf";
   require "check.pl";
 open (STDERR,">$stderr") if $stderr;  
   open (STDERR,">$stderr") if $stderr;
   
 open (UNKNOWN,">$unknown");  
   open (UNKNOWN,">$unknown");
 $qlimit=shift||500000;  
   $qlimit=shift||500000;
            
 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";
   
 $sch=0;  
 while ((++$sch<=$qlimit) && (($id, @ss) = getrow, $id))  $sch=0;
 {  while ((++$sch<=$qlimit) && (($id, @ss) = getrow, $id)) 
    if ($forbidden{$id}) {next};  {
    print "\n$id ";  #   if ($forbidden{$id}) {next};
    foreach $fieldnumber (0..$#ss) #перебираем поля     print "\n$id ";
    {     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=$list[$wordnumber];        {
              $word=$list[$wordnumber];
            if (@n=knownword(uc $word))  
            {             if (@n=knownword(uc $word)) 
                 incnf($_) foreach @n;             {
                 updateword2question($_,packword($fieldnumber, $id,$wordnumber),1)                  incnf($_) foreach @n;
                      foreach (@n);                  updateword2question($_,packword($fieldnumber, $id,$wordnumber),1)
 print ".";                       foreach (@n);
            }  print ".";
            else {             }
              if ($word=~/^${RLrl}+$/o){ # Русское слово             else {
             # проанализировать по таблице аффиксов,               if ($word=~/^${RLrl}+$/o){ # Русское слово
             # проверить наличие начальных форм в              # проанализировать по таблице аффиксов, 
             # nf, а если таких нет, то              # проверить наличие начальных форм в 
             # и по словарю.              # nf, а если таких нет, то 
                            # и по словарю. 
                $nf=&checkit(uc $word,\%words);                
 print "!";                 $nf=&checkit(uc $word,\%words);
                if (!$nf) {  print "!";
                            $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=knownnf($f))                     ($f,$flag)=split '/', $n;
                    {                     if ($nfnumber=knownnf($f))
                        addnest(uc $word,$nfnumber);                     {
                        incnf($nfnumber);                         addnest(uc $word,$nfnumber);
                        updateword2question($nfnumber,packword($fieldnumber,                         incnf($nfnumber);
                           $id,$wordnumber),1)                                   updateword2question($nfnumber,packword($fieldnumber,
                    }                            $id,$wordnumber),1)           
                    else                     }
                    {                     else 
                       $nfnumber=addnf(0, $f, $flag,1);                     {
                       addnest(uc $word,$nfnumber);                        $nfnumber=addnf(0, $f, $flag,1);
                       updateword2question($nfnumber,packword($fieldnumber,                        addnest(uc $word,$nfnumber);
                           $id,$wordnumber),0)                                  updateword2question($nfnumber,packword($fieldnumber,
                    }                            $id,$wordnumber),0)           
                }                     }
            }                 }
              }
       }  
    }        }
    searchmark($id);     }
 }     searchmark($id);
   }
   
   
   
Removed from v.1.1  
changed lines
  Added in v.1.4

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