#!/usr/bin/perl #undef $/; $/=";\n"; %tnt = qw{ 1 P 2 P 3 P Act voz C modo Fut T FutP T G modo Gvo modo Imp T Ind modo Inf modo Ipr T MQP T Part modo Pass voz Perf T Pres T Sup modo ab C ac C comp grau dat C t tran x tran dep tran f G gen C m G n G nom C p N pos grau s N spl grau voc C }; while(<>){ chomp; my $name; s/(\w+)\s*=\s*(.*?)(#.*)?/\n#---------------------\nflag $1: $3\n$2/; $name=uc($1); s/#.*//g; s!\s+\+\s+(\w+)/!\n. \t>\t \U$1/!g; s/\s+\+\s+/\n/g; s{<B(\d?)><L(\d?)><B(\d?)>(\w+)/}{ my $b1 = $1 || 1; my $lft = $2 || 1; my $b2 = $3 || 1; my $c = $b1+$lft+$b2; my $y = substr($name,-$c); my $add = substr($name,-($b2+$lft),$lft); my $z = sje($y); "$z \t>\t -$y,\U$4$add/" }ge; s{<L(\d?)><B(\d?)>(\w+)/}{ my $lft = $1 || 1; my $b1 = $2 || 1; my $c = $b1+$lft; my $y = substr($name,-$c); my $add = substr($name,-$lft); my $z = sje($y); "$z \t>\t -$y,\U$3$add/" }ge; s{<L(\d?)>(\w+)<L(\d?)>(\w+)/}{ my $l1 = $1 || 1; my $l2 = $3 || 1; my $w1 = $2; my $w2 = $4; my $c = $l1 + $l2 - length($w1); my $add1 = substr($name,-$l1); my $add2 = substr($name,-$c, $l2 - length($w1)); my $y = substr($name,-$c); my $z = sje($y); "$z \t>\t -$y,\U$w2$add2$w1$add1/" }ge; s{<L(\d?)><B(\d?)>/}{ my $lft = $1 || 1; my $b1 = $2 || 1; my $c = $b1+$lft; my $y = substr($name,-$c); my $add = substr($name,-$lft); my $z = sje($y); "$z \t>\t -$y,\U$add/" }ge; s!<L(\d?)>(\w+)/! $x=$1||1; $y=substr($name,-$x); $z=sje($y); "$z \t>\t -$y,\U$2$y/"!ge; s!<B(\d?)>/! $x=$1 || 1; $y=substr($name,-$x); $z=sje($y); "$z \t>\t -$y,-/" !ge; s!<B(\d?)>(\w+)/! $x=$1 || 1; $y=substr($name,-$x); $z=sje($y); "$z \t>\t -$y,\U$2/" !ge; s!<E>!$l=substr($name,-1);"$l \t>\t -$l,$l "!ge; s!/! \t;\t"+!g ; s![+/](\w+)!$tnt{$1}=$1,!g; s!,\n!"\n!g; s!,$!"\n!g; while(m![+/](\w+)!g){ $oco{$1}++ } print } sub sje{ join(" ",split("",shift(@_))); }