| Text-RewriteRules documentation | Contained in the Text-RewriteRules distribution. |
Text::RewriteRules - A system to rewrite text using regexp-based rules
use Text::RewriteRules;
RULES email
\.==> DOT
@==> AT
ENDRULES
print email("ambs@cpan.org") # prints ambs AT cpan DOT org
RULES/m inc
(\d+)=e=> $1+1
ENDRULES
print inc("I saw 11 cats and 23 dogs") # prints I saw 12 cats and 24 dogs
This module uses a simplified syntax for regexp-based rules for rewriting text. You define a set of rules, and the system applies them until no more rule can be applied.
Two variants are provided:
traditional rewrite (RULES function):
while it is possible do substitute | apply first substitution rule
cursor based rewrite (RULES/m function):
add a cursor to the begining of the string while not reach end of string | apply substitute just after cursor and advance cursor | or advance cursor if no rule can be applied
A lot of computer science problems can be solved using rewriting rules.
Rewriting rules consist of mainly two parts: a regexp (LHS: Left Hand Side) that is matched with the text, and the string to use to substitute the content matched with the regexp (RHS: Right Hand Side).
Now, why don't use a simple substitute? Because we want to define a set of rules and match them again and again, until no more regexp of the LHS matches.
A point of discussion is the syntax to define this system. A brief discussion shown that some users would prefer a function to receive an hash with the rules, some other, prefer some syntax sugar.
The approach used is the last: we use Filter::Simple such that we
can add a specific non-perl syntax inside the Perl script. This
improves legibility of big rewriting rules sytems.
This documentation is divided in two parts: first we will see the reference of the module. Kind of, what it does, with a brief explanation. Follows a tutorial which will be growing through time and releases.
Note: most of the examples are very stupid, but that is the easiest way to explain the basic syntax.
The basic syntax for the rewrite rules is a block, started by the
keyword RULES and ended by the ENDRULES. Everything between
them is handled by the module and interpreted as rules or comments.
The RULES keyword can handle a set of flags (we will see that
later), and requires a name for the rule-set. This name will be used
to define a function for that rewriting system.
RULES functioname
...
ENDRULES
The function is defined in the main namespace where the RULES
block appears.
In this block, each line can be a comment (Perl style), an empty line or a rule.
A basic rule is a simple substitution:
RULES foobar foo==>bar ENDRULES
The arrow ==> is used as delimiter. At its left is the regexp
to match, at the right side, the substitution. So, the previous block
defines a foobar function that substitutes all foo by
bar.
Although this can seems similar to a global substitution, it is not. With a global substitution you can't do an endless loop. With this module it is very simple. I know you will get the idea.
You can use the syntax of Perl both on the left and right hand side of
the rule, including $1....
If the Perl substitution supports execution, why not to support it, also? So, you got the idea. Here is an example:
RULES foo (\d+)b=e=>'b' x $1 (\d+)a=eval=>'a' x ($1*2) ENDRULES
So, for any number followed by a b, we replace by that number of
b's. For each number followed by an a, we replace them by twice
that number of a's.
Also, you mean evaluation using an e or eval inside the arrow. I
should remind you can mix all these rules together in the same
rewriting system.
On some cases we want to perform a susbtitution if the pattern matches and a set of conditions about that pattern (or not) are true.
For that, we use a three part rule. We have the common rule plus the
condition part, separated from the rule by !!. These conditional
rules can be applied both for basic and exeuction rules.
RULES translate
([[:alpha:]]+)=e=>$dic{$1}!! exists($dic{$1})
ENDRULES
The previous example would translate all words that exist on the dictionary.
Sometimes it is useful to change something on the string before
starting to apply the rules. For that, there is a special rule named
begin (or b for abbreviate) just with a RHS. This RHS is Perl
code. Any Perl code. If you want to modify the string, use $_.
RULES foo =b=> $_.=" END" ENDRULES
As you use last on Perl to skip the remaining code on a loop, you
can also call a last (or l) rule when a specific pattern
matches.
Like the begin rule with only a RHS, the last rule has only a
LHS:
RULES foo foobar=l=> ENDRULES
This way, the rules iterate until the string matches with foobar.
You can also supply a condition in a last rule:
RULES bar f(o+)b(a+)r=l=> !! length($1) == 2 * length($2);
It is possible to use the regular expressions /x mode in the rewrite rules. In this case:
there must be an empty line between rules
you can insert space and line breaks into the regular expression:
RULES/x f1
(\d+)
(\d{3})
(000)
==>$1 milhao e $2 mil!! $1 == 1
ENDRULES
To facilitate matching complex languages Text::RewriteRules defines a set of regular expressions that you can use (without defining them).
There are three kind of usual parenthesis: the standard parenthesis,
brackets or curly braces. You can match a balanced string of
parenthesis using the power expressions [[:PB:]], [[:BB:]] and
[[:CBB:]] for these three kind of parenthesis.
For instance, if you apply this rule:
[[:BB:]]==>foo
to this string
something [ a [ b] c [d ]] and somehting more
then, you will get
something foo and something more
Note that if you apply it to
something [[ not ] balanced [ here
then you will get
something [foo balanced [ here
At the moment, just a set of commented examples.
Example1 -- from number to portuguese words (usint tradicional rewriting)
Example2 -- Naif translator (using cursor-based rewriting)
Yes, you can use Lingua::PT::Nums2Words and similar (for other languages). Meanwhile, before it existed we needed to write such a conversion tool.
Here I present a subset of the rules (for numbers bellow 1000). The generated text is Portuguese but I think you can get the idea. I'll try to create a version for English very soon.
You can check the full code on the samples directory (file
num2words).
use Text::RewriteRules;
RULES num2words
100==>cem
1(\d\d)==>cento e $1
0(\d\d)==>$1
200==>duzentos
300==>trezentos
400==>quatrocentos
500==>quinhentos
600==>seiscentos
700==>setecentos
800==>oitocentos
900==>novecentos
(\d)(\d\d)==>${1}00 e $2
10==>dez
11==>onze
12==>doze
13==>treze
14==>catorze
15==>quinze
16==>dezasseis
17==>dezassete
18==>dezoito
19==>dezanove
20==>vinte
30==>trinta
40==>quarenta
50==>cinquenta
60==>sessenta
70==>setenta
80==>oitenta
90==>noventa
0(\d)==>$1
(\d)(\d)==>${1}0 e $2
1==>um
2==>dois
3==>três
4==>quatro
5==>cinco
6==>seis
7==>sete
8==>oito
9==>nove
0$==>zero
0==>
==>
,==>,
ENDRULES
num2words(123); # returns "cento e vinte e três"
use Text::RewriteRules;
%dict=(driver=>"motorista",
the=>"o",
of=>"de",
car=>"carro");
$word='\b\w+\b';
if( b(a("I see the Driver of the car")) eq "(I) (see) o Motorista do carro" )
{print "ok\n"}
else {print "ko\n"}
RULES/m a
($word)==>$dict{$1}!! defined($dict{$1})
($word)=e=> ucfirst($dict{lc($1)}) !! defined($dict{lc($1)})
($word)==>($1)
ENDRULES
RULES/m b
\bde o\b==>do
ENDRULES
Alberto Simões, <ambs@cpan.org>
José João Almeida, <jjoao@cpan.org>
We know documentation is missing and you all want to use this module. In fact we are using it a lot, what explains why we don't have the time to write documentation.
Please report any bugs or feature requests to
bug-text-rewrite@rt.cpan.org, or through the web interface at
http://rt.cpan.org. I will be notified, and then you'll automatically
be notified of progress on your bug as I make changes.
Damian Conway for Filter::Simple
Copyright 2004-2009 Alberto Simões and José João Almeida, All Rights Reserved.
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
| Text-RewriteRules documentation | Contained in the Text-RewriteRules distribution. |
package Text::RewriteRules; use Data::Dumper; use Filter::Simple; use warnings; use strict; use 5.010000; # 5.10.0
our $VERSION = '0.23';
our $DEBUG = 0; our $count = 0; our $NL = qr/\r?\n\r?/; my %pseudo_classes=( TEXENV => 'TEXENV', PB => 'PB', BB => 'BB', CBB => 'CBB', XML => 'XMLtree', 'XML+1' => \&_tag_re, ); sub _regular_expressions { return <<'EORE'; our $__XMLattrs = qr/(?: \s+[a-zA-Z0-9:-]+\s* = \s*(?: '[^']+' | "[^"]+" ))*/x; ### This (?<PCDATA>\n) is a BIG hack! our $__XMLempty = qr/<(?<TAGNAME>[a-zA-Z0-9:-]+)(?<PCDATA>\b)$__XMLattrs\/>/x; our $__XMLtree2 = qr/$__XMLempty | (?<XML> <(?<TAG>[a-zA-Z0-9:-]+)$__XMLattrs> (?: $__XMLempty | [^<]++ | (?&XML) )*+ <\/\k<TAG>> )/x; our $__XMLtree = qr/$__XMLempty | (?<XML> <(?<TAGNAME>[a-zA-Z0-9:-]+)$__XMLattrs> (?<PCDATA>(?: $__XMLempty | [^<]++ | $__XMLtree2 )*+) <\/\k<TAGNAME>> )/x; our $__XMLinner = qr/(?: [^<]++ | $__XMLempty | $__XMLtree2 )*+/x; our $__CBB = qr{ (?<cbb1> \{ (?<CBB>(?:[^\{\}]++|(?&cbb1))*+) \} ) }sx; our $__BB = qr{ (?<bb1> \[ (?<BB> (?:[^\[\]]++|(?&bb1) )*+) \] ) }sx; our $__PB = qr{ (?<pb1> \( (?<PB> (?:[^\(\)]++|(?&pb1) )*+) \) ) }sx; our $__TEXENV = qr{\\begin\{(\w+)\}(.*?)\\end\{\1\}}s; ## \begin{$1}$2\end our $__TEXENV1 = qr{\\begin\{(\w+)\}($__BB?)($__CBB)(.*?)\\end\{\1\}}s; ## \begin{$1}[$2]{$3}$4\end EORE } sub _tag_re { my $tagname = shift; return "<$tagname\$__XMLattrs(?:\/>|>\$__XMLinner<\/$tagname>)"; } sub _expand_pseudo_classes { my $rules = shift; $rules =~ s/\[\[:(\w+):\]\]/\$__$pseudo_classes{$1}/g; $rules =~ s/\[\[:(\w+)\(([^,\(\)]+)\):\]\]/$pseudo_classes{"$1+1"}->($2)/ge; return $rules; } sub _mrules { my ($conf, $name, $rules) = @_; ++$count; my $code = "sub $name {\n"; $code .= " my \$p = shift;\n"; $code .= " my \$_M = \"\\x01\";\n"; $code .= " for (\$p) {\n"; $code .= " my \$modified = 1;\n"; $code .= " \$_ = \$_M.\$_;\n"; $code .= " #__$count#\n"; $code .= " my \$iteration = 0;\n"; $code .= " MAIN: while (\$modified) {\n"; $code .= " \$iteration++;\n"; if ($DEBUG) { $code .= " print STDERR \" >\$_\\n\";\n" } $code .= " \$modified = 0;\n"; my $ICASE = exists($conf->{i})?"i":""; my $DX = exists($conf->{x})?"x":""; if (exists($conf->{d})) { $code .= " print STDERR \"Iteration on $name: \$iteration\n\$p\n\";"; } my @rules; if ($DX eq "x") { @rules = split /$NL$NL/, $rules; } else { @rules = split /$NL/, $rules; } for my $rule (@rules) { $rule =~ s/$NL$//; if ($rule =~ m/(.*?)(=i?=>)(.*)!!(.*)/) { my ($ant,$con,$cond) = ($1,$3,$4); $ICASE = "i" if $2 =~ m!i!; $ant = _expand_pseudo_classes($ant); $code .= " while (m{\${_M}(?:$ant)}g$ICASE) {\n"; $code .= " if ($cond) {\n"; $code .= " s{\${_M}(?:$ant)}{$con\${_M}}$ICASE;\n"; $code .= " pos = undef;\n"; $code .= " \$modified = 1;\n"; $code .= " next MAIN\n"; $code .= " }\n"; $code .= " }\n"; } elsif ($rule =~ m/(.*?)(=(?:i=)?e(?:val)?=>)(.*)!!(.*)/) { my ($ant,$con,$cond) = ($1,$3,$4); $ICASE = "i" if $2 =~ m!i!; $ant = _expand_pseudo_classes($ant); $code .= " while (m{\${_M}(?:$ant)}g$ICASE) {\n"; $code .= " if ($cond) {\n"; $code .= " s{\${_M}(?:$ant)}{eval{$con}.\${_M}}e$ICASE;\n"; $code .= " pos = undef;\n"; $code .= " \$modified = 1;\n"; $code .= " next MAIN\n"; $code .= " }\n"; $code .= " }\n"; } elsif ($rule =~ m/(.*?)(=i?=>)(.*)/) { my ($ant,$con) = ($1,$3); $ICASE = "i" if $2 =~ m!i!; $ant = _expand_pseudo_classes($ant); $code .= " if (m{\${_M}(?:$ant)}$ICASE) {\n"; $code .= " s{\${_M}(?:$ant)}{$con\${_M}}$ICASE;\n"; $code .= " \$modified = 1;\n"; $code .= " next\n"; $code .= " }\n"; } elsif($rule =~ m/=b(?:egin)?=>(.*)/s) { my $ac = $1; $code =~ s/(#__$count#\n)/$ac;\n$1/; } elsif ($rule =~ m/(.*?)(=(?:i=)?e(?:val)?=>)(.*)/) { my ($ant,$con) = ($1,$3); $ICASE = "i" if $2 =~ m!i!; $ant = _expand_pseudo_classes($ant); $code .= " if (m{\${_M}(?:$ant)}$ICASE) {\n"; $code .= " s{\${_M}(?:$ant)}{eval{$con}.\"\$_M\"}e$ICASE;\n"; $code .= " \$modified = 1;\n"; $code .= " next\n"; $code .= " }\n"; } elsif($rule =~ m/(.*?)(=(?:i=)?l(?:ast)?=>\s*!!(.*))/s) { my ($ant,$cond) = ($1,$3); $ICASE = "i" if $2 =~ m!i!; $ant = _expand_pseudo_classes($ant); $code .= " if (m{\${_M}(?:$ant)}$ICASE$DX) {\n"; $code .= " if ($cond) {\n"; $code .= " s{\${_M}}{};\n"; $code .= " last\n"; $code .= " }\n"; $code .= " }\n"; } elsif($rule =~ m/(.*?)(=(?:i=)?l(?:ast)?=>)/s) { my ($ant) = ($1); $ICASE = "i" if $2 =~ m!i!; $ant = _expand_pseudo_classes($ant); $code .= " if (m{\${_M}(?:$ant)}$ICASE$DX) {\n"; $code .= " s{\${_M}}{};\n"; $code .= " last\n"; $code .= " }\n"; } else { warn "Unknown rule: $rule\n" unless $rule =~ m!^\s*(#|$)!; } } ##--- # Make it walk... $code .= " if (m{\${_M}(.|\\n)}) {\n"; $code .= " s{\${_M}(.|\\n)}{\$1\${_M}};\n"; $code .= " \$modified = 1;\n"; $code .= " next\n"; $code .= " }\n"; $code .= " }\n"; $code .= " s/\$_M//;\n"; $code .= " }\n"; $code .= " return \$p;\n"; $code .= "}\n"; $code; } sub _rules { my ($conf, $name, $rules) = @_; ++$count; my $code = "sub $name {\n"; $code .= " my \$p = shift;\n"; $code .= " for (\$p) {\n"; $code .= " my \$modified = 1;\n"; $code .= " #__$count#\n"; $code .= " my \$iteration = 0;\n"; $code .= " MAIN: while(\$modified) {\n"; $code .= " print STDERR \$_;\n" if $DEBUG > 1; $code .= " \$modified = 0;\n"; $code .= " \$iteration++;\n"; ##--- my $DICASE = exists($conf->{i})?"i":""; my $DX = exists($conf->{x})?"x":""; if (exists($conf->{d})) { $code .= " print STDERR \"Iteration on $name: \$iteration\n\$p\n\";"; } my @rules; if ($DX eq "x") { @rules = split /$NL$NL/, $rules; } else { @rules = split /$NL/, $rules; } for my $rule (@rules) { $rule =~ s/$NL$//; my $ICASE = $DICASE; if($rule =~ m/(.*?)(=i?=>)(.*)!!(.*)/s) { my ($ant,$con,$cond) = ($1,$3,$4); $ICASE = "i" if $2 =~ m!i!; $ant = _expand_pseudo_classes($ant); $code .= " while (m{$ant}g$ICASE$DX) {\n"; $code .= " if ($cond) {\n"; $code .= " s{$ant}{$con}$ICASE$DX;\n"; $code .= " pos = undef;\n"; $code .= " \$modified = 1;\n"; $code .= " next MAIN\n"; $code .= " }\n"; $code .= " }\n"; } elsif($rule =~ m/(.*?)(=(?:i=)?e(?:val)?=>)(.*)!!(.*)/s) { my ($ant,$con,$cond) = ($1,$3,$4); $ICASE = "i" if $2 =~ m!i!; $ant = _expand_pseudo_classes($ant); $code .= " while (m{$ant}g$ICASE$DX) {\n"; $code .= " if ($cond) {\n"; $code .= " s{$ant}{$con}e${ICASE}${DX};\n"; $code .= " pos = undef;\n"; $code .= " \$modified = 1;\n"; $code .= " next MAIN\n"; $code .= " }\n"; $code .= " }\n"; } elsif ($rule =~ m/(.*?)(=i?=>)(.*)/s) { my ($ant,$con) = ($1,$3); $ICASE = "i" if $2 =~ m!i!; $ant = _expand_pseudo_classes($ant); $code .= " if (m{$ant}$ICASE$DX) {\n"; $code .= " s{$ant}{$con}$ICASE$DX;\n"; $code .= " \$modified = 1;\n"; $code .= " next\n"; $code .= " }\n"; } elsif ($rule =~ m/(.*?)(=(?:i=)?e(?:val)?=>)(.*)/s) { my ($ant,$con) = ($1,$3); $ICASE = "i" if $2 =~ m!i!; $ant = _expand_pseudo_classes($ant); $code .= " if (m{$ant}$ICASE$DX) {\n"; $code .= " s{$ant}{$con}e$ICASE$DX;\n"; $code .= " \$modified = 1;\n"; $code .= " next\n"; $code .= " }\n"; } elsif($rule =~ m/=b(?:egin)?=>(.*)/s) { my $ac = $1; $code =~ s/(#__$count#\n)/$ac;\n$1/; } elsif($rule =~ m/(.*?)(=(i=)?l(ast)?=>\s*!!(.*))/s) { my ($ant,$cond) = ($1,$5); $ICASE = "i" if $2 =~ m!i!; $ant = _expand_pseudo_classes($ant); $code .= " if (m{$ant}$ICASE$DX) {\n"; $code .= " if ($cond) {\n"; $code .= " last\n"; $code .= " }\n"; $code .= " }\n"; } elsif($rule =~ m/(.*?)(=(i=)?l(ast)?=>)/s) { my ($ant) = ($1); $ICASE = "i" if $2 =~ m!i!; $ant = _expand_pseudo_classes($ant); $code .= " if (m{$ant}$ICASE$DX) {\n"; $code .= " last\n"; $code .= " }\n"; } else { warn "Unknown rule: $rule\n" unless $rule =~ m!^\s*(#|$)!; } } ##--- $code .= " }\n"; $code .= " }\n"; $code .= " return \$p;\n"; $code .= "}\n"; $code; } sub _lrules { my ($conf, $name, $rules) = @_; ++$count; my $code = "my \$${name}_input = \"\";\n"; $code .= "sub ${name}_init {\n"; $code .= " \$${name}_input = shift;\n"; $code .= " return 1;\n"; $code .= "}\n\n"; $code .= "sub $name {\n"; $code .= " return undef if not defined \$${name}_input;\n"; $code .= " print STDERR \$_;\n" if $DEBUG > 1; $code .= " for (\$${name}_input) {\n"; ##--- my $DICASE = exists($conf->{i})?"i":""; my $DX = exists($conf->{x})?"x":""; my @rules; if ($DX eq "x") { @rules = split /$NL$NL/, $rules; } else { @rules = split /$NL/, $rules; } for my $rule (@rules) { $rule =~ s/$NL$//; my $ICASE = $DICASE; if ($rule =~ m/=EOF=>(.*)/s) { my $act = $1; $code .= " if (m{^\$}) {\n"; $code .= " \$${name}_input = undef;\n"; $code .= " return \"$act\";\n"; $code .= " }\n"; } elsif ($rule =~ m/=EOF=e=>(.*)/s) { my $act = $1; $code .= " if (m{^\$}) {\n"; $code .= " \$${name}_input = undef;\n"; $code .= " return $act;\n"; $code .= " }\n"; } elsif ($rule =~ m/(.*?)(=(?:i=)?ignore=>)(.*)!!(.*)/s) { my ($ant,$cond) = ($1, $4); $ICASE = "i" if $2 =~ m!i!; $ant = _expand_pseudo_classes($ant); $code .= " if (m{^$ant}g$ICASE$DX) {\n"; $code .= " if ($cond) {\n"; $code .= " s{$ant}{}$ICASE$DX;\n"; $code .= " pos = undef;\n"; $code .= " return $name();\n"; $code .= " }\n"; $code .= " }\n"; } elsif ($rule =~ m/(.*?)(=(?:i=)?ignore=>)(.*)/s) { my ($ant) = ($1); $ICASE = "i" if $2 =~ m!i!; $ant = _expand_pseudo_classes($ant); $code .= " if (m{^$ant}g$ICASE$DX) {\n"; $code .= " s{$ant}{}$ICASE$DX;\n"; $code .= " pos = undef;\n"; $code .= " return $name();\n"; $code .= " }\n"; } elsif($rule =~ m/(.*?)(=i?=>)(.*)!!(.*)/s) { my ($ant,$con,$cond) = ($1,$3,$4); $ICASE = "i" if $2 =~ m!i!; $ant = _expand_pseudo_classes($ant); $code .= " if (m{^$ant}g$ICASE$DX) {\n"; $code .= " if ($cond) {\n"; $code .= " s{$ant}{}$ICASE$DX;\n"; $code .= " pos = undef;\n"; $code .= " return \"$con\"\n"; $code .= " }\n"; $code .= " }\n"; } elsif($rule =~ m/(.*?)(=(?:i=)?e(?:val)?=>)(.*)!!(.*)/s) { my ($ant,$con,$cond) = ($1,$3,$4); $ICASE = "i" if $2 =~ m!i!; $ant = _expand_pseudo_classes($ant); $code .= " if (m{^$ant}g$ICASE$DX) {\n"; $code .= " if ($cond) {\n"; $code .= " s{$ant}{}${ICASE}${DX};\n"; $code .= " pos = undef;\n"; $code .= " return $con;\n"; $code .= " }\n"; $code .= " }\n"; } elsif($rule =~ m/(.*?)(=i?=>)(.*)/s) { my ($ant,$con) = ($1,$3); $ICASE = "i" if $2 =~ m!i!; $ant = _expand_pseudo_classes($ant); $code .= " if (m{^$ant}g$ICASE$DX) {\n"; $code .= " s{$ant}{}$ICASE$DX;\n"; $code .= " pos = undef;\n"; $code .= " return \"$con\"\n"; $code .= " }\n"; } elsif($rule =~ m/(.*?)(=(?:i=)?e(?:val)?=>)(.*)/s) { my ($ant,$con) = ($1,$3); $ICASE = "i" if $2 =~ m!i!; $ant = _expand_pseudo_classes($ant); $code .= " if (m{^$ant}g$ICASE$DX) {\n"; $code .= " s{$ant}{}${ICASE}${DX};\n"; $code .= " pos = undef;\n"; $code .= " return $con;\n"; $code .= " }\n"; } else { warn "Unknown rule in lexer mode: $rule\n" unless $rule =~ m!^\s*(#|$)!; } } ##--- $code .= " }\n"; $code .= " return undef;\n"; $code .= "}\n"; $code; } FILTER { return if m!^(\s|\n)*$!; s!^!_regular_expressions()!e; print STDERR "BEFORE>>>>\n$_\n<<<<\n" if $DEBUG; s!^MRULES +(\w+)\s*?\n((?:.|\n)*?)^ENDRULES!_mrules({}, $1,$2)!gem; s!^LRULES +(\w+)\s*?\n((?:.|\n)*?)^ENDRULES!_lrules({}, $1,$2)!gem; s{^RULES((?:\/\w+)?) +(\w+)\s*?\n((?:.|\n)*?)^ENDRULES}{ my ($a,$b,$c) = ($1,$2,$3); my $conf = {map {($_=>$_)} split //,$a}; if (exists($conf->{'l'})) { _lrules($conf, $b, $c) } elsif (exists($conf->{'m'})) { _mrules($conf,$b,$c) } else { _rules($conf,$b,$c) } }gem; print STDERR "AFTER>>>>\n$_\n<<<<\n" if $DEBUG; $_ }; sub _compiler{ local $/ = undef; $_ = <>; print __compiler($_); } sub __compiler { my $str = shift; for ($str) { s!use Text::RewriteRules;!_regular_expressions()!e; s!^MRULES +(\w+)\s*\n((?:.|\n)*?)^ENDRULES!_mrules({}, $1,$2)!gem; s!^MRULES +(\w+)\s*\n((?:.|\n)*?)^ENDRULES!_lrules({}, $1,$2)!gem; s{^RULES((?:\/\w+)?) +(\w+)\s*\n((?:.|\n)*?)^ENDRULES}{ my ($a,$b,$c) = ($1,$2,$3); my $conf = {map {($_=>$_)} split //,$a}; if (exists($conf->{'l'})) { _lrules($conf,$b,$c) } elsif (exists($conf->{'m'})) { _mrules($conf,$b,$c) } else { _rules($conf,$b,$c) } }gem; } return $str; }
1; # End of Text::RewriteRules