#!/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','drop');
  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    $states[$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;   
 }