diff options
author | Yorhel <git@yorhel.nl> | 2011-01-09 16:29:29 +0100 |
---|---|---|
committer | Yorhel <git@yorhel.nl> | 2011-01-09 16:50:04 +0100 |
commit | 79894c79083005bd98b5ef19edf4966dd4675ada (patch) | |
tree | 69e9b20273bc746c5dcac60429759b4e520916b9 /lib/TUWF/XML.pm | |
parent | d7f850931451bf11538fea70b0dac212be346fc9 (diff) |
s/YAWF/TUWF/ and removed examples and some oudated docs
I'll create new examples while making some improvements to the
framework.
Diffstat (limited to 'lib/TUWF/XML.pm')
-rw-r--r-- | lib/TUWF/XML.pm | 156 |
1 files changed, 156 insertions, 0 deletions
diff --git a/lib/TUWF/XML.pm b/lib/TUWF/XML.pm new file mode 100644 index 0000000..f5a0774 --- /dev/null +++ b/lib/TUWF/XML.pm @@ -0,0 +1,156 @@ +#!/usr/bin/perl + + +package TUWF::XML; + + +# don't use this module directly, it won't work! +# use TUWF ':html'; +# or +# use TUWF ':xml'; +# instead. + + +use strict; +use warnings; +use Exporter; + + +our(@htmltags, @htmlexport, @xmlexport, @htmlbool); + + +BEGIN { + # xhtml 1.0 tags + @htmltags = qw| + address blockquote div dl fieldset form h1 h2 h3 h4 h5 h6 noscript ol p pre ul + a abbr acronym b bdo big br button cite code dfn em i img input kbd label Map + object q samp Select small span strong Sub sup textarea tt var caption col + colgroup table tbody td tfoot th thead Tr area base body dd del dt head ins + legend li Link meta optgroup option param script style title + |; + + # boolean (self-closing) tags + @htmlbool = qw| hr br img input area base frame link param |; + + # functions to export + @htmlexport = (@htmltags, qw| html lit txt tag end |); + @xmlexport = qw| xml lit txt tag end |; + + # create the subroutines to map to the html tags + no strict 'refs'; + for my $e (@htmltags) { + *{__PACKAGE__."::$e"} = sub { _tag(1, $e, @_) } + } +}; + + +# keeps track of the openend tags +my @lasttags; + + +sub import { + my $type = shift; + + # the package that imported the package that imports this package + # this is the reason you can't use this module directly + my $pkg = caller(1); + + my @exp; + push @exp, @xmlexport if grep /^:xml$/, @_; + push @exp, @htmlexport if grep /^:html$/, @_; + push @exp, 'xml_escape' if grep /^xml_escape$/, @_; + + # ugly way to manually export functions... + no warnings 'once'; + no strict 'refs'; + *{"${pkg}::$_"} = *{"${type}::$_"} for (@exp); +} + + +# HTML escape, also does \n to <br /> conversion +sub xml_escape { + local $_ = shift; + return '' if !$_ && $_ ne '0'; + s/&/&/g; + s/</</g; + s/>/>/g; + s/"/"/g; + s/\r?\n/<br \/>/g; + return $_; +} + + +# output literal data (not HTML escaped) +sub lit { + print { $TUWF::OBJ->resFd } $_ for @_; +} + + +# output text (HTML escaped) +sub txt { + lit xml_escape $_ for @_; +} + + +# Output any XML or HTML tag. +# Arguments Output +# 'tagname' <tagname> +# 'tagname', id => "main" <tagname id="main"> +# 'tagname', '<bar>' <tagname><bar></tagname> +# 'tagname', id => 'main', '<bar>' <tagname id="main"><bar></tagname> +# 'tagname', id => 'main', undef <tagname id="main" /> +# 'tagname', undef <tagname /> +sub _tag { + my $indirect = shift; # called as tag() or as generated html function? + my $name = shift; + $name =~ y/A-Z/a-z/ if $indirect; + + my $t = $TUWF::OBJ->{_TUWF}{xml_pretty} ? "\n".(' 'x(@lasttags*$TUWF::OBJ->{_TUWF}{xml_pretty})) : ''; + $t .= '<'.$name; + $t .= ' '.(shift).'="'.xml_escape(shift).'"' while @_ > 1; + + push @_, undef if $indirect && !@_ && grep $name eq $_, @htmlbool; + + if(!@_) { + $t .= '>'; + lit $t; + push @lasttags, $name; + } elsif(!defined $_[0]) { + lit $t.' />'; + } else { + lit $t.'>'.xml_escape(shift).'</'.$name.'>'; + } +} +sub tag { + _tag 0, @_; +} + + +# Ends the last opened tag +sub end() { + my $l=pop @lasttags; + lit "\n".(' 'x(@lasttags*$TUWF::OBJ->{_TUWF}{xml_pretty})) if $TUWF::OBJ->{_TUWF}{xml_pretty}; + lit '</'.$l.'>'; +} + + +# Special function, this writes the XHTML 1.0 Strict doctype +# (other doctypes aren't supported at the moment) +sub html() { + lit qq|<!DOCTYPE html + PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" + "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">\n|; + push @lasttags, 'html'; +} + + +# Writes an xml header, doesn't open an <xml> tag, and doesn't need an +# end() either. +sub xml() { + lit qq|<?xml version="1.0" encoding="UTF-8"?>\n|; +} + + +1; + |