I've made a module out of his idea which I didn't publish. Code using it...
#!/usr/bin/perl
use HTML::Writer qw(xhtml1-transitional.dtd);
render {
HTML {
HEAD {
TITLE { "foo bar"};
};
BODY {
class_ "ugly";
onload_ "javascript: mumble()";
DIV {
class_ "foo";
id_ "bar";
t "If in doubt, mumble.";
IMG { src_ "foo.jpg" };
};
TABLE {
my $c;
for (qw(foo bar baz)) {
TR {
TD { $_ }; TD { $c++};
}
}
};
DIV { class_ "bar"; t "End of that." };
}
};
} 1; # <-- indent level.. kinda odd at this position...
the module...
package HTML::Writer;
use strict;
use XML::Writer;
use XML::DTDParser;
use LWP::Simple;
use File::Slurp;
use Exporter;
our @ISA = qw(Exporter);
our @EXPORT;
our $DTD; # DTD structure, to trap errors e.g. illegal attributes
# default DTD file
my $dtdfile = "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd
+";
my $dtdtype;
our $__frag = ''; # XXX how _not_ make that a package global?
sub import {
my $package = shift;
$dtdfile = shift if $_[0];
$dtdfile =~ /(\w+)\.dtd/ && ($dtdtype = ucfirst($1));
my $dtd;
if($dtdfile =~ /^http:\/\//) {
$dtd = get($dtdfile);
} else {
foreach my $p(@INC) {
if (-f "$p/$dtdfile") {
$dtd = read_file("$p/$dtdfile") or die "$!\n";
last;
}
}
}
$dtd =~ s/.*=== Imported Names =+-->//s; # trap 'die' in XML::DTDP
+arser
$DTD = ParseDTD $dtd or die "$!";
my $elems = [ map { uc($_) } keys %$DTD ];
my %s;
my $attrs = [
grep { s/-/_/g; ! $s{$_}++ }
map { keys %{$DTD->{$_}->{'attributes'}} } keys %$DTD
];
define_vocabulary($elems,$attrs);
HTML::Writer->export_to_level(1,$package);
}
sub define_vocabulary {
no strict "refs";
my($elems, $attrs) = @_;
for (@$elems) {
my $name = $_;
*{$_} = sub(&) { _elem($name, @_) };
}
for (@$attrs) {
my $name = $_;
*{$_."_"} = sub($) { _attr($name, @_) };
}
push(@EXPORT,
qw(render t ),
@$elems, map {$_.'_'} @$attrs
);
}
# root fragment
sub doc(&) {
my ($content_fn) = @_;
local $__frag = [undef,undef,undef];
$content_fn->();
$__frag->[2][0];
}
sub _elem {
my ($elem_name, $content_fn) = @_;
# an element is represented by the triple [name, attrs, children]
my $elem = [$elem_name, undef, undef];
my $ret = do { local $__frag = $elem; $content_fn->(); };
$elem->[2] = [$ret] if defined $ret and not $elem->[2];
$__frag->[2] = [] unless $__frag->[2];
push @{$__frag->[2]}, $elem;
undef;
}
sub _attr {
my ($attr_name, $val) = @_;
$attr_name =~ s/_/-/g;
push @{$__frag->[1]}, [$attr_name, $val];
undef;
}
sub t ($) { push @{$__frag->[2]}, @_ }
sub render_via_xml_writer {
my $doc = shift;
my $writer = XML::Writer->new(@_); # extra args go to ->new()
$writer->doctype( "html",
"-//W3C//DTD XHTML 1.0 $dtdtype//EN",
$dtdfile
) if 0;
_render($writer,$doc);
$writer->end();
undef $__frag;
}
sub _render {
my ($writer,$frag) = @_;
my ($elem, $attrs, $children) = @$frag;
$elem = lc($elem);
$writer->startTag( $elem, map {@$_} @$attrs );
for (@$children) {
ref() ? _render($writer,$_) : $writer->characters($_);
}
$writer->endTag($elem);
}
sub render(&;$) {
local $__frag = '';
my $docfn = shift;
my $indent = shift;
my $output = '';
(defined $indent and $indent =~ /^\d+/) or ($indent = 2);
render_via_xml_writer(
doc( \&$docfn ),
DATA_MODE => 1,
UNSAFE => 1,
DATA_INDENT => $indent,
OUTPUT => \$output,
);
undef $__frag;
undef $docfn;
my $wantarray = wantarray;
if(defined $wantarray) {
return $wantarray == 0 ? $output : split /\n/, $output;
}
print $output;
}
1;
I guess that could easily be tweaked (for some value of "easy" :-) to make a cool RELAX module...