#!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use open qw(:std :utf8);
use integer;
use Unicode::Normalize;
# Filter_5_01_insert_reg.pl
# 2010-06-04
# Wolfgang Schmidle
# beware:
# Mac OS X 10.6.4 still includes Perl 5.10.0, which implements Unicode 5.0 rather than 5.2
# (see https://it-dev.mpiwg-berlin.mpg.de/tracs/mpdl-project-content/wiki/mac-perl-unicode)
my $dir = "/Users/wschmidle/Desktop/Schema/trunk/trunk/texts/aux";
# the following variables may be changed
my $que1 = "(?:q;|)"; # alle Formen von -que ohne Akut
my $que2 = "(?:q́;|q́ue|'que|́)"; # alle Formen von -que mit Akut (beachte: vor Variablen kann das ; fehlen)
# my %wordlistContext = (
# "tñ" => "tantum" # check for "tamen" first!
# );
my %wordlist = ();
my %wordlistAbbreviations = ();
my %regSimple = ();
my $klein = "a-zſæœèòäöüßó";
# $klein .= "ãẽĩõũꝰę"; # sollten Vokale mit Tilde hier überhaupt dabei sein? Das sind doch nur Zeichen, die nicht normalisiert werden?? Immerhin schaden sie wohl auch nicht?
my $gross = "A-ZÄÖÜÆŒ";
my $vor = " (>;:";
my $nach = " )<.,:;!?&\n"; # Vorsicht bei . und :
# the following variables shouldn't be changed
my $vowelTilde = "[ãẽĩõũ]";
my $vowelTildeEndWithM = "[ãẽũ]";
my $vowelTildeEndWithN = "[õ]"; # resolve ĩ via the wordlist
my $withM = "[pbm]";
my $withN = "[sſtcdfginquv]";
my %noTilde = ( "ã" => "a", "ẽ" => "e", "ĩ" => "i", "õ" => "o", "ũ" => "u" );
my $hyphen = "[-]"; # normales hyphen und soft hyphen
my $lb = "
";
my $pb = "\n?]+>\n?";
my $linebreak = "$hyphen(?:$lb|$pb)";
my $kl = "(?:[$klein]|$linebreak)*";
my $gr = "[$gross]?";
my $vo = "(?<=[$vor])";
my $na = "(?=[$nach])";
my $reg = "¤([^¤]+)¤¤([^¤]+)¤¤¤([^¤]+)¤¤¤¤";
# Text einlesen
my @text;
my $isLongline = 0;
my $longline = "";
while(<>) {
if ($isLongline) {
$longline .= $_;
next if m!]\n!;
push @text, $longline;
$isLongline = 0;
next;
}
if (m![^>]\n!) {
$isLongline = 1;
$longline = $_;
next;
}
push @text, $_;
}
# Hilfsdateien einlesen
my @wortlisten = ();
my @simple = ();
my $inText = 0;
my $inParameters = 0;
foreach (@text) {
last if m!!) { $inParameters = 1; }
if ($inParameters) {
while (m!reg\.wordlist *= *([^, <]+)[, <]!g) { push @wortlisten, "$dir/$1"; }
while (m!reg\.simple *= *([^, <]+)[, <]!g) { push @simple, "$dir/$1"; }
}
if (m!!) { $inParameters = 0; }
}
if ($#wortlisten > -1) {
@ARGV = @wortlisten;
}
# es folgt ein übler Hack für Alvarus
else {
@ARGV = (
"$dir/reg-wordlist-lat.txt",
"$dir/reg-wordlist-lat-hentisberi.txt",
"$dir/reg-wordlist-lat-alvarus.txt"
);
}
while (<>) {
chomp;
s!#.*$!!; # remove comments
s! +$!!;
next if m!^$!;
if (m!^\[(.+?)\] *= *(.+)!) {
$wordlistAbbreviations{$1} = $2;
next;
}
if (m!(.+?) *= *(.*)!) {
my $orig = $1;
my $norm = $2;
while ($orig =~ m!\[(.+?)\]!g) {
unless (exists $wordlistAbbreviations{$1}) { die "unknown abbreviation [$1]\n"; }
}
$orig =~ s!\[(.+?)\]!$wordlistAbbreviations{$1}!g;
$orig =~ s!\.!\\.!g;
$wordlist{$orig} = $norm;
}
}
if ($#simple > -1) {
@ARGV = @simple;
}
# wieder ein übler Hack für Alvarus
else {
@ARGV = (
"$dir/reg-simple-lat.txt",
"$dir/reg-simple-lat-alvarus.txt"
);
}
while (<>) {
chomp;
s!#.*$!!; # remove comments
s! +$!!;
next if m!^$!;
if (m!(.+?) *> *(.*)!) {
my $orig = $1;
my $norm = $2;
$regSimple{$orig} = $norm;
}
}
# Textzeilen bearbeiten
foreach (@text) {
# if (m!
# pr¤ę¤ae¤simple¤sẽs -->
# pr¤ę¤ae¤simple¤s¤ẽ¤en¤context¤s -->
# praesens -->
# praesens (falls alle "simple" entfernt werden)
# beachte: ($key) und orig="$1", damit $que aufgelöst wird
# foreach my $key (keys %wordlistContext) {
# s!$vo($key)$na!$wordlistContext{$key}!g;
# }
# schütze bereits regularisierte Formen vor erneuter Regularisierung
# protectori
s!!£!g; # reicht für Wortlisten-Regularisierungen und -que bereits aus
s!$1£!g;
}
# -que: vor allen anderen simplen Ersetzungen
s/($que2)(?![£¥])/¤$1¤¤que¤¤¤simple¤¤¤¤/g;
# das gleiche mit que1: aber eigentlich nur, wenn ein Parameter gesetzt ist
s/($que1)(?![£¥])/¤$1¤¤que¤¤¤simple¤¤¤¤/g;
s!(q́)( |\. | \.)!¤$1¤¤que¤¤¤simple¤¤¤¤$2!g; # Ausnahme: vor einer Zahl oder Variablen kann ; fehlen.
foreach my $key (keys %regSimple) {
1 while s/(¢[^£]*$key)(?!¥)/$1¥/;
s/($key)(?![¥\p{M}])/¤$1¤¤$regSimple{$key}¤¤¤simple¤¤¤¤/g;
# \p{M} verhindert, dass ꝗ auch ꝗ̃ findet
}
# Parameter für Alvarus: Makron bewirkt das gleiche wie Tilde
# (in anderen Texten könnte man gleich Makron durch Tilde ersetzen!)
$vowelTilde = "[ãẽĩõũāēīōū]";
$vowelTildeEndWithM = "[ãẽũāēū]";
$vowelTildeEndWithN = "[õō]";
%noTilde = (
"ã" => "a", "ẽ" => "e", "ĩ" => "i", "õ" => "o", "ũ" => "u",
"ā" => "a", "ē" => "e", "ī" => "i", "ō" => "o", "ū" => "u"
);
# Tilde über Vokal
1 while s/(¢[^£]*$vowelTilde)(?!¥)/$1¥/;
s!($vowelTilde)(?=(?:$linebreak)?¤$que2)!¤$1¤¤$noTilde{$1}m¤¤¤context¤¤¤¤!g; # vor -que: m
s!($vowelTilde)(?=(?:$linebreak)?$withM)!¤$1¤¤$noTilde{$1}m¤¤¤context¤¤¤¤!g;
s!($vowelTilde)(?=(?:$linebreak)?$withN)!¤$1¤¤$noTilde{$1}n¤¤¤context¤¤¤¤!g;
s!($vowelTildeEndWithM)$na!¤$1¤¤$noTilde{$1}m¤¤¤context¤¤¤¤!g;
s!($vowelTildeEndWithN)$na!¤$1¤¤$noTilde{$1}n¤¤¤context¤¤¤¤!g;
# (rules for õr=orr and õl=oll if as soon as cases like this occur)
s![¥¢£]!!g;
# Wörter mit vier Ersetzungen
s!$vo($gr$kl)$reg($kl)$reg($kl)$reg($kl)$reg($kl)$na!$1$2$5$6$9$10$13$14$17!og;
s!( norm="[^"]*$hyphen)(?:$lb|$pb)([^"]*")!$1 $2!g;
# Wörter mit drei Ersetzungen
s!$vo($gr$kl)$reg($kl)$reg($kl)$reg($kl)$na!$1$2$5$6$9$10$13!og;
s!( norm="[^"]*$hyphen)(?:$lb|$pb)([^"]*")!$1 $2!g;
# Wörter mit zwei Ersetzungen
s!$vo($gr$kl)$reg($kl)$reg($kl)$na!$1$2$5$6$9!og;
s!( norm="[^"]*$hyphen)(?:$lb|$pb)([^"]*")!$1 $2!g;
# Wörter mit einer Ersetzung
s!$vo($gr$kl)$reg($kl)$na!$1$2$5!og;
s!( norm="[^"]*$hyphen)(?:$lb|$pb)([^"]*")!$1 $2!g;
if (m!¤!) { die "Fehler beim Einfügen von : $_\n"; }
}
# geänderten Text ausgeben
print @text;
# TO DO:
# tamen versus tantum: Besser getrennt in der Nachbearbeitung?
# pb ?
# ziehe den Abkürzungspunkt heraus, wenn es zugleich der Satzpunkt ist: Beispiel "aīa."
# ↄ̨ſtantium : besser simple statt wordlist?
# ↄ̨-
ſtantium: wird zwar mit markiert, aber der
verschwindet im regularisierten Text
# --> nee, stimmt gar nicht, sondern es wird nicht markiert
# --> kann man das irgendwie lösen? Anders gesagt: kann man eine Zuordnung der Wortstücke
# machen? Bei ↄ̨ſtantium geht das sicher, aber wie ist es bei merkwürdigen Abkürzungen?
# Kann man da dann wiederum erwarten, dass es keine
gibt?
# poem: anders markieren
# schau nach, ob alle Sachen in den Benedetti-Texten übernommen wurden!
# Problem:
in einem Wort der wordlist
# Problem: Großbuchstabe in einem Wort der wordlist, z.B. "Qũo"
# unklare Wörter: bei der automatischen Verarbeitung besser als tamen/tantum ?
# muss auch funktionieren, wenn xml:space schon eingefügt wurde; dürfte aber kein Problem sein
# muss auch mit & statt ' umgehen können.
# Parameter:
# - Alvarus: kein Akut bei -que, Benedetti: Akut, wenn es "und" meint, also nciht be denique
# - man kann Zeichen ergänzen, die als Variablen verwendet werden, zum Beispiel æ in Benedetti
# hierarchische Parameter, zum Beispiel "16. Jahrhundert", die dann Standardwerte für untergeorndete
# Parameter bewirken (was wiederum durch explizite Setzung überschrieben werden kann)
# zum Alvarus-Hack: wenn es nicht gibt, sollte das Skript nach einer Datei in einem festen
# Verzeichnis suchen, zum Beispiel aux/parameters.txt
# und simple mit -->, sodass man alles auf einmal einlesen kann
# simple könnte schon auf die Wortliste wirken. nicht direkt, aber ungefähr. Oder: Parameter "makron gleich
# tilde" könnte direkt auf die Wortliste wirken
# umsteigen von alle Wörter der Wortliste durchgehen zu alle Wörter des Textes durchgehen
# Hilfsdatei wie "Bischoff-paleography.txt" ?