skripte/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).
   8 #
   9 # Folgende Zeichen werden vor der Weiterverarbeitung aus der Eingabe
  10 # herausgefiltert:
  11 #
  12 #   · - = | < >
  13 #
  14 # Ist Option `-1' nicht gegeben, werden Trennungen direkt nach dem ersten
  15 # und vor dem letzten Buchstaben in der Ausgabe entfernt, wie z.B. bei
  16 # deutschen Trennungen erforderlich.
  17 #
  18 # Dieses Skript benützt patgen, nicht TeX!  Die Trennmusterdatei darf daher
  19 # keine TeX-Konstrukte (Makros u.ä.) enthalten.
  20 #
  21 # Aufruf:  perl apply-pattern.pl trennmuster german.tr < eingabe > ausgabe
  22
  23 use strict;
  24 use Encode;
  25 use File::Spec;
  26 use File::Temp;
  27
  28 use Getopt::Std;
  29 getopts('1');
  30
  31 our ($opt_1);
  32
  33 my $prog = $0;
  34 $prog =~ s@.*/@@;
  35
  36 if ($#ARGV != 1) {
  37   die "Aufruf:  $prog [-1] trennmuster german.tr < eingabe > ausgabe\n" .
  38       "\n" .
  39       "  Alle Daten müssen UTF-8-Kodierung verwenden.\n" .
  40       "\n" .
  41       "  Mit Option `-1' bleiben Trennungen nach dem ersten und\n" .
  42       "  vor dem letzten Buchstaben in der Ausgabe.\n";
  43 }
  44
  45 my $trennmuster = File::Spec->rel2abs($ARGV[0]);
  46 my $translation = File::Spec->rel2abs($ARGV[1]);
  47 my $tempdir = File::Temp::tempdir(CLEANUP => 1);
  48 my $tempdatei = "pattern";
  49 my $null = File::Spec->devnull();
  50 my $stdin = "input";
  51
  52 chdir $tempdir
  53 || die "$prog: Kann nicht ins temporäre Verzeichnis `$tempdir' wechseln: $!\n";
  54
  55 my @eingabe;
  56
  57 open TEMP, '>', $tempdatei
  58 || die "$prog: Kann temporäre Datei `$tempdatei' nicht öffnen: $!\n";
  59
  60 while (<STDIN>) {
  61   s/[·=|<>-]//g;
  62   push(@eingabe, $_);
  63   print TEMP $_;
  64 }
  65 close TEMP;
  66
  67 open TEMP, '>', $stdin
  68 || die "$prog: Kann temporäre Datei `$stdin' nicht öffnen: $!\n";
  69 print TEMP "9 8\n";
  70 print TEMP "y\n";
  71 close TEMP;
  72
  73 # Portables Umleiten von stdin, stdout und stderr ...
  74 open STDOUT_ALT, '>&', \*STDOUT
  75 || die "$prog: Kann STDOUT nicht duplizieren: $!\n";
  76 open STDERR_ALT, '>&', \*STDERR
  77 || die "$prog: Kann STDERR nicht duplizieren: $!\n";
  78 open STDOUT, '>', $null
  79 || die "$prog: Kann STDOUT nicht zur Nullausgabe umleiten: $!\n";
  80 open STDERR, '>', $null
  81 || die "$prog: Kann STDERR nicht zur Nullausgabe umleiten: $!\n";
  82 open STDIN, $stdin
  83 || die "$prog: Kann `$stdin' nicht nach STDIN umleiten: $!\n";
  84
  85 my $status = system("patgen $tempdatei $trennmuster $null $translation");
  86 my $fehler = $?;
  87
  88 open STDOUT, '>&', \*STDOUT_ALT
  89 || die "$prog: Kann STDOUT nicht wieder herstellen: $!\n";
  90 open STDERR, '>&', \*STDERR_ALT
  91 || die "$prog: Kann STDERR nicht wieder herstellen: $!\n";
  92
  93 die "$prog: Aufruf von patgen fehlgeschlagen: $fehler\n" if $status;
  94
  95 my @muster;
  96 my ($pattmp) = <pattmp.*>;
  97 open PATGEN, $pattmp
  98 || die "$prog: Kann von patgen erzeugte Datei `$pattmp' nicht öffnen: $!\n";
  99 while (<PATGEN>) {
 100   s/\./-/g;
 101   s/^(.)-/$1/ if not $opt_1;
 102   s/-(.)$/$1/ if not $opt_1;
 103   push(@muster, $_);
 104 }
 105 close PATGEN;
 106
 107 while (@eingabe) {
 108   my @vorlage = split(//, shift(@eingabe));
 109   my @ergebnis = split(//, shift(@muster));
 110   my $i = 0;
 111   my $j = 0;
 112
 113   # letztes Zeichen ist immer \n, daher < und nicht <=
 114   while ($i < $#vorlage) {
 115     $j++ if ($ergebnis[$j] eq '-');
 116     $ergebnis[$j++] = $vorlage[$i++];
 117   }
 118   print @ergebnis;
 119 }
 120
 121 END {
 122   chdir($ENV{HOME}) || chdir('/');
 123 }
 124
 125 # eof