skripte/perl/wlsort.pl

   1 #! /usr/bin/perl -w
   2 #
   3 # wlsort.pl
   4 #
   5 # Dieses Perl-Skript sortiert eine Wortlisten-Datei (entweder im alten oder
   6 # neuen Format des »wortlisten«-Projekts) zeilenweise.
   7 #
   8 # Die Eingabe auf stdin muß UTF-8-kodiert sein; die Ausgabe erfolgt auf
   9 # stdout.
  10 #
  11 # Die angewandte Sortierung ist die Duden-Sortierung für Deutsch, basierend
  12 # auf dem Zeichenrepertoire von ISO-8859-15 (latin9) plus »ſ«.
  13 #
  14 # Beispiel:
  15 #
  16 #   wlsort.pl < eingabe > ausgabe
  17
  18 use strict;
  19 use warnings;
  20 use utf8;                              # String-Literals direkt als UTF-8.
  21 use open qw(:std :utf8);
  22 use feature 'unicode_strings';
  23
  24 my %wortliste;
  25
  26 while (<>) {
  27   # Bestimme den Schlüsselwert einer Zeile für die Hash-Tabelle; wir
  28   # verwenden das erste nicht-leere Feld (ohne Trennzeichen).
  29   #
  30   # Beispiele:
  31   #
  32   #   abartigste;-2-;ab<ar-tig-ste;ab<ar-tigs-te  ->  abartigste
  33   #   -1-;an<ge<rauht                             ->  angerauht
  34   #
  35   my $wort = $_;
  36
  37   # Entferne Kommentar.
  38   $wort =~ s/\# .*+ $//x;
  39
  40   # {»Variante A«/»Variante B«} -> »Variante A«
  41   # [»Variante A«/»Variante B«] -> »Variante A«
  42   #
  43   # Es genügt, den ersten Treffer zu bearbeiten.
  44   $wort =~ s/\{ ([^\/]*+) \/ [^}]*+ \}/$1/x;
  45   $wort =~ s/\[ ([^\/]*+) \/ [^]]*+ \]/$1/x;
  46
  47   # Entferne alle Nicht-Buchstaben außer »;«.
  48   $wort =~ s/[^\p{Alpha};]//g;
  49
  50   # Reduziere auf erstes nicht-leeres Feld.
  51   $wort =~ /^ ;*+ ([^;]++)/x;
  52   $wortliste{$1} = $_;
  53 }
  54
  55 foreach my $erstes_feld
  56         (map {
  57            # Retourniere das originale Wort (also das vierte Element)
  58            # nach dem Suchvorgang.
  59            (split("\0"))[3]
  60          }
  61
  62          sort
  63
  64          map {
  65            # Damit das Sortieren möglichst schnell abläuft, verwenden
  66            # wir einerseits »sort« ohne eine explizite Subroutine (das
  67            # bedeutet im besonderen, daß wir uns auf eine reine
  68            # lexikographische Sortierung beschränken müssen),
  69            # andererseits »tr///« zum Erstellen der Sortierschlüssel,
  70            # soweit wie möglich.  Als Abbildung benutzen wir daher
  71            # passende Unicode-Zeichen, deren Werte ausschließlich zur
  72            # Sortierung verwendet werden.
  73
  74            my $s1 = lc;
  75            my $s2 = $s1;
  76            my $s3 = $_;
  77
  78            my $hat_ligatur = /[ßÆæŒœ]/;
  79
  80            # Wir brauchen drei Sortierschlüssel, siehe weiter unten.
  81            # Die Zeichen »ß«, »Æ«, »æ«, »Œ« und »œ« werden wie
  82            # zweibuchstabige Sequenzen behandelt.
  83            #
  84            # Alle nicht explizit erwähnten Zeichen werden anhand ihres
  85            # Unicode-Wertes sortiert.
  86            #
  87            # Beachte, daß beim Sortieren der Daten im »wortliste«-Projekt
  88            # die tertiäre Sortierung nicht zum Einsatz kommt, da es keine
  89            # Dopplungen gibt, die sich nur durch die Groß- und
  90            # Kleinschreibung unterscheiden.
  91
  92            # Die primäre Sortierung vergleicht Zeichen in
  93            # Kleinschreibung ohne diakritischen Akzent (oder
  94            # Äquivalente; wir bilden beispielsweise »ð« auf »d« ab).
  95            #
  96            $s1 =~ tr[àáâãäåçðèéêëìíîïñòóôõöøšſþùúûüýÿž]
  97                     [aaaaaacdeeeeiiiinoooooosstuuuuyyz];
  98
  99            if ($hat_ligatur) {
 100              $s1 =~ s/ß/ss/g;
 101              $s1 =~ s/æ/ae/g;
 102              $s1 =~ s/œ/oe/g;
 103            }
 104
 105            # Die sekundäre Sortierung ordnet die Akzente
 106            # bzw. Äquivalente (zuerst Grundbuchstaben, dann Zeichen
 107            # mit Diakritika).
 108            #
 109            # Die Formatierung des ersten und zweiten Arguments von
 110            # »tr« muß identisch sein!
 111            $s2 =~ tr
 112 [aàáâãäå
 113 b
 114 cç
 115 dð
 116
 117 eèéêë
 118 fgh
 119 iìíîï
 120 jklm
 121
 122 nñ
 123 oòóôõöø
 124 pqr
 125 sſš
 126
 127 tþ
 128 uùúûü
 129 vwx
 130 yýÿ
 131 zž]
 132 [\x{200}\x{201}\x{202}\x{203}\x{204}\x{205}\x{206}
 133 \x{210}
 134 \x{220}\x{221}
 135 \x{230}\x{231}
 136
 137 \x{240}\x{241}\x{242}\x{243}\x{244}
 138 \x{250}\x{251}\x{252}
 139 \x{260}\x{261}\x{262}\x{263}\x{264}
 140 \x{270}\x{271}\x{272}\x{273}
 141
 142 \x{280}\x{281}
 143 \x{290}\x{291}\x{292}\x{293}\x{294}\x{295}\x{296}
 144 \x{300}\x{301}\x{302}
 145 \x{310}\x{311}\x{313}
 146
 147 \x{320}\x{321}
 148 \x{330}\x{331}\x{332}\x{333}\x{334}
 149 \x{340}\x{341}\x{342}
 150 \x{350}\x{351}\x{352}
 151 \x{360}\x{361}];
 152
 153            if ($hat_ligatur) {
 154              $s2 =~ s/ß/\x{310}\x{312}/g;
 155              $s2 =~ s/æ/\x{200}\x{245}/g;
 156              $s2 =~ s/œ/\x{290}\x{245}/g;
 157            }
 158
 159            # Die tertiäre Sortierung gibt die Groß- und
 160            # Kleinschreibung an (zuerst Klein-, dann Großbuchstaben).
 161            #
 162            if ($hat_ligatur) {
 163              $s3 =~ s/ß/ss/g;
 164              $s3 =~ s/Æ/Ae/g;
 165              $s3 =~ s/Œ/Oe/g;
 166              $s3 =~ s/æ/ae/g;
 167              $s3 =~ s/œ/oe/g;
 168            }
 169
 170            # Die Formatierung des ersten und zweiten Arguments von
 171            # »tr« muß identisch sein!
 172            $s3 =~ tr
 173 [A-ZÀÁÂÃÄÅÇÐÈÉÊËÌÍÎÏÑÒÓÔÕÖØŠÞÙÚÛÜÝŸŽ
 174 a-zàáâãäåçðèéêëìíîïñòóôõöøšþùúûüýÿž]
 175 [a-zaaaaaacdeeeeiiiinoooooostuuuuyyz
 176 A-ZAAAAAACDEEEEIIIINOOOOOOSTUUUUYYZ];
 177
 178            # Wir konstruieren jetzt den Sortierschlüssel (als
 179            # Rückgabewert dieser »map«-Funktion).  Zu diesem Zweck
 180            # hängen wir die Sortierschlüssel mit dem Wort zusammen
 181            # (wobei das Wort am Schluß kommt), unter Verwendung von
 182            # Nullbytes als Feldtrenner.
 183            #
 184            #   http://www.sysarch.com/Perl/sort_paper.html
 185            #
 186            # Wir verwenden Typ »a« für das Originalwort in »pack«,
 187            # damit es unverändert bleibt und kein Padding angewandt
 188            # wird.
 189            pack("A*xA*xA*xa*", $s1, $s2, $s3, $_);
 190          }
 191          keys %wortliste) {
 192   print $wortliste{$erstes_feld};
 193 }
 194
 195 # eof