#!/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;   
 }
[download]

Result : 42

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.