Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Re: Perl module for RELAX NG?

by shmem (Canon)
on Dec 05, 2006 at 21:04 UTC ( #587979=note: print w/ replies, xml ) Need Help??


in reply to Perl module for RELAX NG?

Is there anything out there? I hate editing XML and always thought a natural language style notation would be much better.

For natural style XML notation read the meditation tmoertel wrote some time ago about Embedding a mini-language for XML construction into Perl. The notation he came up with is very similar to RELAX.

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...

--shmem

_($_=" "x(1<<5)."?\n".q·/)Oo.  G°\        /
                              /\_¯/(q    /
----------------------------  \__(m.====·.(_("always off the crowd"))."·
");sub _{s./.($e="'Itrs `mnsgdq Gdbj O`qkdq")=~y/"-y/#-z/;$e.e && print}


Comment on Re: Perl module for RELAX NG?
Select or Download Code
Re^2: Perl module for RELAX NG?
by mattr (Curate) on Dec 06, 2006 at 10:49 UTC
    Whoooweee! Wow, you don't mess around do you, ask for a rock and get a rocket back. Looks like it beats the heck out of Template::Toolkit doesn't it? Thank you for sharing your code. At the very least it makes html documents a lot easier for me to read and more concise. Great!

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://587979]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (6)
As of 2014-09-01 22:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite cookbook is:










    Results (17 votes), past polls