$wort =~ s/(?<=[aeiou])t(?=[aeiou])/d/
$wort =~ s/([aeiou])t\1/$1d$1/;
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45
use warnings; use strict; $| = 1; my @categories = ( 'V=aeiou', 'P=pbtdkg' ); while (1) { print "Text: "; my $text = <STDIN>; chomp($text); last if ! $text; # Leere Eingabe beendet Schleife print "Regel: "; my $rule = <STDIN>; chomp($rule); last if ! $rule; my ($search, $replace) = build_regex($rule); $text =~ s/$search/$replace/g; print "\nMuster: $search\n\nNach Ersetzung: $text\n\n"; } sub build_regex { # build_regex($rule); my ($to_replace, $replace_with, $pattern) = split('/', $_[0]); for my $category (@categories) { my ($type, $class) = split('=', $category); $pattern =~ s/$type/[$class]/g; } $pattern =~ s/(.+)_/(?<=$1)_/; $pattern =~ s/_(.+)/_(?=$1)/; $pattern =~ s/_/$to_replace/; # <--- edit return ($pattern, $replace_with); } __END__
1
2
3
4
5
6
Text: akrta
Regel: k/g/V_rP
Muster: (?<=[aeiou])k(?=r[pbtdkg])
Nach Ersetzung: agrta
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83
use warnings; use strict; $| = 1; my @categories = ( 'V=aeiou', 'P=pbtdkg', 'N=12345' ); my %categ_hash = map { split /=/ } @categories; # ('V' => 'aeiou', ...) my $categ_types = join('', keys %categ_hash); # 'VPN' my $categ_types_rx = qr{ \A [$categ_types] \z }x; # \A[VPN]\z while (1) { print "Text: "; my $text = <STDIN>; chomp($text); last if ! $text; print "Regel: "; my $rule = <STDIN>; chomp($rule); last if ! $rule; my $rule_err = rule_check($rule); if ($rule_err) { print "Regel fehlerhaft: $rule_err\n"; next; } my $processed_text = process_text($text, $rule); print "\nNach Ersetzung: $processed_text\n\n"; } sub rule_check { my $rule = shift; # Hier Regelsyntax prüfen! return 0; # fehlerfrei } sub process_text { # build_regex($rule); my ($text, $rule) = @_; my ($to_replace, $replace_with, $pattern) = split('/', $rule); my $processed = $text; # Sonderfall translate (z.B. Regel V/N/_), das $pattern wird ignoriert if ($to_replace =~ $categ_types_rx and $replace_with =~ $categ_types_rx) { $to_replace = $categ_hash{$to_replace}; $replace_with = $categ_hash{$replace_with}; print ("tr/$to_replace/$replace_with/\n"); if (length($to_replace) != length($replace_with)){ warn "Ungleiche Zeichenzahl in Kategorien.\n"; } else { local $_ = $processed; eval "tr/$to_replace/$replace_with/"; $processed = $_; } return $processed; } for my $category (@categories) { my ($type, $class) = split('=', $category); $pattern =~ s/$type/[$class]/g; $to_replace =~ s/$type/[$class]/g; } $pattern =~ s/(.+)_/(?<=$1)_/; $pattern =~ s/_(.+)/_(?=$1)/; $pattern =~ s/_/$to_replace/; $processed =~ s/$pattern/$replace_with/g; return $processed; } __END__
1
2
3
4
5
6
7
8
9
10
Text: mater
Regel: V/N/_
tr/aeiou/12345/
Nach Ersetzung: m1t2r
Text: amna
Regel: [sm]//_[mn]
Nach Ersetzung: ana
Guest GastBeschäftige mich gerade seit ein paar Wochen mit Perl.
Guest GastNur jetzt bin ich wieder auf ein Problem gestoßen -.-
Wenn ich z.B. die drei Kategorien
1) V=aeiou
2) S=ptc
3) Z=bdg
habe, mit der Bedingung
- S/Z/V_V (Element aus S wird zu Element Z zwischen zwei Vokalen, egal ob
dieselben oder unterschiedliche).
und dem Wort
- lector,
...