in reply to Reaped: can't think of a title

#!/usr/bin/perl; use Modern::Perl; # <<a>b</a>>c</<a>b</a>> # <<a>b</>>c</> #say aXML(qq@[a('b')]('c')@); say aXMLeval(qq@<<a>b</a>>c</<a>b</a>>@); sub a { return 'd' if $_[0] eq "b"; } sub d { return '42' if $_[0] eq "c"; } sub aXMLeval { my $aXML = shift; say $aXML; # should output : <<a>b</a>>c</<a>b</a>> my @chars = split //, $aXML; my $level = 0; my $state = 0; my @states = ('new tag','tag name','tag data','tag end','close','dro +p'); my $dropping_from; my $laststate; my $lastchar; my @finalletters; foreach my $char (@chars) { # print "i.s: $state chr: $char"; $laststate = $state; if ($state eq 5) { if ($char eq ">") { if ($level < $dropping_from) { $state = 3; } $level--; } if ($char eq "<") { $level++; } } else { if ($char eq "<") { if ($state eq 4) { $state++; } else { $state = 0; } $level++; } elsif ($char eq ">") { $state = 3; $level--; } elsif ($char eq "/") { $state = 4; } else { if ($state eq 0) { $state = 2 } elsif ($state eq 3) { if ($level eq 0) { push (@finalletters,$lastchar); } $state--; } elsif ($state eq 4) { $state = 5; $dropping_from = $level +; } } } unless ($state eq 5 ) { push (@finalletters,$char) } $lastchar = $char; # print " l.s: $laststate e.s: $state lvl : $level $state +s[$state] "; # print "\n"; } $aXML = join('',@finalletters); say $aXML; # should output : <<a>b</>>c</> while ($aXML =~ s@<([^<>]+?)>(.+?)</>@\[$1('$2')\]@gs){} say $aXML; # should output : [[a('b')]('c')] while ($aXML =~ m@.*\[(.*?)\].*@gs) { my $expr = $1; my $result; eval (qq@ \$result = $expr; @); $expr =~ s@\(@\\\(@gs; $expr =~ s@\)@\\\)@gs; $aXML =~ s@\[$expr\]@$result@gs; } my $return; eval (qq@ \$return = $aXML; @); return $return; }
Result : 42