apply-pattern.pl

   1 #! /usr/bin/perl -w
   2 #
   3 # apply-pattern.pl
   4 #
   5 # Dieses Perl-Skript wendet die TeX-Trennmusterdatei $1 auf den Datenstrom
   6 # an, wobei $2 als Translationsdatei benutzt wird (das ist diejenige Datei,
   7 # die `patgen' als viertes Argument benötigt).  Die Eingabe kann `-'-Zeichen
   8 # enthalten, welche vor der Weiterverarbeitung herausgefiltert werden.
   9 #
  10 # Trennungen direkt nach dem ersten und vor dem letzten Buchstaben in der
  11 # Ausgabe werden entfernt, wie bei deutschen Trennungen erforderlich.
  12 #
  13 # Dieses Skript benützt patgen, nicht TeX!  Die Trennmusterdatei darf daher
  14 # keine TeX-Konstrukte (Makros u.ä.) enthalten.
  15 #
  16 # Aufruf:  perl apply-pattern.pl trennmuster german.tr < eingabe > ausgabe
  17
  18 use strict;
  19 use File::Spec;
  20 use File::Temp;
  21
  22 my $prog = $0;
  23 $prog =~ s@.*/@@;
  24
  25 if ($#ARGV != 1) {
  26   die "Aufruf:  $prog trennmuster german.tr < eingabe > ausgabe\n";
  27 }
  28
  29 my $trennmuster = File::Spec->rel2abs($ARGV[0]);
  30 my $translation = File::Spec->rel2abs($ARGV[1]);
  31 my $tempdir = File::Temp::tempdir(CLEANUP => 1);
  32 my $tempdatei = "pattern";
  33 my $null = File::Spec->devnull();
  34 my $stdin = "input";
  35
  36 chdir $tempdir
  37 || die "$prog: Kann nicht ins temporäre Verzeichnis `$tempdir' wechseln: $!\n";
  38
  39 my @eingabe;
  40
  41 open TEMP, '>', $tempdatei
  42 || die "$prog: Kann temporäre Datei `$tempdatei' nicht öffnen: $!\n";
  43 while (<STDIN>) {
  44   s/-//g;
  45   push(@eingabe, $_);
  46   print TEMP $_;
  47 }
  48 close TEMP;
  49
  50 open TEMP, '>', $stdin
  51 || die "$prog: Kann temporäre Datei `$stdin' nicht öffnen: $!\n";
  52 print TEMP "9 8\n";
  53 print TEMP "y\n";
  54 close TEMP;
  55
  56 # Portables Umleiten von stdin, stdout und stderr ...
  57 open STDOUT_ALT, '>&', \*STDOUT
  58 || die "$prog: Kann STDOUT nicht duplizieren: $!\n";
  59 open STDERR_ALT, '>&', \*STDERR
  60 || die "$prog: Kann STDERR nicht duplizieren: $!\n";
  61 open STDOUT, '>', $null
  62 || die "$prog: Kann STDOUT nicht zur Nullausgabe umleiten: $!\n";
  63 open STDERR, '>', $null
  64 || die "$prog: Kann STDERR nicht zur Nullausgabe umleiten: $!\n";
  65 open STDIN, $stdin
  66 || die "$prog: Kann `$stdin' nicht nach STDIN umleiten: $!\n";
  67
  68 my $status = system("patgen $tempdatei $trennmuster $null $translation");
  69 my $fehler = $?;
  70
  71 open STDOUT, '>&', \*STDOUT_ALT
  72 || die "$prog: Kann STDOUT nicht wieder herstellen: $!\n";
  73 open STDERR, '>&', \*STDERR_ALT
  74 || die "$prog: Kann STDERR nicht wieder herstellen: $!\n";
  75
  76 die "$prog: Aufruf von patgen fehlgeschlagen: $fehler\n" if $status;
  77
  78 my @muster;
  79 my ($pattmp) = <pattmp.*>;
  80 open PATGEN, $pattmp
  81 || die "$prog: Kann von patgen erzeugte Datei `$pattmp' nicht öffnen: $!\n";
  82 while (<PATGEN>) {
  83   s/\./-/g;
  84   s/^(.)-/$1/;
  85   s/-(.)$/$1/;
  86   push(@muster, $_);
  87 }
  88 close PATGEN;
  89
  90 while (@eingabe) {
  91   my @vorlage = split(//, shift(@eingabe));
  92   my @ergebnis = split(//, shift(@muster));
  93   my $i = 0;
  94   my $j = 0;
  95
  96   # letztes Zeichen ist immer \n, daher < und nicht <=
  97   while ($i < $#vorlage) {
  98     $j++ if ($ergebnis[$j] eq '-');
  99     $ergebnis[$j++] = $vorlage[$i++];
 100   }
 101   print @ergebnis;
 102 }
 103
 104 # eof