File: Trans_morfems.pm

package info (click to toggle)
g2p-sk 0.2
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 332 kB
  • ctags: 31
  • sloc: perl: 1,057; makefile: 47
file content (85 lines) | stat: -rw-r--r-- 1,621 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
package g2p_sk::Trans_morfems;
require 5.000;
require Exporter;
*import = \&Exporter::import;

@ISA = qw(Exporter);
@EXPORT = qw(gen_morfemy set_debug_level);

use Term::ANSIColor qw(:constants);

warn "Loading module - Trans_morfemy ...\n";

my $morfemat="/usr/share/g2p_sk/Exceptions/morfemy.ddat";
my %morf;
my $prior=1;
my $color=0;

mess("Reading dictionary ...",1);
read_dictionary();
return true;

sub set_debug_level
{
   my $tmp=shift;
   my $tmpC=shift;
   return "Error - debug level out of range" if($tmp<0 or $tmp>5);
   $prior=$tmp;
   $color=$tmpC if($tmpC==0 or $tmpC==1);
   return "true";
}

sub gen_morfemy
{
 my $w=@_[0];
 foreach $k (keys %morf)
  {
   if($w=~/$k/)
    {
     $w=~s/$k/$morf{$k}/;
     return $w;
    }
  }
 return $w;
}

sub member
{
 my $s=pop(@_);
 foreach $h (@_)
  { return 1 if($s eq $h);}
 return 0;
}

sub read_dictionary
{
 open (STAT,"< $morfemat") or
    die ("Nie je mozne otvorit vstupny subor $morfemat!!!\n");
 while(<STAT>)
 {
  chomp;
  my $val=$_;
  s/[;><-]*//g;
  $morf{$_}=$val;
 }
 close STAT;
}

sub mess
  {
    my($msg,$pr)=@_;
    if($pr <= $prior)
      {
        $nt=$pr-1; $ss="";
	for($x=0;$x<$nt;$x++){$ss.="\t";}
	print "$ss$msg \n" if($color==0);
        #1-YELLOW,BOLD,2-YELLOW,3-GREEN,         5-default
        print YELLOW,BOLD,"$msg \n",RESET if($pr==1 and $color==1);
        print YELLOW,"$ss$msg \n",RESET if($pr==2 and $color==1);
        print GREEN,"$ss$msg \n",RESET if($pr==3 and $color==1);
        print BLUE,"$ss$msg \n",RESET if($pr==4 and $color==1);
        print RESET,"$ss$msg \n" if($pr==5 and $color==1);
      }
  }

END { }