Added HTML/XML output functions and a small example using them

Based on my proof-of-concept HTML::Writer module, but with quite a
few modifications. It's a very basic and minimal module, but I don't
see how I can improve it at this point.

3 files changed, 168 insertions, 3 deletions

diff --git a/lib/VNDB/Handler/Example.pm b/lib/VNDB/Handler/Example.pm
index 6d18422..764c61d 100644
--- a/lib/VNDB/Handler/Example.pm
+++ b/lib/VNDB/Handler/Example.pm
@@ -3,12 +3,13 @@ package VNDB::Handler::Example;
 
 use strict;
 use warnings;
-use YAWF;
+use YAWF ':html';
 
 
 YAWF::register(
-  qr/envdump/,  \&envdump,
-  qr/error/,    \&error,
+  qr/envdump/,   \&envdump,
+  qr/error/,     \&error,
+  qr/html/,      \&htmlexample,
 );
 
 
@@ -43,5 +44,18 @@ sub error {
 }
 
 
+sub htmlexample {
+  html;
+   head;
+    title 'HTML Output Example';
+   end;
+   body;
+    h1 'HTML Output Example';
+    p 'This is a way to output HTML...';
+   end;
+  end;
+}
+
+
 1;
 
diff --git a/lib/YAWF.pm b/lib/YAWF.pm
index ae29dee..0872ea9 100644
--- a/lib/YAWF.pm
+++ b/lib/YAWF.pm
@@ -17,6 +17,13 @@ our $OBJ;
 my @handlers;
 
 
+# 'redirect' this import to YAWF::XML
+sub import {
+  require YAWF::XML;
+  YAWF::XML->import(@_);
+}
+
+
 # The holy init() function
 sub init {
   my %o = (
diff --git a/lib/YAWF/XML.pm b/lib/YAWF/XML.pm
new file mode 100644
index 0000000..3dbe0a6
--- /dev/null
+++ b/lib/YAWF/XML.pm
@@ -0,0 +1,144 @@
+#!/usr/bin/perl
+
+
+package YAWF::XML;
+
+
+# don't use this module directly, it won't work!
+#  use YAWF ':html';
+# or
+#  use YAWF ':xml';
+# instead.
+
+# Also, this module doesn't do any 'pretty printing', all XML/HTML tags are
+# simply outputted without any returns or indentation.
+
+
+use strict;
+use warnings;
+use Exporter;
+
+
+our(@htmltags, @htmlexport, @xmlexport);
+
+
+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
+  |;
+
+  # 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($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 $xml = grep /^:xml$/, @_;
+  my $html = grep /^:html$/, @_;
+
+  # ugly way to manually export functions...
+  no warnings 'once';
+  no strict 'refs';
+  *{"${pkg}::$_"} = *{"${type}::$_"} for ($xml ? @xmlexport : (), $html ? @htmlexport : ());
+}
+
+
+# HTML escape, also does \n to <br /> conversion
+sub escape(_) {
+  local $_ = shift || return '';
+  s/&/&amp;/g;
+  s/</&lt;/g;
+  s/>/&gt;/g;
+  s/"/&quot;/g;
+  s/\r?\n/<br \/>/g;
+  return $_;
+}
+
+
+# output literal data (not HTML escaped)
+sub lit {
+  print { $YAWF::OBJ->resFd } $_ for @_;
+}
+
+
+# output text (HTML escaped)
+sub txt {
+  lit escape $_ for @_;
+}
+
+
+# Output any XML or HTML tag.
+# Arguments                           Output
+#  'tagname'                           <tagname>
+#  'tagname', id => "main"             <tagname id="main">
+#  'tagname', '<bar>'                  <tagname>&lt;bar&gt;</tagname>
+#  'tagname', id => 'main', '<bar>'    <tagname id="main">&lt;bar&gt;</tagname>
+#  'tagname', id => 'main', undef      <tagname id="main" />
+#  'tagname', undef                    <tagname />
+sub tag {
+  (my $name = shift) =~ y/A-Z/a-z/;
+
+  my $t = '<'.$name;
+  $t .= ' '.(shift).'="'.escape(shift).'"' while @_ > 1;
+
+  if(!@_) {
+    $t .= '>';
+    lit $t;
+    push @lasttags, $name;
+  } elsif(!defined $_[0]) {
+    lit $t.' />';
+  } else {
+    lit $t.'>'.escape(shift).'</'.$name.'>';
+  } 
+}
+
+
+# Ends the last opened tag
+sub end() {
+  my $l=pop @lasttags;
+  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;
+