Return to makecheck.pl CVS log

Up to [Local Repository] / db / prgsrc

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

1.2     ! boris       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: