skripte/perl/wl-new2old.pl

   1 #! /usr/bin/perl -w
   2 #
   3 # wl-new2old.pl
   4 #
   5 # Dieses Perl-Skript konvertiert eine gegebene Liste von Einträgen im neuen
   6 # Wortlistenformat (mit bis zu fünf Feldern) ins alte Format (mit bis zu
   7 # acht Feldern).
   8 #
   9 # Aufruf:
  10 #
  11 #   wl-new2old.pl [--debug] [liste1 liste2 ...] > ausgabe
  12 #
  13 # Die Eingabedateien müssen in UTF-8 kodiert sein.
  14 #
  15 # Sind keine Eingabedateien angegeben, verwendet das Skript ebenfalls die
  16 # Standardeingabe.  Beispiel:
  17 #
  18 #   wl-new2old.pl < reformiert > wortliste.erzeugt
  19 #
  20 # Die Ausgabe erfolgt unsortiert.
  21 #
  22 # Im folgenden Beispiel befinden sich die Eingabedateien im Ordner »neu«.
  23 # Eine sortierte Wortliste kann mit
  24 #
  25 #   wl-new2old.pl neu/* \
  26 #   | wlsort.pl \
  27 #   > wortliste
  28 #
  29 # erzeugt werden.
  30 #
  31 # Option »--debug« gibt einen Dump mit mehr Informationen aus, der explizite
  32 # und implizite Felder anzeigt.
  33
  34
  35 # Diese Datei wird, bevor sie ausgeführt wird, mithilfe des
  36 # »M4filter«-Moduls vom GNU M4 Makroprozessor gefiltert.
  37 #
  38 # Die Datei »M4filter.pm« befindet sich im gleichen Verzeichnis wie dieses
  39 # Skript; wir müssen daher das »lib«-Verzeichnis entsprechend adjustieren.
  40 #
  41 use File::Basename;
  42 use lib dirname (__FILE__);
  43 use M4filter;
  44
  45 # Wir wollen › und ‹ als M4-Quotes verwenden.
  46 changequote(`›', `‹')
  47
  48 # Hauptgrund für die Verwendung von M4 ist das Fehlen von Inline-Funktionen
  49 # in Perl.  Da Subroutinen das Skript deutlich verlangsamen, benützen wir
  50 # stattdessen die M4-Funktionalität.
  51 #
  52 # Anmerkungen:
  53 #
  54 # * Argumente in M4-Makros sollen normalerweise von › und ‹ umschlossen
  55 #   sein, um vorzeitige Expansion zu verhindern.  Der Perl-Code in dieser
  56 #   Datei verwendet keines der beiden Zeichen, was Zweideutigkeiten
  57 #   verhindert.
  58 #
  59 # * »$1«, »$2«, ... sind Argumente in M4-Makros, aber auch Perl verwendet
  60 #   diese Konstrukte in regulären Ausdrücken.  Perl jedoch erlaubt die
  61 #   alternative Syntax »${1}«, »${1}«, ..., die wir daher verwenden, um
  62 #   Zweideutigkeiten zu verhindern.
  63 #
  64 # * Zur besseren Lesbarkeit sind Namen von M4-Makros immer in
  65 #   Großbuchstaben; das verhindert auch Kollisionen im Code, da nur
  66 #   Kleinbuchstaben abgearbeitet werden – es gibt zwar großbuchstabige
  67 #   Einträge in der Wortliste, doch sind sie nicht für dieses Skript
  68 #   relevant.
  69 #
  70 # * Manche Schlüsselwörter sind identisch in M4 und Perl (z.B. »shift«).
  71 #   Derzeit allerdings sind keine von diesen in Verwendung.  Falls sich das
  72 #   einmal ändert, müssen die betroffenen Befehle (auf der M4-Seite) mittels
  73 #   »defn« umdefiniert werden.
  74 #
  75 #
  76 # Mit Subroutinen statt »M4filter« ist das Skript rund 20% langsamer.
  77
  78
  79 use 5.010001;
  80 use strict;
  81 use warnings;
  82 use utf8;                                 # String-Literals direkt als UTF-8.
  83 use open qw(:std :utf8);
  84 use feature qw(unicode_strings);
  85 use Getopt::Long qw(:config no_ignore_case
  86                             no_auto_abbrev
  87                             no_getopt_compat);
  88 use List::MoreUtils qw(first_index);
  89
  90
  91 my $debug = "";
  92 GetOptions("debug" => \$debug);
  93
  94
  95 # Analyse der Wortbestandteile
  96 # ----------------------------
  97 #
  98 # Wir verwenden M4-Makros, um folgende Trennvarianten abzudecken:
  99 #
 100 #   reformierte Rechschreibung,
 101 #   traditionelle Rechtschreibung,
 102 #
 103 #   reformierte Rechtschreibung, Versalform,
 104 #   traditionelle Rechtschreibung, Versalform,
 105 #
 106 #   traditionelle schweizerdeutsche Rechtschreibung.
 107 #
 108 # Beachte: Die Wortliste hat keine separaten Einträge für traditionelle
 109 # schweizerdeutsche Versalformen; diese fallen entweder mit den
 110 # traditionellen Versalformen oder den traditionellen schweizerdeutschen
 111 # Formen zusammen.
 112 #
 113 # Beachte weiters, daß sich Einträge für reformierte und traditionelle
 114 # Rechtschreibung teilweise widersprechen und daher separat behandelt werden
 115 # müssen; die Einträge für traditionelle deutsche und schweizerdeutsche
 116 # Rechtschreibung dagegen nicht.  Aus diesem Grund ist die Wortliste für
 117 # traditionelle schweizerdeutsche Rechtschreibung einfach eine Obermenge der
 118 # Wortliste für die traditionelle deutsche Rechtschreibung; etwaige
 119 # »Fehleinträge« der traditionellen schweizerdeutschen Rechtschreibung (z.B.
 120 # »süsssauer« statt dem korrekten »süssauer«) werden nicht entfernt.
 121
 122
 123 # M4-Makros mit angehängtem »_« sind für Wörter ohne Trennstellenmarker.
 124
 125
 126 # »s-t« -> »-st« (ref. -> trad.)
 127 #                (ref. -> trad. versal)
 128 #                (ref. -> trad. schweiz.)
 129 #
 130 define(›S_T‹,
 131   ›if ($1 =~ /s \W+ t/x) {
 132      # Trennstelle zwischen »s« und »th(eta)« auch in traditioneller
 133      # Rechtschreibung (z.B. An<äs-the-sie)!
 134
 135      # Kno-ten=äs-te -> Kno-ten=äste
 136      # Äs-te         -> Äste
 137      $1 =~ s/(?: (?<= \W \w )
 138                  | (?<= ^ \w ) )
 139              s-t
 140              (?! h )
 141             /st/xg;
 142
 143      # Tes[-ter=/t=er<.]ken-nung -> Te[-ster=/st=er<.]ken-nung
 144      $1 =~ s/(?<= \w [^s] )
 145              s \[ \W+
 146                   t
 147                   (?! h )
 148                   (.*?)
 149                \/
 150                   t
 151                   (.*?)
 152                \]
 153             /[-st${1}\/st${2}]/xg;
 154
 155      #  fas-te  -> fa-ste
 156      # (fass-te -> fass-te)
 157      $1 =~ s/(?<= \w [^s] )
 158              s-t
 159              (?! h )
 160             /-st/xg;
 161    }‹)
 162
 163 # Nichts zu tun.
 164 define(›S_T_‹, ›‹)
 165
 166
 167 # »-ck« -> »{ck/k-k}« (ref. -> trad.)
 168 #                     (ref. -> trad. versal)
 169 #                     (ref. -> trad. schweiz.)
 170 #
 171 define(›CK‹,
 172   ›if ($1 =~ /ck/) {
 173      # Dru[-cker=/ck=er<.]zeug>nis -> Dru[{ck/k-k}er=/ck=er<.]zeug>nis
 174      $1 =~ s/\[ \W+
 175                 ck
 176                 (.*?)
 177              \/
 178                 ck
 179                 (.*?)
 180              \]
 181             /[{ck\/k-k}${1}\/ck${2}]/xg;
 182
 183      # He-cke -> He{ck/k-k}e
 184      $1 =~ s/[^\w\/\[\]\{\}]+
 185              ck
 186             /{ck\/k-k}/xg;
 187
 188      # Stau[=be-/b=e]cken -> Stau[=b/b=]e{ck/k-k}en
 189      $1 =~ s/\[ (.*?) (.)
 190                 -
 191              \/
 192                 (.*?) \g{2}
 193              \]
 194              ck
 195              (?= [aeiouäöüy] )
 196             /[${1}\/${3}]${2}{ck\/k-k}/xg;
 197
 198      #  Ecke       -> E{ck/k-k}e
 199      #  Buch=ecker -> Buch=e{ck/k-k}er
 200      # (Eck        -> Eck)
 201      # (Vier=eck   -> Vier=eck)
 202      # (blockt     -> blockt)
 203      $1 =~ s/(?: (?<= [^\w\/\[\]\{\}] \w )
 204                  | (?<= ^ \w ) )
 205              ck
 206              (?= [aeiouäöüy] )
 207             /{ck\/k-k}/xg;
 208    }‹)
 209
 210 # Nichts zu tun.
 211 define(›CK_‹, ›‹)
 212
 213
 214 # »-ß« -> »s-s« (ref. -> ref. versal)
 215 #               (ref. -> trad. schweiz.)
 216 #
 217 define(›BINDESTRICH_SZ_1‹,
 218   ›# hei-ße -> heis-se
 219    $1 =~ s/\W+
 220            ß
 221           /s-s/xg;
 222
 223    #  äße      -> äs-se
 224    #  auf<aßen -> auf<as-sen
 225    # (auf<aß   -> auf<aß)
 226    # (auf<aßt  -> auf<aßt)
 227    $1 =~ s/(?: (?<= \W \w )
 228                | (?<= ^ \w ) )
 229            ß
 230            (?= [aeiouäöüy] )
 231           /s-s/xg‹)
 232
 233 define(›BINDESTRICH_SZ_1_‹,
 234   ›$1 =~ s/\W+
 235            ß
 236           /ss/xg;
 237
 238    $1 =~ s/(?: (?<= \W \w )
 239                | (?<= ^ \w ) )
 240            ß
 241            (?= [aeiouäöüy] )
 242           /ss/xg‹)
 243
 244
 245 # »-ß« -> »-ss« (ref. -> trad. versal)
 246 #
 247 define(›BINDESTRICH_SZ_2‹,
 248   ›# hei-ße -> hei-sse
 249    $1 =~ s/-ß
 250           /-ss/xg‹)
 251
 252 define(›BINDESTRICH_SZ_2_‹,
 253   ›$1 =~ s/-ß
 254           /ss/xg‹)
 255
 256
 257 # »ß« -> »ss« (ref. -> ref. versal)
 258 #             (ref. -> trad. versal)
 259 #             (ref. -> trad. schweiz.)
 260 #
 261 # Diese Regel ist nach den spezielleren ß-Regeln weiter oben anzuwenden.
 262 #
 263 define(›SZ‹,
 264   ›# heiß   -> heiss
 265    # büß-te -> büss-te
 266    $1 =~ s/ß
 267           /ss/xg;
 268
 269    # Wir markieren Trennstellen nach »en« und »er« als ungünstig.
 270    #
 271    # Ge<fäss=er<kran-kung -> Ge<fäss=er<.kran-kung
 272    $1 =~ s/ss \W+ (?: en | er ) \K
 273            ([<-]) \.?
 274           /${1}./xg‹)
 275
 276 define(›SZ_‹,
 277   ›$1 =~ s/ß
 278           /ss/xg‹)
 279
 280
 281 # »ss« -> »ß« (ref. -> trad.)
 282 #
 283 define(›SS‹,
 284   ›#  biss=fest -> biß=fest
 285    #  esst      -> eßt
 286    #  Hass      -> Haß
 287    #  Rössl     -> Rößl
 288    # (Fa-desse  -> Fa-desse)
 289    $1 =~ s/ss
 290            (?= (?: [tl]
 291                    | \W
 292                    | $ ) )
 293           /ß/xg;
 294
 295    # Wir entfernen Ungünstigkeitsmarker nach »en« und »er«.
 296    #
 297    # Ab<fluß=er<.hö-hung -> Ab<fluß=er<hö-hung
 298    $1 =~ s/ß \W+ (?: en | er ) [<-] \K
 299            \.
 300           //xg‹)
 301
 302 define(›SS_‹,
 303   ›$1 =~ s/ss
 304            (?= (?: [tl]
 305                    | \W
 306                    | $ ) )
 307           /ß/xg‹)
 308
 309
 310 # »xx-x« -> »{xx/xx-x}« (ref. -> trad.)
 311 #                       (ref. -> trad. versal)
 312 #                       (ref. -> trad. schweiz.)
 313 #
 314 # Buchstabe »x« ist irgendein Konsonant außer »s«.
 315 #
 316 define(›XX_X‹,
 317   ›if ($1 =~ /(.) \g{1} \W+ \g{1}/x) {
 318      #  Bau=stoff==fir-ma -> Bau=sto{ff/ff==f}ir-ma
 319      # (Griff=flä-che     -> Griff=flä-che)
 320      $1 =~ s/([b-df-hj-np-rtv-z]) \g{1} (\W+) \g{1}
 321              (?= [aeiouäöüy] )
 322             /{${1}${1}\/${1}${1}${2}${1}}/xg;
 323
 324      # Kipp=phä-no-men -> Ki{pp/pp=p}hä-no-men
 325      $1 =~ s/([prt]) \g{1} (\W+) \g{1}
 326              (?= h [aeiouäöüy] )
 327             /{${1}${1}\/${1}${1}${2}${1}}/xg;
 328
 329      # Wir markieren Trennstellen nach einen Buchstaben als ungünstig.
 330      #
 331      # Ab<fa{ll/ll=l}a-ger -> Ab<fa{ll/ll=l}a-.ger
 332      $1 =~ s/([b-df-hj-np-rtv-z]) \g{1} \W+ \g{1} } [aeiouäöüy] \K
 333              ([<-]) \.?
 334             /${2}./xg;
 335    }‹)
 336
 337 define(›XX_X_‹,
 338   ›if ($1 =~ /(.) \g{1} \W+ \g{1}/x) {
 339      $1 =~ s/([b-df-hj-np-rtv-z]) \g{1} \W+ \g{1}
 340              (?= [aeiouäöüy] )
 341             /${1}${1}/xg;
 342
 343      $1 =~ s/([prt]) \g{1} \W+ \g{1}
 344              (?= h [aeiouäöüy] )
 345             /${1}${1}/xg;
 346    }‹)
 347
 348
 349 define(›ENTFERNE_MARKER‹,
 350   ›# Es gilt
 351    #
 352    #   {»Variante A«/»Variante B«} -> »Variante A«
 353    #   [»Variante A«/»Variante B«] -> »Variante A«
 354    #
 355    # Beispiele:
 356    #
 357    #   Ab<fa{ll/ll=l}a-.ger -> Ab<falla-.ger
 358    #   Dru[-cker=/ck=er<.]zeug>nis -> Dru-cker=zeug>nis
 359    #
 360    # Beachte, daß »{.../...}« bei reformierter Rechtschreibung nicht
 361    # auftreten kann (»[.../...]« dagegen schon).
 362    #
 363    $1 =~ s/\{ (.*?) \/ .*? \}/${1}/gx;
 364    $1 =~ s/\[ (.*?) \/ .*? \]/${1}/gx;
 365
 366    $1 =~ s/\W//g‹)
 367
 368
 369 # Makros zum Erzeugen von Wortformen aus der reformierten Trennung.
 370 # Wiederum sind die Versionen mit angehängtem »_« im Namen für Wörter ohne
 371 # Trennstellenmarker.
 372
 373 define(›REF‹, ›‹)
 374
 375 define(›REF_‹,
 376    ›ENTFERNE_MARKER(›$1‹)‹)
 377
 378
 379 define(›TRAD‹,
 380   ›S_T(›$1‹);
 381    CK(›$1‹);
 382    SS(›$1‹);
 383    XX_X(›$1‹)‹)
 384
 385 define(›TRAD_‹,
 386   ›S_T_(›$1‹);
 387    CK_(›$1‹);
 388    SS_(›$1‹);
 389    XX_X_(›$1‹);
 390    ENTFERNE_MARKER(›$1‹)‹)
 391
 392
 393 define(›REF_VERSAL‹,
 394   ›BINDESTRICH_SZ_1(›$1‹);
 395    SZ(›$1‹)‹)
 396
 397 define(›REF_VERSAL_‹,
 398   ›BINDESTRICH_SZ_1_(›$1‹);
 399    SZ_(›$1‹);
 400    ENTFERNE_MARKER(›$1‹)‹)
 401
 402
 403 define(›TRAD_VERSAL‹,
 404   ›S_T(›$1‹);
 405    CK(›$1‹);
 406    BINDESTRICH_SZ_2(›$1‹);
 407    SZ(›$1‹);
 408    XX_X(›$1‹)‹)
 409
 410 define(›TRAD_VERSAL_‹,
 411   ›S_T_(›$1‹);
 412    CK_(›$1‹);
 413    BINDESTRICH_SZ_2_(›$1‹);
 414    SZ_(›$1‹);
 415    XX_X_(›$1‹);
 416    ENTFERNE_MARKER(›$1‹)‹)
 417
 418
 419 define(›TRAD_SCHWEIZ‹,
 420   ›S_T(›$1‹);
 421    CK(›$1‹);
 422    BINDESTRICH_SZ_1(›$1‹);
 423    SZ(›$1‹);
 424    XX_X(›$1‹)‹)
 425
 426 define(›TRAD_SCHWEIZ_‹,
 427   ›S_T_(›$1‹);
 428    CK_(›$1‹);
 429    BINDESTRICH_SZ_1_(›$1‹);
 430    SZ_(›$1‹);
 431    XX_X_(›$1‹);
 432    ENTFERNE_MARKER(›$1‹)‹)
 433
 434
 435 # Makros zum Erzeugen von Wortformen aus der traditionellen Trennung.
 436
 437 define(›TRAD_T‹, ›‹)
 438
 439 define(›TRAD_T_‹,
 440   ›ENTFERNE_MARKER(›$1‹)‹)
 441
 442
 443 define(›TRAD_VERSAL_T‹,
 444   ›BINDESTRICH_SZ_2(›$1‹);
 445    SZ(›$1‹)‹)
 446
 447 define(›TRAD_VERSAL_T_‹,
 448   ›BINDESTRICH_SZ_2_(›$1‹);
 449    SZ_(›$1‹);
 450    ENTFERNE_MARKER(›$1‹)‹)
 451
 452
 453 define(›TRAD_SCHWEIZ_T‹,
 454   ›BINDESTRICH_SZ_1(›$1‹);
 455    SZ(›$1‹)‹)
 456
 457 define(›TRAD_SCHWEIZ_T_‹,
 458   ›BINDESTRICH_SZ_1(›$1‹);
 459    SZ(›$1‹);
 460    ENTFERNE_MARKER(›$1‹)‹)
 461
 462
 463 # Konvertiere Argument zu Großbuchstaben (unter Auslassung von »ß«).
 464 #
 465 define(›GROSS‹,
 466   ›translit(›$*‹,
 467             ›abcdefghijklmnopqrstuvwxyzäöü‹,
 468             ›ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ‹)‹)
 469
 470
 471 # Konvertiere ersten Buchstaben des Arguments zu einem Großbuchstaben.  Der
 472 # Code hier ist eine verhübschte Version der Beispieldatei »capitalize2.m4«
 473 # aus der M4-Distribution.
 474 #
 475 define(›_ARG1‹,
 476   ›$1‹)
 477 define(›_ZU_ALT‹,
 478   ›changequote(›»‹, ›«‹)‹)
 479 define(›_VON_ALT‹,
 480   ›changequote(»›«, »‹«)‹)
 481 define(›_GROSS_ALT‹,
 482   ›translit(»$*«,
 483             »abcdefghijklmnopqrstuvwxyzäöü«,
 484             »ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ«)‹)
 485 define(›_KLEIN_ALT‹,
 486   ›translit(»$*«,
 487             »ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ«,
 488             »abcdefghijklmnopqrstuvwxyzäöü«)‹)
 489 define(›_GROSS_ANFANG_ALT‹,
 490   ›regexp(»$1«,
 491           »^\(\w\)\(\w*\)«,
 492           »_GROSS_ALT(»»\1««)_KLEIN_ALT(»»\2««)«)‹)
 493 define(›GROSS_ANFANG‹,
 494   ›_ARG1(_ZU_ALT()patsubst(»»$*««,
 495                            »\w+«,
 496                            _VON_ALT()›«_$0_ALT(»\&«)»‹_ZU_ALT())_VON_ALT())‹)
 497
 498
 499 # Ein Makro, um einen Eintrag im »einträge«-Hash zu setzen.
 500 #
 501 # $1 ist der Präfix (z.B. »ref«)
 502 # $2 ist die Feldkonstante (z.B. »Ref«)
 503 # $3 ist der Flagwert (z.B. »Ref_abgeleitet«)
 504 #
 505 # Verwendete Variablen:
 506 #   $$1_wort (z.B. »$ref_wort«)
 507 #   $$1_wort_lc (z.B. »$ref_wort_lc«)
 508 #   $$1_trennung (z.B. »$ref_trennung«)
 509 #   %einträge
 510 #
 511 define(›EINTRAG‹,
 512   ›@{$einträge{$$1_wort_lc}}[Wort] //= $$1_wort;
 513    @{$einträge{$$1_wort_lc}}[$2, $2_] = ($$1_trennung, $3)‹)
 514
 515
 516 # Ein Makro, um Kommentare im »einträge«-Hash zu setzen.
 517 #
 518 # $1 ist der Präfix (z.B. »ref«)
 519 # $2 ist der Flagwert (z.B. »Ref_abgeleitet«)
 520 #
 521 # Verwendete Variablen:
 522 #   $$1_wort_lc (z.B. »$ref_wort_lc«)
 523 #   $kommentar
 524 #   %einträge
 525 #
 526 define(›KOMMENTAR‹,
 527   ›if (!@{$einträge{$$1_wort_lc}}[Kommentar_]
 528        || @{$einträge{$$1_wort_lc}}[Kommentar_] < $2) {
 529      @{$einträge{$$1_wort_lc}}[Kommentar, Kommentar_] = ($kommentar, $2);
 530    }‹)
 531
 532
 533 # Sekundärmakros, die abgeleitete Wortformen setzen.
 534 #
 535 # $1 ist der Präfix (z.B. »ref«)
 536 # $2 ist das Trennmakro (z.B. »REF«),
 537 # $3 ist das Wortmakro (z.B. »REF_«)
 538 # $4 ist die Feldkonstante (z.B. »Ref«)
 539 # $5 ist das ableitende Wort
 540 #
 541 # Verwendete Variablen:
 542 #   $$1_wort (z.B. »$ref_wort«)
 543 #   $$1_wort_lc (z.B. »$ref_wort_lc«)
 544 #   $$1_trennung (z.B. »$ref_trennung«)
 545 #   %einträge
 546 #
 547 define(›_REF_ABGELEITET‹,
 548   ›$$1_wort = $5;
 549    $3(››$$1_wort‹‹);
 550
 551    $$1_trennung = $5;
 552    $2(››$$1_trennung‹‹);
 553
 554    $$1_wort_lc = lc $$1_wort;
 555    if (!@{$einträge{$$1_wort_lc}}[$4_]) {
 556      EINTRAG(›$1‹, ›$4‹, ›Ref_abgeleitet‹);
 557    }‹)
 558
 559
 560 define(›_TRAD_ABGELEITET‹,
 561   ›$$1_wort = $5;
 562    $3(››$$1_wort‹‹);
 563
 564    $$1_trennung = $5;
 565    $2(››$$1_trennung‹‹);
 566
 567    $$1_wort_lc = lc $$1_wort;
 568    if (!@{$einträge{$$1_wort_lc}}[$4_]
 569        || @{$einträge{$$1_wort_lc}}[$4_] <= Trad_abgeleitet) {
 570      EINTRAG(›$1‹, ›$4‹, ›Trad_abgeleitet‹);
 571    }‹)
 572
 573
 574 # Sekundärmakro, das eine explizite Wortform setzt.
 575 #
 576 # $1 ist der Präfix (z.B. »ref«)
 577 # $2 ist das Trennmakro (z.B. »REF«),
 578 # $3 ist das Wortmakro (z.B. »REF_«)
 579 # $4 ist die Feldkonstante (z.B. »Ref«)
 580 # $5 ist das ableitende Wort
 581 #
 582 # Verwendete Variablen:
 583 #   %einträge
 584 #
 585 # Lokale Variablen:
 586 #   $$1_wort (z.B. »$ref_wort«)
 587 #   $$1_wort_lc (z.B. »$ref_wort_lc«)
 588 #   $$1_trennung (z.B. »$ref_trennung«)
 589 #
 590 define(›_EINTRAG_EXPLIZIT‹,
 591   ›$$1_trennung = $5;
 592
 593    $$1_wort = $5;
 594    ENTFERNE_MARKER(›$$1_wort‹);
 595
 596    $$1_wort_lc = lc $$1_wort;
 597    EINTRAG(›$1‹, ›$4‹, ›Explizit‹)‹)
 598
 599
 600 # Die Hauptmakros sind nur dazu da, die notwendigen Makronamen aus dem
 601 # ersten Argument zu konstruieren.  $2 ist das ableitende Wort.
 602 #
 603 define(›REF_ABGELEITET‹,
 604   ›_$0(›$1‹,
 605        ›GROSS(›$1‹)‹,
 606        ›GROSS(›$1_‹)‹,
 607        ›GROSS_ANFANG(›$1‹)‹,
 608        ›$2‹)‹)
 609
 610
 611 define(›TRAD_ABGELEITET‹,
 612   ›_$0(›$1‹,
 613        ›GROSS(›$1_T‹)‹,
 614        ›GROSS(›$1_T_‹)‹,
 615        ›GROSS_ANFANG(›$1‹)‹,
 616        ›$2‹)‹)
 617
 618
 619 define(›EINTRAG_EXPLIZIT‹,
 620   ›_$0(›$1‹,
 621        ›GROSS(›$1‹)‹,
 622        ›GROSS(›$1_‹)‹,
 623        ›GROSS_ANFANG(›$1‹)‹,
 624        ›$2‹)‹)
 625
 626
 627 # Zum Debuggen.  Das zweite Argument von »format« darf nicht von › und ‹
 628 # umgeben sein.
 629
 630 define(›DEBUG‹,
 631   ›print   "  format(›%-14s‹, patsubst(›$1‹, ›_‹, ›. ‹):) "
 632          . $$1_wort
 633          . " "
 634          . $$1_trennung
 635          . "\n"‹)
 636
 637
 638 # Hauptroutine
 639 # ------------
 640
 641 # Alle Einträge kommen in ein Hash, wobei der Schlüssel das zu trennende
 642 # Wort in Kleinschreibung ist (wir verwenden Perls »lc«-Funktion).  Die
 643 # Elemente sind Arrays mit folgender Struktur:
 644 #
 645 #   Wort              Wort ungetrennt
 646 #   Ref               reformierte Trennung
 647 #   Trad              traditionelle Trennung
 648 #   Ref_versal        reformierte versale Trennung
 649 #   Trad_versal       traditionell versale Trennung
 650 #   Trad_schweiz      traditionelle schweizer Trennung
 651 #   Kommentar         Kommentar, falls vorhanden, sonst ""
 652 #
 653 #   Ref_              s.u.
 654 #   Trad_             s.u.
 655 #   Ref_versal_       s.u.
 656 #   Trad_versal_      s.u.
 657 #   Trad_schweiz_     s.u.
 658 #   Kommentar_        s.u.
 659 #
 660 # Die sechs Felder endend mit »_« sind numerische Flags mit folgenden Werten:
 661 #
 662 #   Ref_abgeleitet    abgeleitet von reformierter Trennung
 663 #   Trad_abgeleitet   abgeleitet von traditioneller Trennung
 664 #   Explizit          explizit gesetzt
 665 #
 666 # Alle Trennungen in einem Element haben die gleiche (ungetrennte) Wortform
 667 # im Gegensatz zur Liste im Kurzformat, wo in einer Zeile verschiedene
 668 # Wörter auftreten können.
 669 #
 670 my %einträge;
 671
 672 use constant {
 673   Wort => 0,
 674   Ref => 1,
 675   Trad => 2,
 676   Ref_versal => 3,
 677   Trad_versal => 4,
 678   Trad_schweiz => 5,
 679   Kommentar => 6,
 680
 681   Ref_ => 7,
 682   Trad_ => 8,
 683   Ref_versal_ => 9,
 684   Trad_versal_ => 10,
 685   Trad_schweiz_ => 11,
 686   Kommentar_ => 12,
 687 };
 688
 689 use constant {
 690   Ref_abgeleitet => 0,
 691   Trad_abgeleitet => 1,
 692   Explizit => 2,
 693 };
 694
 695
 696 # Folgender Algorithmus wird für das Setzen von Kommentaren angewandt.
 697 #
 698 # * Der Eintrag für das erste nicht-leere Feld einer Zeile wird explizit mit
 699 #   einem Kommentar gesetzt (auch wenn er leer sein sollte).
 700 #
 701 # * Abgeleitete Kommentare werden gesetzt, falls sie nicht-leer sind und
 702 #   kein expliziter Eintrag vorhanden ist.
 703
 704
 705 while (<>) {
 706   # Variablen, welche von »REF_ABGELEITET«, »TRAD_ABGELEITET« und
 707   # »EINTRAG_EXPLIZIT« benötigt werden.
 708   my ($ref_wort, $ref_wort_lc, $ref_trennung,
 709       $ref_versal_wort, $ref_versal_wort_lc, $ref_versal_trennung,
 710       $trad_wort, $trad_wort_lc, $trad_trennung,
 711       $trad_versal_wort, $trad_versal_wort_lc, $trad_versal_trennung,
 712       $trad_schweiz_wort, $trad_schweiz_wort_lc, $trad_schweiz_trennung);
 713
 714   chop;
 715
 716   # Reine Kommentarzeilen werden ignoriert.
 717   next if (/^ \s* \#/x);
 718
 719   # Analysiere Zeile.
 720   /^ ([^\#]+?)
 721      \s*
 722      (\# .* )? $/x;
 723
 724   my @trennungen = split(";", ${1});
 725   my $kommentar = ${2} // "";
 726
 727   # Reformierte Rechtschreibung.
 728   my $ref_trennung_explizit = $trennungen[0];
 729
 730   if ($ref_trennung_explizit ne "-1-") {
 731     EINTRAG_EXPLIZIT(›ref‹, ›$ref_trennung_explizit‹);
 732
 733     # Leite reformierte Wortform aus der reformierten Trennung ab.
 734     REF_ABGELEITET(›ref_versal‹, ›$ref_trennung_explizit‹);
 735
 736     KOMMENTAR(›ref‹, ›Explizit‹);
 737     if ($kommentar && @trennungen == 1) {
 738       KOMMENTAR(›ref_versal‹, ›Ref_abgeleitet‹);
 739     }
 740
 741     if ($debug) {
 742       print   "\n"
 743             . "explizit:\n";
 744       DEBUG(›ref‹);
 745       print "abgeleitet:\n";
 746       DEBUG(›ref_versal‹);
 747     }
 748
 749     # Leite traditionelle Wortformen aus der reformierten Trennung ab,
 750     # wenn kein traditioneller Eintrag vorhanden ist.
 751     if (@trennungen == 1) {
 752       REF_ABGELEITET(›trad‹, ›$ref_trennung_explizit‹);
 753       REF_ABGELEITET(›trad_versal‹, ›$ref_trennung_explizit‹);
 754       REF_ABGELEITET(›trad_schweiz‹, ›$ref_trennung_explizit‹);
 755
 756       if ($kommentar) {
 757         KOMMENTAR(›trad‹, ›Ref_abgeleitet‹);
 758         KOMMENTAR(›trad_versal‹, ›Ref_abgeleitet‹);
 759         KOMMENTAR(›trad_schweiz‹, ›Ref_abgeleitet‹);
 760       }
 761
 762       if ($debug) {
 763         DEBUG(›trad‹);
 764         DEBUG(›trad_versal‹);
 765         DEBUG(›trad_schweiz‹);
 766       }
 767     }
 768
 769     $kommentar = "";
 770   }
 771
 772   next if @trennungen == 1;
 773
 774   # Traditionelle Rechtschreibung.
 775   my $trad_trennung_explizit = $trennungen[1] eq "-2-"
 776                                  ? "" : $trennungen[1];
 777
 778   EINTRAG_EXPLIZIT(›trad‹, ›$trad_trennung_explizit‹);
 779   TRAD_ABGELEITET(›trad_versal‹, ›$trad_trennung_explizit‹);
 780   TRAD_ABGELEITET(›trad_schweiz‹, ›$trad_trennung_explizit‹);
 781
 782   if ($kommentar) {
 783     KOMMENTAR(›trad‹, ›Explizit‹);
 784     $kommentar = "";
 785   }
 786
 787   if ($debug && $trad_trennung_explizit) {
 788     print "explizit:\n";
 789     DEBUG(›trad‹);
 790
 791     print "abgeleitet:\n";
 792     DEBUG(›trad_versal‹);
 793     DEBUG(›trad_schweiz‹);
 794   }
 795
 796   next if @trennungen == 2;
 797
 798   # Reformierte Rechtschreibung, Versalform.
 799   my $ref_versal_trennung_explizit = $trennungen[2] eq "-3-"
 800                                        ? "" : $trennungen[2];
 801
 802   EINTRAG_EXPLIZIT(›ref_versal‹, ›$ref_versal_trennung_explizit‹);
 803
 804   if ($kommentar) {
 805     KOMMENTAR(›ref_versal‹, ›Explizit‹);
 806     $kommentar = "";
 807   }
 808
 809   if ($debug && $ref_versal_trennung_explizit) {
 810     print "explizit:\n";
 811     DEBUG(›ref_versal‹);
 812   }
 813
 814   next if @trennungen == 3;
 815
 816   # Traditionelle Rechtschreibung, Versalform.
 817   my $trad_versal_trennung_explizit = $trennungen[3] eq "-4-"
 818                                         ? "" : $trennungen[3];
 819
 820   EINTRAG_EXPLIZIT(›trad_versal‹, ›$trad_versal_trennung_explizit‹);
 821
 822   if ($kommentar) {
 823     KOMMENTAR(›trad_versal‹, ›Explizit‹);
 824     $kommentar = "";
 825   }
 826
 827   if ($debug && $trad_versal_trennung_explizit) {
 828     print "explizit:\n";
 829     DEBUG(›trad_versal‹);
 830   }
 831
 832   next if @trennungen == 4;
 833
 834   # Traditionelle Rechtschreibung, schweizerdeutsch.
 835   my $trad_schweiz_trennung_explizit = $trennungen[4] eq "-5-"
 836                                          ? "" : $trennungen[4];
 837
 838   EINTRAG_EXPLIZIT(›trad_schweiz‹, ›$trad_schweiz_trennung_explizit‹);
 839
 840   if ($kommentar) {
 841     KOMMENTAR(›trad_schweiz‹, ›Explizit‹);
 842     $kommentar = "";
 843   }
 844
 845   if ($debug && $trad_schweiz_trennung_explizit) {
 846     print "explizit:\n";
 847     DEBUG(›trad_schweiz‹);
 848   }
 849 }
 850
 851
 852 # Wir iterieren jetzt über alle Einträge, um sie auszugeben.
 853 foreach my $schlüssel (keys %einträge) {
 854   my ($ref_trennung_lc,
 855       $trad_trennung_lc,
 856       $ref_versal_trennung_lc,
 857       $trad_versal_trennung_lc,
 858       $trad_schweiz_trennung_lc);
 859
 860   my ($wort,
 861       $ref_trennung,
 862       $trad_trennung,
 863       $ref_versal_trennung,
 864       $trad_versal_trennung,
 865       $trad_schweiz_trennung,
 866       $kommentar) = @{$einträge{$schlüssel}};
 867
 868   # Ignoriere leere Einträge.
 869   next unless $ref_trennung
 870               || $trad_trennung
 871               || $ref_versal_trennung
 872               || $trad_versal_trennung
 873               || $trad_schweiz_trennung;
 874
 875   print $wort;
 876
 877   $ref_trennung //= "";
 878   $trad_trennung //= "";
 879   $ref_versal_trennung //= "";
 880   $trad_versal_trennung //= "";
 881   $trad_schweiz_trennung //= "";
 882
 883   $ref_trennung_lc = lc $ref_trennung;
 884   $trad_trennung_lc = lc $trad_trennung;
 885   $ref_versal_trennung_lc = lc $ref_versal_trennung;
 886   $trad_versal_trennung_lc = lc $trad_versal_trennung;
 887   $trad_schweiz_trennung_lc = lc $trad_schweiz_trennung;
 888
 889   if ($ref_trennung_lc
 890       && $ref_trennung_lc eq $trad_trennung_lc
 891       && (!$ref_versal_trennung_lc
 892           || ($trad_trennung_lc eq $ref_versal_trennung_lc
 893               && $ref_versal_trennung_lc eq $trad_versal_trennung_lc
 894               && $trad_versal_trennung_lc eq $trad_schweiz_trennung_lc))) {
 895     print   ";"
 896           . $ref_trennung; # Feld 2
 897   }
 898   else {
 899     print   ";"
 900           . "-2-"
 901           . ";"
 902           . ($trad_trennung ? $trad_trennung
 903                             : "-3-")
 904           . ";"
 905           . ($ref_trennung ? $ref_trennung
 906                            : "-4-");
 907
 908     if ($ref_trennung_lc ne $ref_versal_trennung_lc
 909         || $trad_trennung_lc ne $trad_versal_trennung_lc
 910         || $trad_trennung_lc ne $trad_schweiz_trennung_lc) {
 911       if ($ref_versal_trennung_lc eq $trad_versal_trennung_lc
 912           && $ref_versal_trennung_lc eq $trad_schweiz_trennung_lc) {
 913         if ($ref_versal_trennung) {
 914           print   ";"
 915                 . $ref_versal_trennung; # Feld 5
 916         }
 917       }
 918       else {
 919         print   ";"
 920               . "-5-"
 921               . ";"
 922               . ($trad_versal_trennung ? $trad_versal_trennung
 923                                        : "-6-")
 924               . ";"
 925               . ($ref_versal_trennung ? $ref_versal_trennung
 926                                       : "-7-");
 927
 928         if ($trad_versal_trennung_lc ne $trad_schweiz_trennung_lc) {
 929           print   ";"
 930                 . ($trad_schweiz_trennung ? $trad_schweiz_trennung
 931                                           : "-8-");
 932         }
 933       }
 934     }
 935   }
 936
 937   print " " . $kommentar if $kommentar;
 938
 939   print "\n";
 940 }
 941
 942 # EOF