[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.2

version 1.1, 2001/10/31 03:00:10 version 1.2, 2001/10/31 03:07:29
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 chgkfiles;
 use dbchgk;  use dbchgk;
   
   
 do "common.pl";  do "common.pl";
 do "chgk.cnf";  do "chgk.cnf";
                require "check.pl";                 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";       print "Loading $d\n";
      open (DICT, $d) || print "              Not found\n";       open (DICT, $d) || print "              Not found\n";
      while ( <DICT> )       while ( <DICT> )
      {       {
         chomp;          chomp;
         s/\s*$//;          s/\s*$//;
         ($aa,$b)=split(/\//);          ($aa,$b)=split(/\//);
         $a= uc $aa;          $a= uc $aa;
         $words{$a}.=$b || "!";          $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;  $sch=0;
 while ((++$sch<=$qlimit) && (($id, @ss) = getrow, $id))  while ((++$sch<=$qlimit) && (($id, @ss) = getrow, $id)) 
 {  {
    if ($forbidden{$id}) {next};     if ($forbidden{$id}) {next};
    print "\n$id ";     print "\n$id ";
    foreach $fieldnumber (0..$#ss) #перебираем поля     foreach $fieldnumber (0..$#ss) #перебираем поля
    {     {
       $text=$ss[$fieldnumber];        $text=$ss[$fieldnumber];
       next unless $text;        next unless $text;
       $text=~tr/ёЁ/еЕ/;        $text=~tr/ёЁ/еЕ/;
       $text=~s/(${RLrl})p(${RLrl})/$1p$2/gom;        $text=~s/(${RLrl})p(${RLrl})/$1p$2/gom;
       $text=~s/p(${RLrl})/р$1/gom;        $text=~s/p(${RLrl})/р$1/gom;
       $text=~s/(${RLrl})p/$1р/gom;        $text=~s/(${RLrl})p/$1р/gom;
       $text=~s/\s+/ /gmo;        $text=~s/\s+/ /gmo;
       @list= $text=~m/(?:(?:${RLrl})+)|(?:[A-Za-z0-9]+)/gom;        @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;                  incnf($_) foreach @n;
                 updateword2question($_,packword($fieldnumber, $id,$wordnumber),1)                  updateword2question($_,packword($fieldnumber, $id,$wordnumber),1)
                      foreach (@n);                       foreach (@n);
 print ".";  print ".";
            }             }
            else {             else {
              if ($word=~/^${RLrl}+$/o){ # Русское слово               if ($word=~/^${RLrl}+$/o){ # Русское слово
             # проанализировать по таблице аффиксов,              # проанализировать по таблице аффиксов, 
             # проверить наличие начальных форм в              # проверить наличие начальных форм в 
             # nf, а если таких нет, то              # nf, а если таких нет, то 
             # и по словарю.              # и по словарю. 
                              
                $nf=&checkit(uc $word,\%words);                 $nf=&checkit(uc $word,\%words);
 print "!";  print "!";
                if (!$nf) {                 if (!$nf) {
                            $nf=(uc $word)."/!";                             $nf=(uc $word)."/!";
                            print UNKNOWN "$nf\n" if $unknown;                             print UNKNOWN "$nf\n" if $unknown;
                          }                           }
   
               }  else {# нерусское слово                }  else {# нерусское слово
                          $nf=(uc $word)."/!";                           $nf=(uc $word)."/!";
                          print UNKNOWN "$nf\n" if $unknown;                           print UNKNOWN "$nf\n" if $unknown;
                       }                        }
   
                foreach $n (split ' ', $nf)                 foreach $n (split ' ', $nf)
                {                 {
                    ($f,$flag)=split '/', $n;                     ($f,$flag)=split '/', $n;
                    if ($nfnumber=knownnf($f))                     if ($nfnumber=knownnf($f))
                    {                     {
                        addnest(uc $word,$nfnumber);                         addnest(uc $word,$nfnumber);
                        incnf($nfnumber);                         incnf($nfnumber);
                        updateword2question($nfnumber,packword($fieldnumber,                         updateword2question($nfnumber,packword($fieldnumber,
                           $id,$wordnumber),1)                                      $id,$wordnumber),1)           
                    }                     }
                    else                     else 
                    {                     {
                       $nfnumber=addnf(0, $f, $flag,1);                        $nfnumber=addnf(0, $f, $flag,1);
                       addnest(uc $word,$nfnumber);                        addnest(uc $word,$nfnumber);
                       updateword2question($nfnumber,packword($fieldnumber,                        updateword2question($nfnumber,packword($fieldnumber,
                           $id,$wordnumber),0)                                      $id,$wordnumber),0)           
                    }                     }
                }                 }
            }             }
   
       }        }
    }     }
    searchmark($id);     searchmark($id);
 }  }
   
   
   
Removed from v.1.1  
changed lines
  Added in v.1.2

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