in reply to wiki regex reprocessing replacement
UPDATES:
Expanded test case with wrong markup to be ignored
- markup inside word
- wrong pairs like *fail_
> to call tf() recursively in the /e evaled replacement part
seems to work well, see sub rec
use strict; use warnings; use Data::Dump qw/pp dd/; use Test::More; my $wiki = '_/one *two*/ th/ree_ null _/f*ur *five*/ six_ null _/se_ven *eig +ht*/ nine_ *fail_'; my $expected = '<u><i>one <b>two</b></i> th/ree</u> null <u><i>f*ur <b>five</b></ +i> six</u> null <u><i>se_ven <b>eight</b></i> nine</u> *fail_'; my $pre = qr/(^|\s|>)/; my $post = qr/($|\s|<)/; my %h = ( '*' => 'b' , '/' => 'i' , '_' => 'u' , ); sub tf { s{ $pre ([_*/]) (.*?) \2 (?=$post)}{$1<$h{$2}>$3</$h{$2}>}xg +}; $_=$wiki; my $DBG = 0; diag "IN <= '$wiki'\n\n" if $DBG; for my $i (1..3) { tf(); diag "$i: '$_'\n\n" if $DBG; } is($_,$expected,"repeated replace"); my $rec_level=0; sub rec { my ($txt) = @_; my $DBG = 1; diag ++$rec_level ."< $txt" if $DBG; $txt =~ s{ $pre ([_*/]) (.*?) \2 (?=$post) }{ my $tag = $h{$2}; "$1<$tag>" . rec($3). "</$tag>" }xge; diag $rec_level-- . "> $txt\n" if $DBG; return $txt; } my $got_rec = rec($wiki); is($got_rec,$expected,"recursive replace"); done_testing;
ok 1 - repeated replace # 1< _/one *two*/ th/ree_ null _/f*ur *five*/ six_ null _/se_ven *eight*/ nine_ *fail_ # 2< /one *two*/ th/ree # 3< one *two* # 4< two # 4> two # 3> one two # 2> one two th/ree # 2< /f*ur *five*/ six # 3< f*ur *five* # 4< five # 4> five # 3> f*ur five # 2> f*ur five six # 2< /se_ven *eight*/ nine # 3< se_ven *eight* # 4< eight # 4> eight # 3> se_ven eight # 2> se_ven eight nine # 1> one two th/ree null f*ur five six null se_ven eight nine *fail_ ok 2 - recursive replace 1..2
Cheers Rolf
(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery
|
---|
In Section
Seekers of Perl Wisdom