Return to makecheck.pl CVS log

Up to [Local Repository] / db / prgsrc

Annotation of db/prgsrc/makecheck.pl, revision 1.3

1.2       boris       1: #!/usr/bin/perl -w
                      2: 
                      3: =head1 NAME
                      4: 
                      5: makecheck.pl - скрипт для создания, функции, проверяющего слова
                      6: на предмет наличия в словаре.
                      7: 
                      8: =head1 SYNOPSIS
                      9: 
1.3     ! boris      10: makecheck.pl
1.2       boris      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);
1.3     ! boris      32: use lib "../lib";
1.2       boris      33: use chgkfiles;
                     34: 
1.3     ! boris      35: do "../bin/common.pl";
1.2       boris      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: