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:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>