|
version 1.1, 2001/10/31 03:00:10
|
version 1.4, 2001/11/01 01:44:59
|
|
Line 1
|
Line 1
|
| #!perl -w
|
#!/usr/bin/perl -w |
|
|
|
| =head1 NAME
|
=head1 NAME |
|
|
|
| makecheck.pl - скрипт для создания, функции, проверяющего слова
|
makecheck.pl - скрипт для создания, функции, проверяющего слова |
| на предмет наличия в словаре.
|
на предмет наличия в словаре. |
|
|
|
| =head1 SYNOPSIS
|
=head1 SYNOPSIS |
|
|
|
| aff2pl.pl
|
makecheck.pl |
|
|
|
|
|
|
| =head1 BUGS
|
=head1 BUGS |
|
|
|
| На самом деле используется упрощённый формат описания
|
На самом деле используется упрощённый формат описания |
| аффиксов. Существенны только строчки "prefix", "suffix"
|
аффиксов. Существенны только строчки "prefix", "suffix" |
| и строчки, в которых встречается знак ">". Причём
|
и строчки, в которых встречается знак ">". Причём |
| любая такая строка (кроме закомментированных)
|
любая такая строка (кроме закомментированных) |
| будет считаться строкой описания аффикса.
|
будет считаться строкой описания аффикса. |
|
|
|
|
|
|
| =head1 AUTHOR
|
=head1 AUTHOR |
|
|
|
| Роман Семизаров
|
Роман Семизаров |
|
|
|
| =cut
|
=cut |
|
|
|
|
|
|
|
|
|
| use locale;
|
use locale; |
| use POSIX qw (locale_h);
|
use POSIX qw (locale_h); |
| use chgkfiles;
|
use lib "../lib"; |
|
|
use chgkfiles; |
| do "common.pl";
|
|
|
|
do "common.pl"; |
| if ((uc 'а') ne 'А') {die "!Koi8-r locale not installed!\n"};
|
|
|
|
if ((uc 'а') ne 'А') {die "!Koi8-r locale not installed!\n"}; |
|
|
|
| input_files(RULES);
|
|
|
|
input_files(RULES); |
| output_files(CHECK);
|
|
|
|
output_files(CHECK); |
| myprint (CHECK, "#!perl\n\n");
|
|
|
|
myprint (CHECK, "#!perl\n\n"); |
| auto_message(CHECK, "makecheck.pl");
|
|
|
|
auto_message(CHECK, "makecheck.pl"); |
|
|
|
| myprint(CHECK, 'sub checkit {my $nf=\'\'; my $a; my ($uword,$words)=@_; ');
|
|
|
|
myprint(CHECK, 'sub checkit {my $nf=\'\'; my $a; my ($uword,$words)=@_; '); |
|
|
|
|
|
|
| while ( ($sha,$_)=getstring("\s*>\s*",RULES),$sha )
|
|
| {
|
while ( ($sha,$_)=getstring("\s*>\s*",RULES),$sha ) |
| $sha =~ s/\s+//g;
|
{ |
| s/\s+//g;
|
$sha =~ s/\s+//g; |
| if ( $sha =~ m/^flag\s*\*(.):/ )
|
s/\s+//g; |
| {
|
if ( $sha =~ m/^flag\s*\*(.):/ ) |
| $flag=$1;
|
{ |
| }
|
$flag=$1; |
|
|
} |
| if ($_)
|
|
| {
|
if ($_) |
| s/(\#.*)$//g;
|
{ |
| ($f,$s)=split(",");
|
s/(\#.*)$//g; |
|
|
($f,$s)=split(","); |
|
|
|
| if (!$s) {$s = $f; $f=""};
|
|
| $f=~s/^-//;
|
if (!$s) {$s = $f; $f=""}; |
|
|
$f=~s/^-//; |
| if ( $sha eq "." )
|
|
| {
|
if ( $sha eq "." ) |
| $sha="";
|
{ |
| }
|
$sha=""; |
|
|
} |
| if ( $s eq "-")
|
|
| {
|
if ( $s eq "-") |
| $s=""
|
{ |
| }
|
$s="" |
| $sha= $sha."\$";
|
} |
| $s= $s."\$";
|
$sha= $sha."\$"; |
|
|
$s= $s."\$"; |
| myprint (CHECK, "\n\n#-------------------------------------\n\n");
|
|
|
|
myprint (CHECK, "\n\n#-------------------------------------\n\n"); |
| myprint (CHECK, "
|
|
| \$\_=\$uword;
|
myprint (CHECK, " |
| if ((s/$s/$f/) && (m/$sha/) && (\$a=\$\$words{\$\_}) && (\$a=~m/$flag/))
|
\$\_=\$uword; |
| \{
|
if ((s/$s/$f/) && (m/$sha/) && (\$a=\$\$words{\$\_}) && (\$a=~m/$flag/)) |
| \$nf.=\"\$\_/$flag \";
|
\{ |
| \}");
|
\$nf.=\"\$\_/$flag \"; |
| }
|
\}"); |
|
|
} |
| }
|
|
|
|
} |
| myprint (CHECK, "
|
|
| \$\_=\$uword;
|
myprint (CHECK, " |
| if (\$\$words{\$\_})
|
\$\_=\$uword; |
| \{
|
if (\$\$words{\$\_}) |
| \$nf.=\"\$\_/! \";
|
\{ |
| \}
|
\$nf.=\"\$\_/! \"; |
| return \$nf;
|
\} |
| ");
|
return \$nf; |
|
|
"); |
|
|
|
| myprint (CHECK,"} 1\n")
|
|
|
|
myprint (CHECK,"} 1\n") |
|
|
|
|
|
|
| |
|
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to makecheck.pl CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Local Repository] / db / prgsrc