viklund · May 12, 2009 20:10
diff --git a/hitomi b/hitomi
 #!perl6

 # A lot of the subs in this one can be simplified and merged

 class For { 
    has $.value;
    method perl { "For.new('$.value')" }
 }

 class If {
    has $.value;
    method perl { "If.new($.value)" }
 }

 class Eval { }

 grammar Test {
    regex TOP { ^ <pi>* <xmlcontent>+ {*} $ };

    token xmlcontent {
        | <node>           {*} #= node
        | <empty>          {*} #= empty
        | <content>        {*} #= content
    };

    rule node {
        '<' <name=ident> <attrs> '>'
        <xmlcontent>*
        '</' $<name> '>'
        {*}
    }
    rule pi { '<!' <.ident> <.ident> '>' };

    rule empty   { '<'  <name=ident> <attrs> '/>' {*} };

    token attrs { <attr>* }
    rule attr { $<name>=[<.ident>[':'<.ident>]?] '=' '"' $<value>=[<-["]>+] '"' }
    
    token ident { <+alnum + [\-]>+ }

    regex content { <-[<]>+ }
 }

 class Test::Action {
    method TOP($/) {}
    method xmlcontent($/, $key) { }
    method node($/) { 
        if $/<attrs> ne '' {
            for $/<attrs><attr> -> $attr {
                if ~$attr<name> eq 'pl:if' {
                    make If.new( :value( ~$attr<value> ) );
                }
                elsif ~$attr<name> eq 'pl:for' {
                    make For.new( :value( ~$attr<value> ) );
                }
            }
        }
    }
 }

 sub links() {
    return [
        {
            :url<http://ihrd.livejournal.com/>,
            :title("ihrd's blog"),
            :username<ihrd>,
            :time(1240904601)
        },
        {   :url<http://blogs.gurulabs.com/stephen/>,
            :title("Tene's blog"),
            :username<Tene>,
            :time(1240905184),
        },
        {   :url<http://use.perl.org/~masak/journal/>,
            :title("masak's blog"),
            :username<masak>,
            :time(1240905293),
        },
    ];
 }

 multi sub traverse( $a?, $b? ) {
    return;
    say "STRANGENESS HERE, GOT:";
    if $a {
        say "    ",$a.WHAT,' ',$a;
    }
    if $b {
        say "    ",$b.WHAT,' ',$b;
    }
 }

 multi sub traverse( Match $m, Str $s where 'root' | 'xmlcontent' ) {
    for $m.chunks -> $c {
        traverse( $c.value, $c.key );
    }
 }

 multi sub traverse( Match $m, Str $s where 'empty' ) {
    # For seems unlikely on an empty node
    if $m.ast ~~ If {
        if eval( $m.ast.value ) {
            recreate_empty_node( $m );
        }
    }
    else {
        recreate_empty_node( $m );
    }
 }

 multi sub traverse( Match $m, Str $s where 'content' | 'pi' ) {
    take $m.text;
 }

 multi sub traverse( Match $m, Str $s where 'node' ) {
    if $m.ast ~~ If {
        if eval( $m.ast.value ) {
            recreate_node( $m );
        }
    }
    elsif $m.ast ~~ For {
        #say $m.ast.perl;
        recreate_node( $m );
    }
    else {
        recreate_node( $m );
    }
 }

 sub recreate_empty_node( Match $m ) {
    take '<' ~ $m<name>;
    get_attributes( $m );
    take " />";
 }

 sub recreate_node( Match $m ) {
    take '<' ~ $m<name>;
    get_attributes( $m );
    take '>';
    for $m<xmlcontent> -> $c {
        traverse( $c, 'xmlcontent' );
    }
    take '</' ~ $m<name> ~ '>';
 }

 sub get_attributes( Match $m ) {
    if $m<attrs> ne '' {
        for $m<attrs><attr> -> $a {
            next if $a.text ~~ /^pl:/;
            take ' ' ~ $a.text;
        }
    }
 }

 #my $str = '<ol pl:if="links">plink</ol><p>ohla</p>';
 #my $str = '<ol pl:if="links">plink</ol>';
 #my $str = '<ol a="b">plink</ol>';
 #my $str = '<body><p><a />hej</p></body>';
 my $str = $*IN.slurp;

 my $res = Test.parse( $str, :action( Test::Action.new() ) );

 $res.perl.say;
 say "#############";

 say [~] gather traverse( $res, 'root' );

 # vim: ft=perl6
diff --git a/hitomi-example.xml b/hitomi-example.xml
 <!DOCTYPE html>
 <html xmlns="http://www.w3.org/1999/xhtml"
      xmlns:pl="http://github.com/masak/hitomi">
  <head>
    <title>Slurp: News</title>
  </head>
  <body class="index">
    <div id="header">
      <h1>News</h1>
    </div>

    <ol pl:if="links">
      <li pl:for="links.reverse -> $link">
        <a href="${$link.url}">${$link.title}</a>
        posted by ${$link.username} at ${strftime('%x %X', $link.time)}
      </li>
    </ol>

    <p><a class="action" href="/submit/">Submit new link</a></p>

    <div id="footer">
      <hr />
      <p class="legalese">© 2009 The Web.pm authors, Artistic License 2.0</p>
    </div>
  </body>
 </html>
	#!perl6

	# A lot of the subs in this one can be simplified and merged

	class For {
	has $.value;
	method perl { "For.new('$.value')" }
	}

	class If {
	has $.value;
	method perl { "If.new($.value)" }
	}

	class Eval { }

	grammar Test {
	regex TOP { ^ <pi>* <xmlcontent>+ {*} $ };

	token xmlcontent {
	\| <node> {*} #= node
	\| <empty> {*} #= empty
	\| <content> {*} #= content
	};

	rule node {
	'<' <name=ident> <attrs> '>'
	<xmlcontent>*
	'</' $<name> '>'
	{*}
	}
	rule pi { '<!' <.ident> <.ident> '>' };

	rule empty { '<' <name=ident> <attrs> '/>' {*} };

	token attrs { <attr>* }
	rule attr { $<name>=[<.ident>[':'<.ident>]?] '=' '"' $<value>=[<-["]>+] '"' }

	token ident { <+alnum + [\-]>+ }

	regex content { <-[<]>+ }
	}

	class Test::Action {
	method TOP($/) {}
	method xmlcontent($/, $key) { }
	method node($/) {
	if $/<attrs> ne '' {
	for $/<attrs><attr> -> $attr {
	if ~$attr<name> eq 'pl:if' {
	make If.new( :value( ~$attr<value> ) );
	}
	elsif ~$attr<name> eq 'pl:for' {
	make For.new( :value( ~$attr<value> ) );
	}
	}
	}
	}
	}

	sub links() {
	return [
	{
	:url<http://ihrd.livejournal.com/>,
	:title("ihrd's blog"),
	:username<ihrd>,
	:time(1240904601)
	},
	{ :url<http://blogs.gurulabs.com/stephen/>,
	:title("Tene's blog"),
	:username<Tene>,
	:time(1240905184),
	},
	{ :url<http://use.perl.org/~masak/journal/>,
	:title("masak's blog"),
	:username<masak>,
	:time(1240905293),
	},
	];
	}

	multi sub traverse( $a?, $b? ) {
	return;
	say "STRANGENESS HERE, GOT:";
	if $a {
	say " ",$a.WHAT,' ',$a;
	}
	if $b {
	say " ",$b.WHAT,' ',$b;
	}
	}

	multi sub traverse( Match $m, Str $s where 'root' \| 'xmlcontent' ) {
	for $m.chunks -> $c {
	traverse( $c.value, $c.key );
	}
	}

	multi sub traverse( Match $m, Str $s where 'empty' ) {
	# For seems unlikely on an empty node
	if $m.ast ~~ If {
	if eval( $m.ast.value ) {
	recreate_empty_node( $m );
	}
	}
	else {
	recreate_empty_node( $m );
	}
	}

	multi sub traverse( Match $m, Str $s where 'content' \| 'pi' ) {
	take $m.text;
	}

	multi sub traverse( Match $m, Str $s where 'node' ) {
	if $m.ast ~~ If {
	if eval( $m.ast.value ) {
	recreate_node( $m );
	}
	}
	elsif $m.ast ~~ For {
	#say $m.ast.perl;
	recreate_node( $m );
	}
	else {
	recreate_node( $m );
	}
	}

	sub recreate_empty_node( Match $m ) {
	take '<' ~ $m<name>;
	get_attributes( $m );
	take " />";
	}

	sub recreate_node( Match $m ) {
	take '<' ~ $m<name>;
	get_attributes( $m );
	take '>';
	for $m<xmlcontent> -> $c {
	traverse( $c, 'xmlcontent' );
	}
	take '</' ~ $m<name> ~ '>';
	}

	sub get_attributes( Match $m ) {
	if $m<attrs> ne '' {
	for $m<attrs><attr> -> $a {
	next if $a.text ~~ /^pl:/;
	take ' ' ~ $a.text;
	}
	}
	}

	#my $str = '<ol pl:if="links">plink</ol><p>ohla</p>';
	#my $str = '<ol pl:if="links">plink</ol>';
	#my $str = '<ol a="b">plink</ol>';
	#my $str = '<body><p><a />hej</p></body>';
	my $str = $*IN.slurp;

	my $res = Test.parse( $str, :action( Test::Action.new() ) );

	$res.perl.say;
	say "#############";

	say [~] gather traverse( $res, 'root' );

	# vim: ft=perl6
	<!DOCTYPE html>
	<html xmlns="http://www.w3.org/1999/xhtml"
	xmlns:pl="http://github.com/masak/hitomi">
	<head>
	<title>Slurp: News</title>
	</head>
	<body class="index">
	<div id="header">
	<h1>News</h1>
	</div>

	<ol pl:if="links">
	<li pl:for="links.reverse -> $link">
	<a href="${$link.url}">${$link.title}</a>
	posted by ${$link.username} at ${strftime('%x %X', $link.time)}
	</li>
	</ol>

	<p><a class="action" href="/submit/">Submit new link</a></p>

	<div id="footer">
	<hr />
	<p class="legalese">© 2009 The Web.pm authors, Artistic License 2.0</p>
	</div>
	</body>
	</html>