File:  [Local Repository] / db / prgsrc / makecheck.pl
Revision 1.4: download - view: text, annotated - select for diffs - revision graph
Thu Nov 1 01:44:59 2001 UTC (22 years, 5 months ago) by boris
Branches: MAIN
CVS tags: HEAD
added files to makefile. Added use lib "../lib";

#!/usr/bin/perl -w

=head1 NAME

makecheck.pl - скрипт для создания, функции, проверяющего слова
на предмет наличия в словаре.

=head1 SYNOPSIS

makecheck.pl


=head1 BUGS

На самом деле используется упрощённый формат описания 
аффиксов. Существенны только строчки "prefix", "suffix" 
и строчки, в которых встречается знак ">". Причём 
любая такая строка (кроме закомментированных) 
будет считаться строкой описания аффикса.


=head1 AUTHOR

Роман Семизаров

=cut



use locale;
use POSIX qw (locale_h);
use lib "../lib";
use chgkfiles;

do "common.pl";

if ((uc 'а') ne 'А') {die "!Koi8-r locale not installed!\n"};


input_files(RULES);

output_files(CHECK);

myprint (CHECK, "#!perl\n\n");

auto_message(CHECK, "makecheck.pl");


myprint(CHECK, 'sub checkit {my $nf=\'\'; my $a; my ($uword,$words)=@_; ');



while ( ($sha,$_)=getstring("\s*>\s*",RULES),$sha )
{
    $sha =~ s/\s+//g;
    s/\s+//g;
    if ( $sha =~ m/^flag\s*\*(.):/ )
    {
        $flag=$1;
    }

    if ($_)
    {
        s/(\#.*)$//g;
        ($f,$s)=split(",");


        if (!$s) {$s = $f; $f=""};
        $f=~s/^-//;

        if ( $sha eq "." )
        {
            $sha="";
        }
        
        if ( $s eq "-")
        { 
          $s=""
        }
        $sha= $sha."\$";
        $s= $s."\$";

myprint (CHECK, "\n\n#-------------------------------------\n\n"); 

        myprint (CHECK, "
           \$\_=\$uword;
           if ((s/$s/$f/) && (m/$sha/) &&  (\$a=\$\$words{\$\_}) && (\$a=~m/$flag/))
           \{
               \$nf.=\"\$\_/$flag \";
           \}");
      }

}

        myprint (CHECK, "
           \$\_=\$uword;
           if (\$\$words{\$\_})
           \{
               \$nf.=\"\$\_/! \";
           \}
          return \$nf;
         ");


myprint (CHECK,"} 1\n")




FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>