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>