gistfile1.pl

#!perl6
 
class For { }
 
class If {
    has $.value;
    method perl { "If.new($.value)" }
    method Str  { "<MANGLED_IF $.value>" }
}
 
class Eval { }
 
grammar Test {
    regex TOP { ^ <xmlcontent>+ {*} $ };
 
    token xmlcontent {
        | <node> {*} #= node
        | <content> {*} #= content
    };
 
    rule node {
        '<' <name=ident> <attrs>'>'
        <xmlcontent>*
        '</' $<name> '>'
        {*}
    }
    token attrs { <attr>* {*} }
    rule attr { $<name>=[<.ident>[':'<.ident>]?] '=' '"' $<value>=[<-["]>+]
        '"'  {*}}
    token ident { <+alnum + [\-]>+ {*} }
    regex content { <-[<]>+ {*} }
}

class Test::Action {
    my $do = -> $/ { 
        make [
            gather for $/.chunks {
                if .key eq '~' {
                    take .value;
                } else {
                    take .value.ast;
                }
            }
        ]
    }
    method TOP($/) {
        $do($/);
    }
    method xmlcontent($/, $key) {
        $do($/);
    }
    method node($/) {

        my @names = try { @($/<attrs><attr>.map: {.<name>}) };

        if any(@names) eq "pl:if" {
            say "FOUND A 'pl:if'";
            make If.new(:value(~$/));
        } else {
            $do($/);
        }
    }
    method  attrs($/) {
        $do($/);
    }
    method  attr($/) {
        $do($/);
    }
    method  ident($/) {
        $do($/);
    }
    method  content($/) {
        $do($/);
    }
}

multi sub traverse(Str $m) { $m }
multi sub traverse(@m) {
    [~] gather {
        for @m -> $a {
            take traverse($a);
        }
    }
}
multi sub traverse(If $m) {
    ~$m
}
            
my $str = '<div a="b"></div><ol pl:if="links">plink</ol>';
    
my $res = Test.parse( $str, :action( Test::Action.new() ) ) or die "no match";
say $res.ast.perl; 
#say traverse($res.ast) eq $str ?? "YES" !! "NO";
say traverse($res.ast);

# vim: ft=perl6