Return to makecheck.pl CVS log

Up to [Local Repository] / db / prgsrc

KOIfication and Unixation...

    1: #!/usr/bin/perl -w
    2: 
    3: =head1 NAME
    4: 
    5: makecheck.pl - скрипт для создания, функции, проверяющего слова
    6: на предмет наличия в словаре.
    7: 
    8: =head1 SYNOPSIS
    9: 
   10: aff2pl.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 chgkfiles;
   33: 
   34: do "common.pl";
   35: 
   36: if ((uc 'а') ne 'А') {die "!Koi8-r locale not installed!\n"};
   37: 
   38: 
   39: input_files(RULES);
   40: 
   41: output_files(CHECK);
   42: 
   43: myprint (CHECK, "#!perl\n\n");
   44: 
   45: auto_message(CHECK, "makecheck.pl");
   46: 
   47: 
   48: myprint(CHECK, 'sub checkit {my $nf=\'\'; my $a; my ($uword,$words)=@_; ');
   49: 
   50: 
   51: 
   52: while ( ($sha,$_)=getstring("\s*>\s*",RULES),$sha )
   53: {
   54:     $sha =~ s/\s+//g;
   55:     s/\s+//g;
   56:     if ( $sha =~ m/^flag\s*\*(.):/ )
   57:     {
   58:         $flag=$1;
   59:     }
   60: 
   61:     if ($_)
   62:     {
   63:         s/(\#.*)$//g;
   64:         ($f,$s)=split(",");
   65: 
   66: 
   67:         if (!$s) {$s = $f; $f=""};
   68:         $f=~s/^-//;
   69: 
   70:         if ( $sha eq "." )
   71:         {
   72:             $sha="";
   73:         }
   74:         
   75:         if ( $s eq "-")
   76:         { 
   77:           $s=""
   78:         }
   79:         $sha= $sha."\$";
   80:         $s= $s."\$";
   81: 
   82: myprint (CHECK, "\n\n#-------------------------------------\n\n"); 
   83: 
   84:         myprint (CHECK, "
   85:            \$\_=\$uword;
   86:            if ((s/$s/$f/) && (m/$sha/) &&  (\$a=\$\$words{\$\_}) && (\$a=~m/$flag/))
   87:            \{
   88:                \$nf.=\"\$\_/$flag \";
   89:            \}");
   90:       }
   91: 
   92: }
   93: 
   94:         myprint (CHECK, "
   95:            \$\_=\$uword;
   96:            if (\$\$words{\$\_})
   97:            \{
   98:                \$nf.=\"\$\_/! \";
   99:            \}
  100:           return \$nf;
  101:          ");
  102: 
  103: 
  104: myprint (CHECK,"} 1\n")
  105: 
  106: 
  107: