Skip to content

Instantly share code, notes, and snippets.

@masak
Created April 29, 2009 08:41
Show Gist options
  • Save masak/103668 to your computer and use it in GitHub Desktop.
Save masak/103668 to your computer and use it in GitHub Desktop.
$ cat hitomi
use v6;
grammar XML {
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 XML::Actions {
my $h = -> $/ {
make [~] gather {
for $/.chunks{
if .key eq '~' {
take .value;
} else {
take .value.ast;
}
}
}
}
method TOP($/) {
$h($/);
}
method xmlcontent($/, $key) {
$h($/);
}
method node($/) {
if $<attrs><attr> {
for $<attrs><attr> -> $a {
if $a<name> eq "pe:if" {
make eval(~$a<value>) ?? matching-if($/) !! q[];
return;
}
elsif $a<name> ~~ /^ 'pe:'/ {
make "Unknown 'pe:' attribute!";
return;
}
}
}
$h($/);
}
method empty($/) {
$h($/);
}
method attrs($/) {
$h($/);
}
method content($/) {
make ~$/;
}
sub matching-if($/) {
return $/.ast;
}
}
# RAKUDO: Arguably wrong that this has to be here and not in the class.
# [perl #65238]
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),
},
];
}
my $xml = $*IN.slurp;
my $result = XML.parse($xml, :action(XML::Actions.new()));
print $result.ast;
# vim: ft=perl6
$ cat hitomi-example.xml
<!DOCTYPE html>
<html xmlns="http://www.w3.org/1999/xhtml"
xmlns:pe="http://github.com/masak/hitomi">
<head>
<title>Slurp: News</title>
</head>
<body class="index">
<div id="header">
<h1>News</h1>
</div>
<ol pe:if="links">
<li pe: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 hitomi < hitomi-example.xml
<!DOCTYPE html>
<html xmlns="http://www.w3.org/1999/xhtml"
xmlns:pe="http://github.com/masak/hitomi">
<head>
<title>Slurp: News</title>
</head>
<body class="index">
<div id="header">
<h1>News</h1>
</div>
<ol pe:if="links">
<li pe: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>
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment