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