Codierungen austauschen innerhalb Tags

Hallo,

In einer Textdatei (in.txt) mit folgendem Inhalt:

<0xF074><0xF06F><0xF069><0xF06F>
<0xF0A5>

sollen die Codes der Buchstaben jeweils bei Schrift 1 und Schrift 2 nach
zwei unterschiedlichen Suche/Ersetzen-Tabelle ausgetauscht werden.
Ungefähr so habe ich es versucht. Aber das funktioniert nicht, weil alle
Codes und nicht nur diejenigen zwischen den Tags von Schrift 1.

open(OUT, ">out.txt") or die " Die Datei kann nicht geoeffnet werden: $!\n";
open(FILE, "in.txt") or die " Die Datei kann nicht geoeffnet werden: $!\n";
my $Muster = '/()([A-Zx0-9<> ]*)()/';

while () {
if ($Muster) {
s/<0xF0A1>/<0x1F71>/g;
s/<0xF0A2>/<0x1F70>/g;
s/<0xF0A3>/<0x1F00>/g;
s/<0xF0A4>/<0x1F01>/g;
usw....
}
print OUT;
}
close OUT;
close FILE;

Wie kann ich es schaffen, dass nur die Codes zwischen den Tags einer
einzigen Schrift (z.B. Schrift1) getausche werden?

Für Hilfe wäre ich sehr dankbar
Klaus

Re: Codierungen austauschen innerhalb Tags

Thus spoke Klaus Boer (on 2006-10-14 23:07):
> In einer Textdatei (in.txt) mit folgendem Inhalt:
> <0xF074><0xF06F><0xF069><0xF06F>
> <0xF0A5>
>
> sollen die Codes der Buchstaben jeweils bei Schrift 1 und Schrift 2 nach
> zwei unterschiedlichen Suche/Ersetzen-Tabelle ausgetauscht werden.
> Ungefähr so habe ich es versucht. Aber das funktioniert nicht, weil alle
> Codes und nicht nur diejenigen zwischen den Tags von Schrift 1.

Hallo Klaus,

> my $Muster = '/()([A-Zx0-9<> ]*)()/';

so würde das nicht gehen, Du meinst wahrscheinlich sowas wie

my $Muster = qr{.+?};

> while () {
> if ($Muster) {
> s/<0xF0A1>/<0x1F71>/g;
> Wie kann ich es schaffen, dass nur die Codes zwischen den Tags einer
> einzigen Schrift (z.B. Schrift1) getausche werden?

Ich denke, das ist neben dem Regex-Problem auch ein
Problem der Organisation. Und da ich gerade warte,
dass mein *BSD seinen kleinen Gnome auf 2.16 hoch-
tüddelt, habe ich mal ein rudimentäres Programm
geschrieben, das dies tut.

Das wäre dann "meine Sicht" auf die Lösungsmöglichkeit,
man kann es natürlich ganz anders anfangen.

Ich mache für jede Schrift erstmal eine
"Übersetzungstabelle" auf, so brauche
ich nicht alles in die Suchschleife
zu packen.

Ausserdem nehme ich gerne "indirekte Filehandles",
d.h. der Filedeskriptor wird in einer Variablen
vorgehalten.

use strict;
use warnings;

open(my $inh, '<', 'in.txt' ) or die "booom $!";
open(my $outh, '>', 'out.txt') or die "booom $!";

my @muster1 = qw' ';
my %tausch1 = qw' <0xF0A1> <0x1F71>
<0xF0A2> <0x1F70>
<0xF0A3> <0x1F00>
<0xF0A4> <0x1F01> ';

my @muster2 = qw' ';
my %tausch2 = qw' <0xF0A5> <0x1F41>
<0xF0A6> <0x1F40>
<0xF0A7> <0x1F40>
<0xF0A8> <0x1F41> ';

while( my $line=<$inh> ) {
if( $line =~ /$muster1[0] .+? $muster1[1]/x ) {
$line =~ s/$_/$tausch1{$_}/g for keys %tausch1;
}

if( $line =~ /$muster2[0] .+? $muster2[1]/x ) {
$line =~ s/$_/$tausch2{$_}/g for keys %tausch2;
}

print $outh $line;
}

close $_ for $outh, $inh;



Viele Grüße

M.

Re: Codierungen austauschen innerhalb Tags

Hallo Mirco,
vielen danke für deine schnelle Antwort und deinen Vorschlag. Ja, mit
der Tabelle ist das gleich viel übersichtlicher.
Da ich "Perl-beginner" bin, verstehe ich einiges nicht. Was heißt

qr{...} ??

und was ist

qw ?? Ein Hash-Segment, das noch vorher deklariert werden muß? Oder muss
man das bei "strict" nicht deklarieren? (Unter Win2000, Perl 5.xx)

Wenn du einem Perl-Anfänger ein bisschen auf die Sprünge helfen
könntest, wäre ich dir dankbar.

Klaus

Mirco Wahab schrieb:
> Thus spoke Klaus Boer (on 2006-10-14 23:07):
>> In einer Textdatei (in.txt) mit folgendem Inhalt:
>> <0xF074><0xF06F><0xF069><0xF06F>
>> <0xF0A5>
>>
>> sollen die Codes der Buchstaben jeweils bei Schrift 1 und Schrift 2 nach
>> zwei unterschiedlichen Suche/Ersetzen-Tabelle ausgetauscht werden.
>> Ungefähr so habe ich es versucht. Aber das funktioniert nicht, weil alle
>> Codes und nicht nur diejenigen zwischen den Tags von Schrift 1.
>
> Hallo Klaus,
>
>> my $Muster = '/()([A-Zx0-9<> ]*)()/';
>
> so würde das nicht gehen, Du meinst wahrscheinlich sowas wie
>
> my $Muster = qr{.+?};
>
>> while () {
>> if ($Muster) {
>> s/<0xF0A1>/<0x1F71>/g;
>> Wie kann ich es schaffen, dass nur die Codes zwischen den Tags einer
>> einzigen Schrift (z.B. Schrift1) getausche werden?
>
> Ich denke, das ist neben dem Regex-Problem auch ein
> Problem der Organisation. Und da ich gerade warte,
> dass mein *BSD seinen kleinen Gnome auf 2.16 hoch-
> tüddelt, habe ich mal ein rudimentäres Programm
> geschrieben, das dies tut.
>
> Das wäre dann "meine Sicht" auf die Lösungsmöglichkeit,
> man kann es natürlich ganz anders anfangen.
>
> Ich mache für jede Schrift erstmal eine
> "Übersetzungstabelle" auf, so brauche
> ich nicht alles in die Suchschleife
> zu packen.
>
> Ausserdem nehme ich gerne "indirekte Filehandles",
> d.h. der Filedeskriptor wird in einer Variablen
> vorgehalten.
>
> use strict;
> use warnings;
>
> open(my $inh, '<', 'in.txt' ) or die "booom $!";
> open(my $outh, '>', 'out.txt') or die "booom $!";
>
> my @muster1 = qw' ';
> my %tausch1 = qw' <0xF0A1> <0x1F71>
> <0xF0A2> <0x1F70>
> <0xF0A3> <0x1F00>
> <0xF0A4> <0x1F01> ';
>
> my @muster2 = qw' ';
> my %tausch2 = qw' <0xF0A5> <0x1F41>
> <0xF0A6> <0x1F40>
> <0xF0A7> <0x1F40>
> <0xF0A8> <0x1F41> ';
>
> while( my $line=<$inh> ) {
> if( $line =~ /$muster1[0] .+? $muster1[1]/x ) {
> $line =~ s/$_/$tausch1{$_}/g for keys %tausch1;
> }
>
> if( $line =~ /$muster2[0] .+? $muster2[1]/x ) {
> $line =~ s/$_/$tausch2{$_}/g for keys %tausch2;
> }
>
> print $outh $line;
> }
>
> close $_ for $outh, $inh;
>
>
>
> Viele Grüße
>
> M.

Re: Codierungen austauschen innerhalb Tags

On 2006-10-15 08:52, Klaus Boer wrote:
> vielen danke für deine schnelle Antwort und deinen Vorschlag. Ja, mit
> der Tabelle ist das gleich viel übersichtlicher.
> Da ich "Perl-beginner" bin, verstehe ich einiges nicht.

Dann erlaube ich mir, Dich auf "perldoc" hinzuweisen, die Dokumentation,
die bei Perl mitgeliefert wird, bzw. das Kommando, um Teile der selbigen
anzuzeigen.

»perldoc perlop« zeigt das Kapitel "perlop - Perl operators and
precedence" an (eines der Kapitel, die zur Pflichtlektüre zählen),
»perldoc -f qr« ("-f" wie "function") zeigt das entsprechtende
Unterkapitel aus perlfunc an, und
»perldoc -q quote« ("-q" wie "question") sucht alle Einträge mit "quote"
aus der FAQ heraus.

(Unter Windows gibts die Doku auch zum durchklicken, aber Du wirst in
dieser Gruppe immer Verweise auf die Doku in der Form »perldoc
irgendwas« finden, also solltest Du das Tool perldoc zumindest kennen
und gegebenenfalls wissen, wie Du die gleiche Info mit der Maus findest)


> Was heißt
>
> qr{...} ??
>
> und was ist
>
> qw ??

Wennn man's nicht weiß, kann man mal raten, dass es eingebaute
Perl-Funktionen sind:

perldoc -f qr
gibt aus:

qr/STRING/
qx/STRING/
qw/STRING/
Generalized quotes. See "Regexp Quote-Like Operators" in
perlop.

Ok, falsch geraten, es sind Operatoren, aber zumindest weiß man jetzt,
wo man nachlesen kann[0]. Also ruft man
perldoc perlop
auf und sucht dort nach "Regexp Quote-Like Operators":

qr/STRING/imosx
This operator quotes (and possibly compiles) its STRING as a
regular expression.
[...]
qw/STRING/
Evaluates to a list of the words extracted out of STRING, using
embedded whitespace as the word delimiters.
[...]

Da ist also beides beschrieben.

hp

[0] Wenn ich das richtig mitbekommen habe, wurden kürzlich in perlfunc
auch Syntax-Elemente aufgenommen. In der nächsten Version von Perl
sollte man mit "perldoc -f while" einen Verweis auf "Compound
statements" in perlsyn bekommen.

--
_ | Peter J. Holzer | > Wieso sollte man etwas erfinden was nicht
|_|_) | Sysadmin WSR | > ist?
| | | hjp@hjp.at | Was sonst wäre der Sinn des Erfindens?
__/ | http://www.hjp.at/ | -- P. Einstein u. V. Gringmuth in desd

Re: Codierungen austauschen innerhalb Tags

Thus spoke Klaus Boer (on 2006-10-15 10:52):
> Da ich "Perl-beginner" bin, verstehe ich einiges nicht.

Hallo Klaus,

ich erinnere mich noch wie das noch wie es bei mir war - vor
geraumer Zeit. Man kennt sich in <'anderer Programmiersprache'>
recht ordentlich aus (bei mir: C/C++) und erlebt dann mit Perl
eine Art "Kulturschock" ;-)

Peter hat ja im Parallelposting schon auf
die 'kanonische Art' des Herangehens hin-
gewiesen: 'perldoc'. Aber ich weiss selbst
noch gut, wie 'fremdartig' mir perldoc beim
Einstieg erschien.

Aus meiner Sicht würde ich Dir als "Lernhilfe"
das "gute Wort" von Ditchen empfehlen, kosten-
los und legal herunterzuladen bei M&T:
http://download.pearsoned.de/leseecke/pdf/3827269040%20Perl% 20in%2021%20Tagen.pdf

Weiterhin empfehle ich Dir, für den Anfang eine
"IDE" zu verwenden, wenn Du die shell-Kommandozeile
nicht gewöhnt bist, vorzugsweise unter Windows
die OpenPerlIDE: http://open-perl-ide.sourceforge.net/

> Was heißt qr{...} ??

Das ist einer der [q]uote-Operatoren (für [r]eguläre Ausdrücke,
erklärt in obigem "Ditchen" auf S. 736 (Anhang):

...
qr/string/ behandelt string als Mustererkennungs-Pattern
Beispiel: $re = qr/HTTP/i; # HTTP, Http, http ...
if($string =~ /${re}-Protokoll/ { ... }
...


> und was ist qw ?? Ein Hash-Segment, das noch
> vorher deklariert werden muß? Oder muss

Das ist eine andere Varietät des 'quote operators'
beschrieben in Ditchen auf S.158:


...
Listen von Zeichenketten, die keine Leer- oder
Sonderzeichen enthalten, können mithilfe
des qw()-Operators geschrieben werden (quoted words).
Er wirkt genauso wie Single-Quotes um jedes Wort.
Die Werte werden hier durch Leerzeichen getrennt.

# statt ( 'meier', 'mueller', 'schmidt' ):
qw( meier mueller schmidt )
...


Im Prinzip erzeugst Du hie also eine Liste, mit
dieser kann ein Array direkt "gefüllt" werden -
bei einem Hash wird dabei immer das n'te Element
als 'key' und das n+1'te Element als 'value'
verwendet.

Viele Grüße

Mirco

Re: Codierungen austauschen innerhalb Tags

Mirco Wahab schrieb:
> Thus spoke Klaus Boer (on 2006-10-15 10:52):
>> Da ich "Perl-beginner" bin, verstehe ich einiges nicht.
>
> Hallo Klaus,
>
> ich erinnere mich noch wie das noch wie es bei mir war - vor
> geraumer Zeit. Man kennt sich in <'anderer Programmiersprache'>
> recht ordentlich aus (bei mir: C/C++) und erlebt dann mit Perl
> eine Art "Kulturschock" ;-)
>
> Peter hat ja im Parallelposting schon auf
> die 'kanonische Art' des Herangehens hin-
> gewiesen: 'perldoc'. Aber ich weiss selbst
> noch gut, wie 'fremdartig' mir perldoc beim
> Einstieg erschien.
>
> Aus meiner Sicht würde ich Dir als "Lernhilfe"
> das "gute Wort" von Ditchen empfehlen, kosten-
> los und legal herunterzuladen bei M&T:
> http://download.pearsoned.de/leseecke/pdf/3827269040%20Perl% 20in%2021%20Tagen.pdf
>
> Weiterhin empfehle ich Dir, für den Anfang eine
> "IDE" zu verwenden, wenn Du die shell-Kommandozeile
> nicht gewöhnt bist, vorzugsweise unter Windows
Hallo Mirco und Peter,
das nenne ich eine umfassende Info. Ich danke euch beiden herzlich für
die verständlichen Ausführungen und Hinweise.

Schöne Grüsse
Klaus

> die OpenPerlIDE: http://open-perl-ide.sourceforge.net/
>
>> Was heißt qr{...} ??
>
> Das ist einer der [q]uote-Operatoren (für [r]eguläre Ausdrücke,
> erklärt in obigem "Ditchen" auf S. 736 (Anhang):
>
> ...
> qr/string/ behandelt string als Mustererkennungs-Pattern
> Beispiel: $re = qr/HTTP/i; # HTTP, Http, http ...
> if($string =~ /${re}-Protokoll/ { ... }
> ...
>
>
>> und was ist qw ?? Ein Hash-Segment, das noch
>> vorher deklariert werden muß? Oder muss
>
> Das ist eine andere Varietät des 'quote operators'
> beschrieben in Ditchen auf S.158:
>
>
> ...
> Listen von Zeichenketten, die keine Leer- oder
> Sonderzeichen enthalten, können mithilfe
> des qw()-Operators geschrieben werden (quoted words).
> Er wirkt genauso wie Single-Quotes um jedes Wort.
> Die Werte werden hier durch Leerzeichen getrennt.
>
> # statt ( 'meier', 'mueller', 'schmidt' ):
> qw( meier mueller schmidt )
> ...
>
>
> Im Prinzip erzeugst Du hie also eine Liste, mit
> dieser kann ein Array direkt "gefüllt" werden -
> bei einem Hash wird dabei immer das n'te Element
> als 'key' und das n+1'te Element als 'value'
> verwendet.
>
> Viele Grüße
>
> Mirco

Re: Codierungen austauschen innerhalb Tags

Peter J. Holzer schrieb:
> On 2006-10-15 08:52, Klaus Boer wrote:
>> vielen danke für deine schnelle Antwort und deinen Vorschlag. Ja, mit
>> der Tabelle ist das gleich viel übersichtlicher.
>> Da ich "Perl-beginner" bin, verstehe ich einiges nicht.
>
> Dann erlaube ich mir, Dich auf "perldoc" hinzuweisen, die Dokumentation,
> die bei Perl mitgeliefert wird, bzw. das Kommando, um Teile der selbigen
> anzuzeigen.
>
> »perldoc perlop« zeigt das Kapitel "perlop - Perl operators and
> precedence" an (eines der Kapitel, die zur Pflichtlektüre zählen),
> »perldoc -f qr« ("-f" wie "function") zeigt das entsprechtende
> Unterkapitel aus perlfunc an, und
> »perldoc -q quote« ("-q" wie "question") sucht alle Einträge mit "quote"
> aus der FAQ heraus.
>
> (Unter Windows gibts die Doku auch zum durchklicken, aber Du wirst in
> dieser Gruppe immer Verweise auf die Doku in der Form »perldoc
> irgendwas« finden, also solltest Du das Tool perldoc zumindest kennen
> und gegebenenfalls wissen, wie Du die gleiche Info mit der Maus findest)
>
>
>> Was heißt
Hallo Mirco und Peter,
das nenne ich eine umfassende Info. Ich danke euch beiden herzlich für
die verständlichen Ausführungen und Hinweise.

Schöne Grüsse
Klaus

>>
>> qr{...} ??
>>
>> und was ist
>>
>> qw ??
>
> Wennn man's nicht weiß, kann man mal raten, dass es eingebaute
> Perl-Funktionen sind:
>
> perldoc -f qr
> gibt aus:
>
> qr/STRING/
> qx/STRING/
> qw/STRING/
> Generalized quotes. See "Regexp Quote-Like Operators" in
> perlop.
>
> Ok, falsch geraten, es sind Operatoren, aber zumindest weiß man jetzt,
> wo man nachlesen kann[0]. Also ruft man
> perldoc perlop
> auf und sucht dort nach "Regexp Quote-Like Operators":
>
> qr/STRING/imosx
> This operator quotes (and possibly compiles) its STRING as a
> regular expression.
> [...]
> qw/STRING/
> Evaluates to a list of the words extracted out of STRING, using
> embedded whitespace as the word delimiters.
> [...]
>
> Da ist also beides beschrieben.
>
> hp
>
> [0] Wenn ich das richtig mitbekommen habe, wurden kürzlich in perlfunc
> auch Syntax-Elemente aufgenommen. In der nächsten Version von Perl
> sollte man mit "perldoc -f while" einen Verweis auf "Compound
> statements" in perlsyn bekommen.
>

Re: Codierungen austauschen innerhalb Tags

Hallo Mirco,
habe dein Script angewendet, doch leider werden dabei immer alle Wörter
gefunden, nicht nur jeweils zwischen den Tags von oder

Hier dein etwas geändertes Script, damit man sieht, wie die Fundstellen
im zweiten Durchgang überschrieben werden:

use strict;
use warnings;

open(my $outh, '>', 'out.txt') or die " booom $!\n";
open(my $inh, '<', 'in.txt' ) or die " booom $!\n";

my @muster1 = qw' ';
my %tausch1 = qw'Klaus Jürgen
zwei Kzwei
drei Kdrei
vier Kvier';

my @muster2 = qw' ';
my %tausch2 = qw'Maier Huber
zwei Mzwei
drei Mdrei';

while( my $line=<$inh> ) {
if( $line =~ /$muster1[0] .+? $muster1[1]/x ) {
$line =~ s/$_/$tausch1{$_}/g for keys %tausch1;
}
if( $line =~ /$muster2[0] .+? $muster2[1]/x ) {
$line =~ s/$_/$tausch2{$_}/g for keys %tausch2;
}
print $outh $line;
}

close $_ for $outh, $inh;

Und hier der Text der Datei in.txt zum Testen:

Klaus BoerKlaus
MaierKlaus Boer
zweiMaier zweiKlaus Boer
dreiKlaus Boer vierMaier
drei

Weißt du Rat, warum die Tags ignoriert werden. Es sollen ja nur die
Texte (auch wenn sie gleich sind) zwischen den Schrift-Tags geändert werden.

Danke für dein Hilfe im voraus.

Klaus

Re: Codierungen austauschen innerhalb Tags

Thus spoke Klaus Boer (on 2006-10-16 02:16):
> habe dein Script angewendet, doch leider werden dabei immer alle Wörter
> gefunden, nicht nur jeweils zwischen den Tags von oder

Hallo Klaus,

> Klaus BoerKlaus
> MaierKlaus Boer
> zweiMaier zweiKlaus Boer
> dreiKlaus Boer vierMaier
> drei
>
> Weißt du Rat, warum die Tags ignoriert werden. Es sollen ja nur die
> Texte (auch wenn sie gleich sind) zwischen den Schrift-Tags geändert werden.

Das ist klar ;-) Hier gibt es mehrere
Komplikationen:

- es gibt mehrere Sektionen vom selben Typ
- die Sektionen können sich über mehrere Zeilen hinziehen

Das ist eigentlich schon das Maximum an Komplikationen ;-)
(mehr geht praktisch nicht, ausser dass die Sektionen
noch verschachtelt sein dürfen)

Um das zu lösen, muss man -
- den Text komplett (nicht zeilenweise) vorhalten
- beachten, dass sich die Textlänge zwischen mehr-
fachen Ersetungen ändert


Um obiges hinzubekommen, müsste man die aufeinanderfolgenden
Ersetzungen von hinten her machen, wenn man nicht jedes mal
für jede Kombination den gesamten Text durchscannen möchte.

Ich mahe hier zwei Dinge, erstens suche ich nach
allen Positionen ($-[0] und $+[0]) an denen eine
Sektion vorkommt - und dann durchlaufe ich diese
Positionen rückwärts (push/pop @array) um den
Text dazwischen zu ändern.

Das mache ich für jede Schriftsektion. Die 0. Näherung
dafür wäre folgendes:

...
my @muster1 = qw' ';
my %tausch1 = qw' Klaus Jürgen
zwei Kzwei
drei Kdrei
vier Kvier';

my @muster2 = qw' ';
my %tausch2 = qw' Maier Huber
zwei Mzwei
drei Mdrei';

# Text komplett in einen string einlesen
my $text = do { local $/; <$inh> };
my @stack = ();

# Postionen fuer #1 suchen und abspeichern
push @stack, [$-[0], $+[0]] while $text=~/($muster1[0].+?$muster1[1])/gms;

# und rueckwaerts ersetzen
while( my $p = pop @stack ) {
substr($text, $$p[0], $$p[1]-$$p[0]) =~ s/$_/$tausch1{$_}/sm
for keys %tausch1;
}

# Postionen fuer #2 suchen und abspeichern
push @stack, [$-[0], $+[0]] while $text=~/($muster2[0].+?$muster2[1])/gms;

# und rueckwaerts ersetzen
while( my $p = pop @stack ) {
substr($text, $$p[0], $$p[1]-$$p[0]) =~ s/$_/$tausch2{$_}/sm
for keys %tausch2;
}

print $outh $text;


Vielleicht fällt ja noch jemandem eine
einfachere Lösung ein. Aber so müsste
es zumindest funktionieren.

Viele Grüße

Mirco

Re: Codierungen austauschen innerhalb Tags

Mirco Wahab schrieb:
> Thus spoke Klaus Boer (on 2006-10-16 02:16):
>> habe dein Script angewendet, doch leider werden dabei immer alle Wörter
>> gefunden, nicht nur jeweils zwischen den Tags von oder
>
> Hallo Klaus,
>
>> Klaus BoerKlaus
>> MaierKlaus Boer
>> zweiMaier zweiKlaus Boer
>> dreiKlaus Boer vierMaier
>> drei
>>
>> Weißt du Rat, warum die Tags ignoriert werden. Es sollen ja nur die
>> Texte (auch wenn sie gleich sind) zwischen den Schrift-Tags geändert werden.
>
> Das ist klar ;-) Hier gibt es mehrere
> Komplikationen:
>
> - es gibt mehrere Sektionen vom selben Typ
> - die Sektionen können sich über mehrere Zeilen hinziehen
>
> Das ist eigentlich schon das Maximum an Komplikationen ;-)
> (mehr geht praktisch nicht, ausser dass die Sektionen
> noch verschachtelt sein dürfen)
>
> Um das zu lösen, muss man -
> - den Text komplett (nicht zeilenweise) vorhalten
> - beachten, dass sich die Textlänge zwischen mehr-
> fachen Ersetungen ändert
>
>
> Um obiges hinzubekommen, müsste man die aufeinanderfolgenden
> Ersetzungen von hinten her machen, wenn man nicht jedes mal
> für jede Kombination den gesamten Text durchscannen möchte.
>
> Ich mahe hier zwei Dinge, erstens suche ich nach
> allen Positionen ($-[0] und $+[0]) an denen eine
> Sektion vorkommt - und dann durchlaufe ich diese
> Positionen rückwärts (push/pop @array) um den
> Text dazwischen zu ändern.
>
> Das mache ich für jede Schriftsektion. Die 0. Näherung
> dafür wäre folgendes:
>
> ...
> my @muster1 = qw' ';
> my %tausch1 = qw' Klaus Jürgen
> zwei Kzwei
> drei Kdrei
> vier Kvier';
>
> my @muster2 = qw' ';
> my %tausch2 = qw' Maier Huber
> zwei Mzwei
> drei Mdrei';
>
> # Text komplett in einen string einlesen
> my $text = do { local $/; <$inh> };
> my @stack = ();
>
> # Postionen fuer #1 suchen und abspeichern
> push @stack, [$-[0], $+[0]] while $text=~/($muster1[0].+?$muster1[1])/gms;
>
> # und rueckwaerts ersetzen
> while( my $p = pop @stack ) {
> substr($text, $$p[0], $$p[1]-$$p[0]) =~ s/$_/$tausch1{$_}/sm
> for keys %tausch1;
> }
>
> # Postionen fuer #2 suchen und abspeichern
> push @stack, [$-[0], $+[0]] while $text=~/($muster2[0].+?$muster2[1])/gms;
>
> # und rueckwaerts ersetzen
> while( my $p = pop @stack ) {
> substr($text, $$p[0], $$p[1]-$$p[0]) =~ s/$_/$tausch2{$_}/sm
> for keys %tausch2;
> }
>
> print $outh $text;
>
>
> Vielleicht fällt ja noch jemandem eine
> einfachere Lösung ein. Aber so müsste
> es zumindest funktionieren.
>
> Viele Grüße
>
> Mirco

Hallo Mirco,
danke für deine Mühe und die schnelle Lösung. Bei meinem Test-Beispiel
funktioniert dein Script tadellos (mit den wenigen Einträgen). Wenn ich
jedoch mit dem erweiterten Script die Schriftcodes austauschen lasse,
werden je länger der Text ist, desto mehr Zeichen aus #1 überhaupt nicht
ausgetauscht.
Ich sehe da überhaupt keinen systematischen Zusammenhang. Ich dachte,
was im Kleinen funktioniert, muss im Grossen genauso laufen????

Bin nun völlig ratlos
Dennoch herzlichen Dank
Klaus

Re: Codierungen austauschen innerhalb Tags

Thus spoke Klaus Boer (on 2006-10-16 16:47):

> ... Bei meinem Test-Beispiel funktioniert dein Script tadellos (mit den wenigen
> Einträgen). Wenn ich jedoch mit dem erweiterten Script die Schriftcodes
> austauschen lasse, werden je länger der Text ist, desto mehr Zeichen aus
> #1 überhaupt nicht ausgetauscht.
> Ich sehe da überhaupt keinen systematischen Zusammenhang. Ich dachte,
> was im Kleinen funktioniert, muss im Grossen genauso laufen????
>
> Bin nun völlig ratlos

An sich müsste das auch 'im Grossen' gehen, es sei denn,
im File ist irgend was unvorhergesehenes drin. Kannst
Du mal ein *nicht* funktionierendes Beispiel anhängen?

Die Code-Duplikation im letzten Beispiel gefällt mir
nicht, daher wird mal die ganze Rechnerei in eine
Funktion ausgelagert (tausche_muster), die für
alle Problemstellungen geht und vermeidet, dass
man bei copy/paste von Code Fehler macht.

Dann kann man noch die ganzen Ersetzungssachen
in ein Array packen, um darüber zu iterieren.
Der Code würde dann so aussehen:

...
open(my $outh, '>', 'out.txt') or die " booom $!\n";
open(my $inh, '<', 'in.txt' ) or die " booom $!\n";
my @ersetzen = ();

push @ersetzen, { Muster => [ qw' ' ],
Tabelle => { qw' Klaus Jürgen
zwei Kzwei
drei Kdrei
vier Kvier ' }
};

push @ersetzen, { Muster => [ qw' ' ],
Tabelle => { qw' Maier Huber
wei Mzwei
drei Mdrei ' }
};

# Text komplett in einen String einlesen und ersetzen
my $text = do { local $/; <$inh> };

for my $e (@ersetzen) {
$text = tausche_muster( $text, $e->{Muster}, $e->{Tabelle} );
}
# und wieder ausgeben
print $outh $text;
...

Du siehst, ich habe die Datenstruktur extra so gestaltet, um
in der Funktion 'sprechende' Argumente verwenden zu können:

$e->{Muster}, $e->{Tabelle} ...

So lange das o.k. it, braucht man sich dann in Zukunft nur
noch um die Funktion tausche_muster() Gedanken zu machen,
die müsste etwa so aussehen:


sub tausche_muster {
my ($text, $rmus, $rtau) = @_;
my @positionen;
# alle Postionen fuer Muster suchen und abspeichern
while( $text =~ /$rmus->[0](.+?)$rmus->[1]/gms ) {
push @positionen, [ $-[1], $+[1] - $-[1] ]
}
# und dann 'rueckwaerts' ersetzen
while( my $p = pop @positionen ) { # gemerkte Positionen holen
for my $k (keys %$rtau) { # darin ggf. Ersetzungen machen
substr($text, $p->[0], $p->[1]) =~ s/$k/$rtau->{$k}/ms
}
}
$text; # return
}


Was wir hier im Laufe der Postings gemacht haben -
ist quasi ein 'multiline parser' ;-)

Aber schick doch bitte mal ein Beispiel, welches
nicht funktioniert (jetzt fängt's an, mich zu
interessieren ... ;-)


Viele Grüße

M.

Re: Codierungen austauschen innerhalb Tags

Thus spoke Mirco Wahab (on 2006-10-17 23:02):

kleine Ergänzung und Fehlerkorrektur:

> Weiterhin muss man jetzt ausfpassen, dass sich ja zwischen
> zwei Ersetzungen in der selben Sequenz die Textlänge
> ändern kann, man muss also das Stringende je entsprechend
>
> $p_end += length( $ersetzung ) - length( $original )

Das muss man natürlich auch 5 x machen, wenn es
5 Ersetzungen des selben Elements gab (aargghh!).

Hier also nochmal die Ersetzungsfunktion unter
Berücksichtigung obiger "Erkenntnis" (ich hab
noch eine Kontrolle zur Ausgabe der vorgenommenen
Ersetzungen pro tag-Paar eingebaut)

sub tausche_muster {
my ($text, $rmus, $rtau) = @_;
my @positionen;

print "$rmus->[0] ";
while( $text =~ /$rmus->[0](.+?)$rmus->[1]/gms ) { # Postionen suchen
push @positionen, [ $-[1], $+[1] - $-[1] ] # und abspeichern
} # und dann 'rueckwaerts' ersetzen

while( my $p = pop @positionen ) { # gemerkte Positionen holen, darin
for my $k (keys %$rtau) { # ggf. mehrere! Ersetzungen machen
if( my $z = substr($text, $p->[0], $p->[1]) =~ s/$k/$rtau->{$k}/gms ) {
print "$z "; # Laenge ggf mehrmals! anpassen
$p->[1] += $z * (length( $rtau->{$k} ) - length( $k ))
}
}
}

print "\n";
return $text;
}



Viele Grüße

Mirco

Re: Codierungen austauschen innerhalb Tags

Mirco Wahab schrieb:
> Thus spoke Mirco Wahab (on 2006-10-17 23:02):
>
> kleine Ergänzung und Fehlerkorrektur:
>
>> Weiterhin muss man jetzt ausfpassen, dass sich ja zwischen
>> zwei Ersetzungen in der selben Sequenz die Textlänge
>> ändern kann, man muss also das Stringende je entsprechend
>>
>> $p_end += length( $ersetzung ) - length( $original )
>
> Das muss man natürlich auch 5 x machen, wenn es
> 5 Ersetzungen des selben Elements gab (aargghh!).
>
> Hier also nochmal die Ersetzungsfunktion unter
> Berücksichtigung obiger "Erkenntnis" (ich hab
> noch eine Kontrolle zur Ausgabe der vorgenommenen
> Ersetzungen pro tag-Paar eingebaut)
>
> sub tausche_muster {
> my ($text, $rmus, $rtau) = @_;
> my @positionen;
>
> print "$rmus->[0] ";
> while( $text =~ /$rmus->[0](.+?)$rmus->[1]/gms ) { # Postionen suchen
> push @positionen, [ $-[1], $+[1] - $-[1] ] # und abspeichern
> } # und dann 'rueckwaerts' ersetzen
>
> while( my $p = pop @positionen ) { # gemerkte Positionen holen, darin
> for my $k (keys %$rtau) { # ggf. mehrere! Ersetzungen machen
> if( my $z = substr($text, $p->[0], $p->[1]) =~ s/$k/$rtau->{$k}/gms ) {
> print "$z "; # Laenge ggf mehrmals! anpassen
> $p->[1] += $z * (length( $rtau->{$k} ) - length( $k ))
> }
> }
> }
>
> print "\n";
> return $text;
> }
>
>
>
> Viele Grüße
>
> Mirco

Hallo Mirco,
vielen Dank für dieses verbesserte Script. In der Tat, es tauscht jetzt
besser aus als das alte.
Allerdings bleibt das Phänomen, dass einige Zeichen, die in der Tabelle
stehen, überhaupt nicht getauscht werden und einige wenige falsch.

Zum Beispiel in IN.TXT die vorletzten drei lauten:

<0xF0C2><0xF061><0xF06E>

Müssten getauscht werden in:

<0x1F77><0x03B1><0x03BD>

In der OUT.TXT steht aber die unveränderte Folge:

<0xF0C2><0xF061><0xF06E>

Kannst du dir das erklären, wo doch sonst diese Codes korrekt getauscht
werden.
Da du von hinten austauschst, muss der Fehler doch gleich am Anfang
stattfinden - oder irre ich mich?

Schöne Grüsse
Klaus

Re: Codierungen austauschen innerhalb Tags

Mirco Wahab schrieb:
> Thus spoke Mirco Wahab (on 2006-10-17 23:02):
>
> kleine Ergänzung und Fehlerkorrektur:
>
>> Weiterhin muss man jetzt ausfpassen, dass sich ja zwischen
>> zwei Ersetzungen in der selben Sequenz die Textlänge
>> ändern kann, man muss also das Stringende je entsprechend
>>
>> $p_end += length( $ersetzung ) - length( $original )
>
> Das muss man natürlich auch 5 x machen, wenn es
> 5 Ersetzungen des selben Elements gab (aargghh!).
>
> Hier also nochmal die Ersetzungsfunktion unter
> Berücksichtigung obiger "Erkenntnis" (ich hab
> noch eine Kontrolle zur Ausgabe der vorgenommenen
> Ersetzungen pro tag-Paar eingebaut)
>
> sub tausche_muster {
> my ($text, $rmus, $rtau) = @_;
> my @positionen;
>
> print "$rmus->[0] ";
> while( $text =~ /$rmus->[0](.+?)$rmus->[1]/gms ) { # Postionen suchen
> push @positionen, [ $-[1], $+[1] - $-[1] ] # und abspeichern
> } # und dann 'rueckwaerts' ersetzen
>
> while( my $p = pop @positionen ) { # gemerkte Positionen holen, darin
> for my $k (keys %$rtau) { # ggf. mehrere! Ersetzungen machen
> if( my $z = substr($text, $p->[0], $p->[1]) =~ s/$k/$rtau->{$k}/gms ) {
> print "$z "; # Laenge ggf mehrmals! anpassen
> $p->[1] += $z * (length( $rtau->{$k} ) - length( $k ))
> }
> }
> }
>
> print "\n";
> return $text;
> }
>
>
>
> Viele Grüße
>
> Mirco

Hallo Mirco,
wunderbar, es funktioniert !!!!!
ich habe zu früh gemault. Hatte das Script in der ZIP genommen und deine
Verbesserung im zweiten posting übersehen.

O happy day....

Ich danke dir vielmals.
Nach der Freude, kommt das Studieren..., denn verstehen will ich dein
Script natürlich auch. Im Augenblick jedenfalls lese ich deine
Literaturempfehlung "Perl in 21 Tagen". Ich denke nicht, dass ich das in
21 Tagen schaffe... Ich weiß wohl durch deine Kommentare, was du gemacht
hast, aber die Perl-Codes sind mir noch ein Buch mit 7 Siegeln...
Werde wohl oder übel noch eine Menge "dummer" Fragen stelenn...

Schöne Grüße
Klaus