← Back to branch summary

~ubuntu-branches/debian/sid/aspell-cs/sid

« back to all changes in this revision

Viewing changes to misc/aff2oo.pl

  • Committer: Package Import Robot
  • Author(s): Ondřej Surý
  • Date: 2012-06-28 11:47:01 UTC
  • Revision ID: package-import@ubuntu.com-20120628114701-l0gikjis03qt3f0i
Tags: 0.51.0-1
Imported Upstream version 0.51.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
misc/aff2oo.pl
1
 
#!/usr/bin/perl
2
 
 
3
 
#
4
 
# .aff -> Open Office afix file convertor; not tested!!!
5
 
# Using:
6
 
#      perl aff2oo.pl czech.aff
7
 
#
8
 
 
9
 
use open ':encoding(iso-8859-2)', ':std';
10
 
#use locale;
11
 
 
12
 
print "SET ISO8859-2\n";
13
 
 
14
 
$number='';
15
 
while (<>) {
16
 
  if (/^wordchars\s+(.*)/ || /^stringchar\s+(.*)/) {
17
 
    $chars=$1;
18
 
    $chars=~s/\s+$//;
19
 
    $expand='';
20
 
    if ($chars=~/\[([^\]]*)\]\s+\[([^\]]*)\]/) {
21
 
      $list1=$1;
22
 
      $list2=$2;
23
 
      while ($list1 ne '') {
24
 
        if ($list1=~s/^(.)-(.)//) {
25
 
          $from=$1;
26
 
          $upto=$2;
27
 
          $expand='';
28
 
          for ($c=$from; $c le $upto; $c++) {
29
 
            $expand.=$c;
30
 
          }
31
 
          $list1=$expand.$list1;
32
 
        }
33
 
        if ($list2=~s/^(.)-(.)//) {
34
 
          $from=$1;
35
 
          $upto=$2;
36
 
          $expand='';
37
 
          for ($c=$from; $c le $upto; $c++) {
38
 
            $expand.=$c;
39
 
          }
40
 
          $list2=$expand.$list2;
41
 
        }
42
 
        while ($list1 =~ s/^(.)//) {
43
 
          $c=$1;
44
 
          if ($list2 =~ s/^(.)//) {
45
 
            $uc=$1;
46
 
            $uc='' if $c eq $uc;
47
 
          }
48
 
          $try .= $c . $uc;
49
 
        }
50
 
      }
51
 
    } else {
52
 
      $chars=~s/^(.)\s+\1/$1/;
53
 
      $try.=join('', split(/\s+/, $chars));
54
 
    }
55
 
  }
56
 
  if (/^prefixes/) {
57
 
    $affixtype='PFX';
58
 
    if ($try) {
59
 
      print "TRY $try\n\n";
60
 
      $try='';
61
 
    }
62
 
  } elsif (/^suffixes/) {
63
 
    $affixtype='SFX';
64
 
    if ($try) {
65
 
      print "TRY $try\n\n";
66
 
      $try='';
67
 
    }
68
 
  } else {
69
 
    next if (!$affixtype);
70
 
    if (/^flag (\*?)(.):/) {
71
 
      if ($number ne '') {
72
 
        $out=shift(@OUT);
73
 
        print "$out $number\n";
74
 
        print @OUT;
75
 
        print "\n";
76
 
      }
77
 
      $flag=$2;
78
 
      $combined=($1 eq '')? 'N' : 'Y';
79
 
      @OUT=("$affixtype $flag $combined");
80
 
      $number=0;
81
 
    } else {
82
 
      s/\n$//;
83
 
      s/\s*\#.*$//;
84
 
      s/^\s*//;
85
 
#print "Line: `$_'\n";
86
 
      if (/^([^\>]*)>(.*)/) {
87
 
        $cond=$1;
88
 
        $rest=$2;
89
 
#print "\$cond: `$cond'\n";
90
 
#print "\$rest: `$rest'\n";
91
 
        $cond=~s/^\s*//;
92
 
        $cond=~s/\s*$//;
93
 
        $rest=~s/^\s*//;
94
 
        $rest=~s/\s*$//;
95
 
#print "\$cond: `$cond'\n";
96
 
#print "\$rest: `$rest'\n";
97
 
        if ($rest=~/-(.*),(.*)/) {
98
 
          $remove=$1;
99
 
          $add=$2;
100
 
        } else {
101
 
          $remove='0';
102
 
          $add=$rest;
103
 
        }
104
 
        $remove=~s/\s*$//;
105
 
        $add=~s/^\s*//;
106
 
        $cond=~s/ //g;
107
 
        $remove=lc($remove);
108
 
        $add=lc($add);
109
 
        $cond=lc($cond);
110
 
        
111
 
        $add='0' if $add eq '-';
112
 
        if ($cond ne '.') {
113
 
          @cond = $cond =~ /\[.+?\]|./g;
114
 
          die unless join('',@cond) eq $cond;
115
 
          $rem_len = $rem eq '.' ? 0 : length($remove);
116
 
          @i = ();
117
 
          @i = ($rem_len .. $#cond)       if $affixtype eq 'PFX';
118
 
          @i = (0 .. ($#cond - $rem_len)) if $affixtype eq 'SFX';
119
 
          #print ">>@i $cond\n";
120
 
          foreach my $i (@i) {
121
 
            ($p, $s) = $cond[$i] =~ /^\[?(\^?)(.+?)\]?$/ or die;
122
 
            $cond[$i] = '[' . $p . $s . uc $s . ']';
123
 
          }
124
 
          $cond = join('',@cond);
125
 
          #print "<<@i $cond\n";
126
 
        }
127
 
        push(@OUT, "$affixtype $flag $remove $add $cond\n");
128
 
        $number++;
129
 
      }
130
 
    }
131
 
  }
132
 
}
133
 
      if ($number ne '') {
134
 
        $out=shift(@OUT);
135
 
        print "$out $number\n";
136
 
        print @OUT;
137
 
        print "\n";
138
 
      }