Return to makecheck.pl CVS log

Up to [Local Repository] / db / prgsrc

changed libs

    1: #!/usr/bin/perl -w
    2: 
    3: =head1 NAME
    4: 
    5: makecheck.pl - скрипт для создания, функции, проверяющего слова
    6: на предмет наличия в словаре.
    7: 
    8: =head1 SYNOPSIS
    9: 
   10: makecheck.pl
   11: 
   12: 
   13: =head1 BUGS
   14: 
   15: На самом деле используется упрощённый формат описания 
   16: аффиксов. Существенны только строчки "prefix", "suffix" 
   17: и строчки, в которых встречается знак ">". Причём 
   18: любая такая строка (кроме закомментированных) 
   19: будет считаться строкой описания аффикса.
   20: 
   21: 
   22: =head1 AUTHOR
   23: 
   24: Роман Семизаров
   25: 
   26: =cut
   27: 
   28: 
   29: 
   30: use locale;
   31: use POSIX qw (locale_h);
   32: use lib "../lib";
   33: use chgkfiles;
   34: 
   35: do "../bin/common.pl";
   36: 
   37: if ((uc 'а') ne 'А') {die "!Koi8-r locale not installed!\n"};
   38: 
   39: 
   40: input_files(RULES);
   41: 
   42: output_files(CHECK);
   43: 
   44: myprint (CHECK, "#!perl\n\n");
   45: 
   46: auto_message(CHECK, "makecheck.pl");
   47: 
   48: 
   49: myprint(CHECK, 'sub checkit {my $nf=\'\'; my $a; my ($uword,$words)=@_; ');
   50: 
   51: 
   52: 
   53: while ( ($sha,$_)=getstring("\s*>\s*",RULES),$sha )
   54: {
   55:     $sha =~ s/\s+//g;
   56:     s/\s+//g;
   57:     if ( $sha =~ m/^flag\s*\*(.):/ )
   58:     {
   59:         $flag=$1;
   60:     }
   61: 
   62:     if ($_)
   63:     {
   64:         s/(\#.*)$//g;
   65:         ($f,$s)=split(",");
   66: 
   67: 
   68:         if (!$s) {$s = $f; $f=""};
   69:         $f=~s/^-//;
   70: 
   71:         if ( $sha eq "." )
   72:         {
   73:             $sha="";
   74:         }
   75:         
   76:         if ( $s eq "-")
   77:         { 
   78:           $s=""
   79:         }
   80:         $sha= $sha."\$";
   81:         $s= $s."\$";
   82: 
   83: myprint (CHECK, "\n\n#-------------------------------------\n\n"); 
   84: 
   85:         myprint (CHECK, "
   86:            \$\_=\$uword;
   87:            if ((s/$s/$f/) && (m/$sha/) &&  (\$a=\$\$words{\$\_}) && (\$a=~m/$flag/))
   88:            \{
   89:                \$nf.=\"\$\_/$flag \";
   90:            \}");
   91:       }
   92: 
   93: }
   94: 
   95:         myprint (CHECK, "
   96:            \$\_=\$uword;
   97:            if (\$\$words{\$\_})
   98:            \{
   99:                \$nf.=\"\$\_/! \";
  100:            \}
  101:           return \$nf;
  102:          ");
  103: 
  104: 
  105: myprint (CHECK,"} 1\n")
  106: 
  107: 
  108: