skripte/wortliste/extract-tex.pl

   1 #! /usr/bin/perl -w
   2 #
   3 # extract-tex.pl
   4 #
   5 # Dieses Perl-Skript extrahiert einfache Wortlisten aus der
   6 # »wortliste«-Datenbank im Langformat (oder ähnlichen Dateien mit gleichem
   7 # Dateiformat), die beispielsweise als Eingabedateien für »patgen« verwendet
   8 # werden können.
   9 #
  10 # Aufruf:
  11 #
  12 #   perl extract-tex.pl [Optionen...] [liste1 liste2 ...] > input.patgen
  13 #
  14 # Die Eingabedateien müssen in UTF-8 kodiert sein; ist keine Eingabedatei
  15 # angegeben, verwendet das Skript die Standardeingabe.  Beispiele:
  16 #
  17 #   perl extract-tex.pl -l < ../wortliste > wortliste.ref.latin9
  18 #   perl extract-tex.pl -t ../wortliste > wortliste.trad.utf8
  19 #
  20 # Die Aufrufe
  21 #
  22 #   perl extract-tex.pl -1 ...
  23 #   perl extract-tex.pl -t -1 ...
  24 #   perl extract-tex.pl -s -1 ...
  25 #
  26 # liefern jeweils die gleiche Ausgabe wie
  27 #
  28 #   sprachauszug.py -l de-1996,de-1996-x-versal ...
  29 #   sprachauszug.py -l de-1901,de-1901-x-versal ...
  30 #   sprachauszug.py -l de-CH-1901,de-1901 ...
  31 #
  32 #
  33 # Optionen
  34 # --------
  35 #
  36 # -t
  37 # -s  Option »-t« wählt die traditionelle deutsche Rechtschreibung aus,
  38 #     Option »-s« die traditionelle (deutsch)schweizerische Rechtschreibung.
  39 #     Wenn weder »-s« noch »-t« gesetzt ist, wird die reformierte deutsche
  40 #     Rechtschreibung ausgewählt.
  41 #
  42 # -G  Gib zusätzlich Gesangstrennstellen aus, z.B. »A-bend«, wobei
  43 #     Ungünstigkeitsmarker ignoriert werden.
  44 #
  45 # -x  Ignoriere Optionen »-g«, »-u« sowie »-1« und gib die
  46 #     sprachspezifischen Felder unbearbeitet aus (inklusive Kommentare).
  47 #
  48 # -g  Gib Wörter mit gewichteten Trennstellen aus.  Optional kann ein
  49 #     ganzzahliges Argument angegeben werden: Wert 0 gibt alle gewichtete
  50 #     Trennstellen aus inklusive »-« (das ist der Standardwert), Wert 1 nur
  51 #     die Trennstellen mit der höchsten Wichtung (ohne »-«), Wert 2 die
  52 #     Trennstellen mit der höchsten und zweithöchsten Wichtung (ohne »-«),
  53 #     usw.
  54 #
  55 #     Beachte, dass bei nahe beieinanderstehenden Trennstellen derzeit keine
  56 #     zusätzliche Wichtung vorgenommen wird.  Beispielsweise ist in dem Wort
  57 #
  58 #       ab<be<ru-fen
  59 #
  60 #     die Trennung »abbe-rufen« schlecht, weil ganz nahe der optimalen
  61 #     Trennstelle (nach »ab«).  Das Skript gibt trotzdem diese Trennstelle
  62 #     als zweitbeste aus.
  63 #
  64 # -u  Verhindere die Ausgabe von Wörtern mit Markern für unerwünschte
  65 #     Trennungen (z.B. »An<=al-.pha=bet«).  Wenn nicht gesetzt, werden als
  66 #     ungünstig markierte Trennstellen entfernt (z.B. »An<=alpha=bet«).
  67 #
  68 # -U  Gib Wörter mit Nicht-ASCII-Zeichen auch in Umschrift aus (z.B.
  69 #     »loe-sen«, »Haen-de«).  Ausgenommen davon sind Wörter mit »ß«, weil
  70 #     die entsprechenden Formen mit »ss« bereits in der Wortliste enthalten
  71 #     sind.
  72 #
  73 # -1  (Ziffer 1) Verhindere einbuchstabige Trennungen.  Ist die Option
  74 #     gesetzt, wird die erste dieser Trennungen unterdrückt, falls beide
  75 #     Trennstellen gleichwertig sind (z.B. »eu-ro-päi-sche« statt
  76 #     »eu-ro-pä-i-sche«), anderenfalls bleibt die stärkere erhalten (z.B.
  77 #     »päd<ago-gisch« statt »pä-d<a-go-gisch«).
  78 #
  79 #     Gesangstrennstellen sind von dieser Option nicht betroffen; es
  80 #     ist daher nicht sinnvoll, gleichzeitig »-G« zu verwenden.
  81 #
  82 # -S  Entferne Schwankungsfälle (z.B. »Sta-tion« statt »Sta-ti-on«).
  83 #
  84 # -v  Verhindere die Ausgabe von Versalformen, wo »ß« durch »ss« ersetzt
  85 #     ist.
  86 #
  87 # -l  (Kleinbuchstabe L) Konvertiere die Ausgabe von UTF-8 nach latin-9.
  88
  89 # Wir verwenden »<<>>« statt »<>« aus Sicherheitsgründen.
  90 require 5.22.0;
  91
  92 use strict;
  93 use warnings;
  94 use English '-no_match_vars';
  95 use utf8;                              # String-Literals direkt als UTF-8.
  96 use open qw(:std :utf8);
  97 use Getopt::Long qw(:config bundling);
  98
  99
 100 my ($opt_g, $opt_G,
 101     $opt_l,
 102     $opt_s, $opt_S,
 103     $opt_t,
 104     $opt_u, $opt_U,
 105     $opt_v,
 106     $opt_x,
 107     $opt_1);
 108 $opt_g = -1;
 109
 110 GetOptions("g:i" => \$opt_g, "G" => \$opt_G,
 111            "l"   => \$opt_l,
 112            "s"   => \$opt_s, "S" => \$opt_S,
 113            "t"   => \$opt_t,
 114            "u"   => \$opt_u, "U" => \$opt_U,
 115            "v"   => \$opt_v,
 116            "x"   => \$opt_x,
 117            "1"   => \$opt_1);
 118
 119
 120 my $prog = $0;
 121 $prog =~ s@.*/@@;
 122
 123
 124 # Kodierung:
 125 binmode(STDOUT, ":encoding(iso-8859-15)") if $opt_l;
 126
 127
 128 # Einige Konstanten für reguläre Ausdrücke, um die Lesbarkeit zu
 129 # erhöhen.
 130 my $marker = qr/[.·<>=-]/x;
 131 my $buchstabe = qr/(?: [^.·<>=-] | ch)/x;
 132 my $vokal = qr/[aeiouäöüy]/x;
 133 # Konsonant: nicht Vokal, aber Buchstabe.
 134 my $konsonant = qr/(?! $vokal ) $buchstabe/x;
 135
 136
 137 sub entferne_marker {
 138   my $arg = shift;
 139   $arg =~ s/$marker//g;
 140   return $arg;
 141 }
 142
 143 # Wenn Option »-U« gesetzt ist, müssen wir erkennen können, ob Wörter in
 144 # Umschrift in der Wortliste existieren.  Wir benutzen dafür zwei Hashes.
 145 my %wortliste;
 146 my %wortliste_umschrift;
 147
 148 while (<<>>) {
 149   # Gebe Kommentarzeilen direkt aus, falls verlangt.
 150   if (/^ \s* \#/x) {
 151     print if $opt_x;
 152     next;
 153   }
 154
 155   chop;
 156
 157   # Isoliere Kommentare.
 158   s/(\# .*) $//x;
 159
 160   my $kommentar = $1 // "";
 161
 162   # Entferne Leerzeichen aller Art.
 163   s/\s+//g;
 164
 165   my @feld = split(';');
 166   next if $#feld < 1;
 167
 168   # reformiert:           Felder 2, 4, 5, 7
 169   # traditionell:         Felder 2, 3, 5, 6
 170   # traditionell Schweiz: Felder 2, 3, 5, 6, 8
 171   #
 172   # Beachte: Feld n hat Index n-1.
 173   my $zeile = "";
 174   $zeile = $feld[2] if defined $feld[2]
 175                        && $feld[2] ne "-3-" && ($opt_t || $opt_s);
 176   $zeile = $feld[3] if defined $feld[3]
 177                        && $feld[3] ne "-4-" && !($opt_t || $opt_s);
 178   if (!$zeile) {
 179     # Wir nehmen Versalformen nur dann, wenn es keine normalen Formen (in
 180     # Feld 2 oder 3) gibt.
 181     $zeile = $feld[4] if defined $feld[4]
 182                          && $feld[4] ne "-5-" && !$opt_v;
 183     $zeile = $feld[5] if defined $feld[5]
 184                          && $feld[5] ne "-6-" && ($opt_t || $opt_s) && !$opt_v;
 185     $zeile = $feld[6] if defined $feld[6]
 186                          && $feld[6] ne "-7-" && !($opt_t || $opt_s) && !$opt_v;
 187   }
 188
 189   $zeile = $feld[7] if defined $feld[7] && $opt_s;
 190
 191   if (!$zeile) {
 192     $zeile = $feld[1];
 193   }
 194
 195   next if $zeile eq "-2-";
 196
 197   if (!$opt_x) {
 198     # Entferne spezielle Trennungen.
 199     $zeile =~ s|\{ (.*?) / .*? \}|$1|gx;
 200
 201     # Entferne Doppeldeutigkeiten.
 202     $zeile =~ s|\[ (.*?) / .*? \]|entferne_marker($1)|egx;
 203
 204     # Hier der Algorithmus, um die verbliebenen Markierungen in
 205     # Trennstellen aufzulösen.  Die Schritte sind in der gegebenen
 206     # Reihenfolge abzuarbeiten.
 207     #
 208     # Dieses Skript implementiert ausschließlich den morphemischen
 209     # Trennstil (siehe Punkt 1), unter weiterer Anwendung der Regeln
 210     # 2 bis 6.
 211     #
 212     # (1) Auflösung von Wahlmöglichkeiten zwischen morphemischem und
 213     #     syllabischem Trennstil (einer der beiden Stile muß gewählt
 214     #     werden).  Ungünstigkeitsmarker und Gesangstrennstellen
 215     #     werden in diesem Schritt nicht berücksichtigt (wohl aber
 216     #     entfernt, wenn die entsprechende Trennstelle entfällt).
 217     #
 218     #     (a) Die Bezeichnungen
 219     #
 220     #           <x-  und  -x<
 221     #
 222     #         sind Kurzschreibungen für
 223     #
 224     #           {<x/x-}  und  {x</-x}  (morphemisch/syllabisch)   ,
 225     #
 226     #         wobei »x« ein Konsonant oder »ch« ist.  Diese Regel gilt
 227     #         nicht für die Suffixe »>x-« und »-x>«.  Die
 228     #         Zusammensetzungen »=x-« und »-x=« werden gegenwärtig
 229     #         nicht beachtet, da sie in der Wortliste nicht vorkommen
 230     #         (Beispiel: Lö-b=au).
 231     #
 232     #     (b) Die Bezeichnungen
 233     #
 234     #           <i-  und  -i<
 235     #
 236     #         sind Kurzschreibungen für
 237     #
 238     #           {<i·/i-}  und  {·i</-i}  (morphemisch/syllabisch)   ,
 239     #
 240     #         wobei »i« ein Vokal ist (einschließlich »y«).  Diese
 241     #         Regel gilt nicht für die Suffixe »>i-« und »-i>«.  Die
 242     #         Zusammensetzungen »=i-« und »-i=« werden gegenwärtig
 243     #         nicht beachtet, da sie in der Wortliste nicht vorkommen
 244     #         (Beispiel: Ei-se-n=a-ch-er Motorenwerke).
 245     #
 246     #         Beispielsweise bleibt die Markierung
 247     #
 248     #             al-ge-bra>i-sche
 249     #
 250     #         in diesem Schritt unverändert; wegen »>« gibt es keine
 251     #         Wahlmöglichkeit.
 252     #
 253     # (2) Behandle (angehängte) ».«-Marker, falls ungünstige
 254     #     Trennstellen unterdrückt werden sollen.
 255     #
 256     # (3) Entferne Flattervokale (also Einbuchstaben-Silben), falls
 257     #     verlangt.  Beachte, daß »ch« wie ein Buchstabe behandelt
 258     #     wird und auch Schwankungsfälle (».«) berücksichtigt werden.
 259     #     Gesangstrennstellen dagegen werden ignoriert (aber
 260     #     gegebenenfalls entfernt).
 261     #
 262     #     Die folgenden beiden Regeln beziehen sich auf die
 263     #     Trennstellen unmittelbar vor und nach dem Flattervokal.
 264     #
 265     #     (a) Ist eine Trennstelle »stärker« als die andere, wird die
 266     #         stärkere Trennstelle genommen (z.B. ist »>« stärker als
 267     #         »-«, »-« stärker als ».«).
 268     #
 269     #     (b) Sind die Trennstellen gleich stark, wird die rechte
 270     #         Trennstelle genommen.
 271     #
 272     # (4) Entferne Gesangstrennstellen (»·«), falls verlangt.
 273     #     Beachte, daß die Markierung für Gesangstrennstellen, ähnlich
 274     #     Ungünstigkeitsmarkern, auch zu anderen Markern treten kann
 275     #     (die dann ebenfalls entfernt werden).
 276     #
 277     #     Falls Gesangstrennstellen berücksichtigt werden sollen und
 278     #     Situationen wie »·x<« auftreten (wobei »x« ein Konsonant
 279     #     oder »ch« ist), wird die »stärkere« Trennstelle genommen.
 280     #
 281     # (5) Entferne restliche Schwankungsfälle, falls verlangt.
 282     #
 283     # (6) Alle verbliebenen Markierungen werden zu »-« aufgelöst.
 284     #
 285     #
 286     # Beispiele:
 287     #   Re<s-tau-rant
 288     #   Re<stau-rant  (1a, morphemisch)
 289     #   Re-stau-rant  (6)
 290     #
 291     #   Re<s-tau-rant
 292     #   Res-tau-rant  (1a, syllabisch)
 293     #
 294     #   Ge-r<i.a-trie
 295     #   Ger<i.a-trie  (1a, morphemisch)
 296     #   Ger<ia-trie   (3)
 297     #   Ger-ia-trie   (6)
 298     #
 299     #   Ge-r<i.a-trie
 300     #   Ge-ri.a-trie  (1a, syllabisch)
 301     #   Ge-ria-trie   (3)
 302     #
 303     #   Ärz-te=i·n<.i-ti.a-ti-ve
 304     #   Ärz-te=i·n<.i·ti.a-ti-ve  (1b, morphemisch)
 305     #   Ärz-te=i·ni·ti.a-ti-ve    (2)
 306     #   Ärz-te=i·ni·tia-ti-ve     (3a)
 307     #   Ärz-te=initia-ti-ve       (4)
 308     #   Ärz-te-initia-ti-ve       (6)
 309     #
 310     #   Ärz-te=i·n<.i-ti.a-ti-ve
 311     #   Ärz-te=i·ni-ti.a-ti-ve  (1b, syllabisch)
 312     #   Ärz-te=i·ni-tia-ti-ve   (3a)
 313     #   Ärz-te=ini-tia-ti-ve    (4)
 314     #   Ärz-te-ini-tia-ti-ve    (6)
 315     #
 316     #   Di-a<s-po-ra
 317     #   Di·a<s-po-ra  (1b, morphemisch)
 318     #   Di·a<spo-ra   (1a)
 319     #   Dia<spo-ra    (4)
 320     #   Dia-spo-ra    (6)
 321     #
 322     #   Di-a<s-po-ra
 323     #   Di-as-po-ra   (1b, syllabisch)
 324     #
 325     #   Kaf-ka=ken-.ner
 326     #   Kaf-ka=kenner  (2)
 327     #   Kaf-ka-kenner  (6)
 328     #
 329     #   al-ge-bra>i-sche
 330     #   al-ge-bra>ische  (3a)
 331     #   al-ge-bra-ische  (6)
 332     #
 333     #   Ru-i-ne
 334     #   Rui-ne  (3b)
 335     #
 336     #   A<·s-phalt
 337     #   A<·sphalt  (1a, morphemisch)
 338     #   Asphalt    (4)
 339     #
 340     #   A<·s-phalt
 341     #   As-phalt  (1a, syllabisch)
 342     #
 343     #   ge-ni.al
 344     #   ge-nial  (5)
 345     #
 346     #   A·b<i-tur
 347     #   A·b<i·tur  (1b, morphemisch)
 348     #   Ab<i·tur   (4, mit Gesangstrennstellen)
 349     #   Ab-i-tur   (6)
 350     #
 351     #   A·b<i-tur
 352     #   A·bi-tur  (1b, syllabisch)
 353     #   A-bi-tur  (6, mit Gesangstrennstellen)
 354
 355     # Schritt 1a: »<x-« wird zu »<x«.
 356     $zeile =~ s/< [.·]* $konsonant \K - \.*//gx;
 357     #             »-x<« wird zu »x<«.
 358     $zeile =~ s/- \.* ($konsonant \.*) (?= <)/$1/gx;
 359
 360     # Schritt 1b: »<i-« wird zu »<i·«.
 361     $zeile =~ s/(< \.* $vokal) -/$1·/gx;
 362     #             »-i<« wird zu »·i<«.
 363     $zeile =~ s/- (\.* $vokal) (?= <)/·$1/gx;
 364
 365     # Ausgabe von Wörtern mit unerwünschten Trennungen?
 366     next if $zeile =~ /\./ and $opt_u;
 367
 368     # Schritt 2: »a<.b« wird zu »ab«.
 369     $zeile =~ s/[·<>=-]+ \.+//gx if !$opt_G;
 370
 371     if ($opt_1) {
 372       # Schritt 3a: »a-b>c« wird zu »ab>c«.
 373       $zeile =~ s/[-.]+ (?= $buchstabe [<>=] )//gx;
 374       #             »a<=b-c« wird zu »a<=bc«.
 375       $zeile =~ s/[<>=] [·<>=]* $buchstabe \K [-.]+//gx;
 376
 377       # Schritt 3b: »a-b-c« wird zu »ab-c«.
 378       $zeile =~ s/- ( $buchstabe - )/$1/gx;
 379     }
 380
 381     if ($opt_1 && !$opt_G) {
 382       # Schritt 3a: »a.b-c« wird zu »ab-c«.
 383       $zeile =~ s/\. ( $buchstabe - )/$1/gx;
 384       #             »a-b.c« wird zu »a-bc«.
 385       $zeile =~ s/( - $buchstabe ) \./$1/gx;
 386     }
 387
 388     # Schritt 4.
 389     if ($opt_G) {
 390       # »a·x<c« wird zu »ax<c«.
 391       $zeile =~ s/(?<! <) ·+ ( $konsonant < )/$1/gx;
 392     }
 393     else {
 394       # »a<·b« wird zu »ab«.
 395       $zeile =~ s/($buchstabe) $marker* ·+/$1/gx;
 396     }
 397
 398     # Schritt 5:
 399     if ($opt_S) {
 400       # »a.b« wird zu »ab«.
 401       $zeile =~ s/\.//gx;
 402     }
 403     else {
 404       # »a.b« wird zu »a-b«.
 405       $zeile =~ s/\./-/gx;
 406     }
 407
 408     if ($opt_g > 0) {
 409       # Berechne Wichtungen.  Wir verwenden folgende Werte:
 410       #
 411       #   -2   Wortteil
 412       #   -1   -
 413       #    0   --
 414       #    1   <, >
 415       #    2   =
 416       #    3   ==, <=, =>
 417       #    4   ===, <==, ==>
 418       #    ..
 419       #
 420       # Bei mehrfachem Auftreten von »<« hat das am meisten links stehende
 421       # den höchsten Rang.  Bei mehrfachem Auftreten von »>« hat das am
 422       # meisten rechts stehende den höchsten Rang.  Beispiel:
 423       #
 424       #   Mit<ver<ant-wort>lich>keit
 425       #      ^                 ^
 426       #
 427       # Das bezieht sich auch auf Ketten mit »=>« u.ä:
 428       #
 429       #   Ei-gen=wirt>schaft=>lich>keit
 430       #                           ^
 431
 432       my $g;
 433       my $m;
 434       my ($r, $r_vorher);
 435       my ($w, $w_vorher);
 436
 437       # Wir zerlegen mit `split' unter Beibehaltung der Begrenzer.
 438       my @zerlegung = split /([<>=-]+)/, $zeile;
 439
 440       # Wir speichern Wichtung und Rang als Felder.
 441       my @wichtung = (-2) x ($#zerlegung + 1);
 442       my @rang = (0) x ($#zerlegung + 1);
 443
 444       # Erster Durchgang: Ermittle Wichtungswerte.
 445
 446       # Wir starten bei erstem Marker (mit Index 1).
 447       foreach my $i (1 .. ($#zerlegung - 1)) {
 448         # Ignoriere Nicht-Marker.
 449         next if not $i % 2;
 450
 451         $m = $zerlegung[$i];
 452
 453         if ($m =~ /^-$/) {
 454           $w = -1;
 455         }
 456         elsif ($m =~ /^--$/) {
 457           $w = 0;
 458         }
 459         elsif ($m =~ /^[<>]$/) {
 460           $w = 1;
 461         }
 462         elsif ($m =~ /^=$/) {
 463           $w = 2;
 464         }
 465         elsif ($m =~ /( ==*>? | <?=*= )/x) {
 466           $w = length($1) + 1;
 467         }
 468         else {
 469           warn "Zeile $INPUT_LINE_NUMBER:"
 470                . " unbekannter Marker »$m« behandelt als »-«\n";
 471           $w = -1;
 472         }
 473
 474         $wichtung[$i] = $w;
 475       }
 476
 477       # Zweiter Durchgang: Adjustiere Wichtung von »<« und »>«.
 478
 479       # Behandle »<« von rechts nach links gehend.
 480       $w_vorher = -2;
 481       foreach my $i (reverse(1 .. ($#zerlegung - 1))) {
 482         # Ignoriere Nicht-Marker.
 483         next if not $i % 2;
 484
 485         if (index ($zerlegung[$i], "<") >= 0) {
 486           # Hat der rechte Marker in einer Kette von »<« eine höhere
 487           # Wichtung, wird diese übernommen.
 488           $w = $wichtung[$i];
 489
 490           if ($w_vorher >= $w) {
 491             $wichtung[$i] = $w_vorher;
 492           }
 493           else {
 494             $w_vorher = $w;
 495           }
 496         }
 497         # »-«-Marker zwischen zwei »<« ändert nicht deren Wichtung.
 498         elsif ($zerlegung[$i] ne "-") {
 499           $w_vorher = -2;
 500         }
 501       }
 502
 503       # Behandle »>« von links nach rechts gehend.
 504       $w_vorher = -2;
 505       foreach my $i (1 .. ($#zerlegung - 1)) {
 506         # Ignoriere Nicht-Marker.
 507         next if not $i % 2;
 508
 509         if (index ($zerlegung[$i], ">") >= 0) {
 510           # Hat der linke Marker in einer Kette von »>« eine höhere
 511           # Wichtung, wird diese übernommen.
 512           $w = $wichtung[$i];
 513
 514           if ($w_vorher >= $w) {
 515             $wichtung[$i] = $w_vorher;
 516           }
 517           else {
 518             $w_vorher = $w;
 519           }
 520         }
 521         # »-«-Marker zwischen zwei »>« ändert nicht deren Wichtung.
 522         elsif ($zerlegung[$i] ne "-") {
 523           $w_vorher = -2;
 524         }
 525       }
 526
 527       # Dritter Durchgang: Ermittle Rang von »<« und »>«.
 528
 529       # Behandle »<« von links nach rechts gehend.
 530       $r = 0;
 531       foreach my $i (1 .. ($#zerlegung - 1)) {
 532         # Ignoriere Nicht-Marker.
 533         next if not $i % 2;
 534
 535         if (index ($zerlegung[$i], "<") >= 0) {
 536           $rang[$i] = $r--;
 537         }
 538         # »-«-Marker zwischen zwei »<« ändert nicht den Rang.
 539         elsif ($zerlegung[$i] ne "-") {
 540           $r = 0;
 541         }
 542       }
 543
 544       # Behandle »>« von rechts nach links gehend.
 545       $r = 0;
 546       foreach my $i (reverse(1 .. ($#zerlegung - 1))) {
 547         # Ignoriere Nicht-Marker.
 548         next if not $i % 2;
 549
 550         if (index ($zerlegung[$i], ">") >= 0) {
 551           $rang[$i] = $r--;
 552         }
 553         # »-«-Marker zwischen zwei »>« ändert nicht den Rang.
 554         elsif ($zerlegung[$i] ne "-") {
 555           $r = 0;
 556         }
 557       }
 558
 559       # Sortiere Indexfeld für Marker mit absteigender Wichtung.
 560       my @wichtungsindices =
 561         sort {
 562           # Benutze Rang für Sekundärsortierung.
 563           if ($wichtung[$a] == $wichtung[$b]) {
 564             -($rang[$a] <=> $rang[$b]);
 565           }
 566           else {
 567             -($wichtung[$a] <=> $wichtung[$b]);
 568           }
 569         } (0 .. $#zerlegung);
 570
 571       # Entferne Trennstellen unter Berücksichtigung des Arguments von »-g«.
 572       $g = 0;
 573       $w_vorher = -2;
 574       $r_vorher = 0;
 575
 576       foreach my $i (@wichtungsindices) {
 577         # Alle Wortteile haben einen geraden Index und sind stets am Schluß
 578         # von @wichtungsindices.
 579         last if not $i % 2;
 580
 581         $w = $wichtung[$i];
 582         $r = $rang[$i];
 583
 584         if ($w_vorher == $w) {
 585           $g++ if $r_vorher != $r;
 586         }
 587         else {
 588           $g++;
 589         }
 590
 591         $w_vorher = $w;
 592         $r_vorher = $r;
 593
 594         # Entferne Trennung mit zu geringer Wichtung.
 595         $zerlegung[$i] = "" if $g > $opt_g || $w < 0;
 596       }
 597
 598       $zeile = join '', @zerlegung;
 599     }
 600     elsif ($opt_g < 0) {
 601       # Schritt 6.
 602       $zeile =~ s/$marker+/-/g;
 603     }
 604   }
 605
 606   print "$zeile";
 607   print " " . $kommentar if $kommentar && $opt_x;
 608   print "\n";
 609
 610   # Der Schlüssel im Hash ist das ungetrennte Wort, konvertiert zu
 611   # Kleinbuchstaben; Wert wird keiner gebraucht.
 612   $wortliste{lc($feld[0])} = ();
 613
 614   if ($opt_U) {
 615     my $orig_zeile = $zeile;
 616
 617     $zeile =~ tr[ÀàÁáÂâÃãÇçÈèÉéÊêËëÌìÍíÎîÏïÑñÒòÓóÔôÕõŠšÙùÚúÛûÝýŸÿŽž]
 618                 [AaAaAaAaCcEeEeEeEeIiIiIiIiNnOoOoOoOoSsUuUuUuYyYyZz];
 619
 620     $zeile =~ s/Ä/Ae/g;
 621     $zeile =~ s/ä/ae/g;
 622     $zeile =~ s/Å/Aa/g;
 623     $zeile =~ s/å/aa/g;
 624     $zeile =~ s/Æ/Ae/g;
 625     $zeile =~ s/æ/Ae/g;
 626
 627     $zeile =~ s/Ö/Oe/g;
 628     $zeile =~ s/ö/oe/g;
 629     $zeile =~ s/Ø/Oe/g;
 630     $zeile =~ s/ø/oe/g;
 631     $zeile =~ s/Œ/Oe/g;
 632     $zeile =~ s/œ/oe/g;
 633
 634     $zeile =~ s/Ü/Ue/g;
 635     $zeile =~ s/ü/ue/g;
 636
 637     $wortliste_umschrift{lc($feld[0])} = $zeile if $orig_zeile ne $zeile;
 638   }
 639 }
 640
 641 if ($opt_U) {
 642   # Wir geben nur Wörter aus, die nicht bereits in der originalen Wortliste
 643   # existieren.
 644   foreach my $wort (sort(keys %wortliste_umschrift)) {
 645     my $umschrift = $wortliste_umschrift{$wort};
 646     my $test = lc(entferne_marker($umschrift));
 647
 648     print "$umschrift\n" if not exists ($wortliste{$test});
 649   }
 650 }
 651
 652 # eof