diff options
author | Yorhel <git@yorhel.nl> | 2020-01-11 10:42:07 +0100 |
---|---|---|
committer | Yorhel <git@yorhel.nl> | 2020-01-11 10:42:07 +0100 |
commit | 6a5a93013e8e7254d8c91faf9e6fadde7cbb8d08 (patch) | |
tree | 55e06741d857072ee2354f010e4b8ff9a25f3bc6 | |
parent | 96cfe6180a33c90d22b15c2ae95a1938ad3a75b7 (diff) |
TUWF::XML: Add xml_string() function + simple test script
-rw-r--r-- | MANIFEST | 1 | ||||
-rw-r--r-- | lib/TUWF/XML.pm | 11 | ||||
-rw-r--r-- | lib/TUWF/XML.pod | 14 | ||||
-rw-r--r-- | t/xml.t | 22 |
4 files changed, 47 insertions, 1 deletions
@@ -30,3 +30,4 @@ README.md t/interop.t t/kv_validate.t t/validate.t +t/xml.t diff --git a/lib/TUWF/XML.pm b/lib/TUWF/XML.pm index 87afa4f..108e1f1 100644 --- a/lib/TUWF/XML.pm +++ b/lib/TUWF/XML.pm @@ -59,7 +59,7 @@ BEGIN { # functions to export @EXPORT_OK = (@all, qw( - xml mkclass xml_escape html_escape + xml mkclass xml_escape html_escape xml_string tag html lit txt end Tag Html Lit Txt End tag_ html_ lit_ txt_ end_ @@ -136,6 +136,15 @@ sub html_escape { return $_; } +# Evaluate a function and return XML as a string +sub xml_string { + my $f = pop; + my $buf = ''; + local $OBJ = TUWF::XML->new(@_, write => sub { $buf .= shift }); + $f->(); + $buf +} + # output literal data (not HTML escaped) sub lit { diff --git a/lib/TUWF/XML.pod b/lib/TUWF/XML.pod index e56a89e..1d1fafb 100644 --- a/lib/TUWF/XML.pod +++ b/lib/TUWF/XML.pod @@ -110,6 +110,20 @@ the control on where to (not) insert whitespace. Default: 0 (disabled). =back +=head2 xml_string(%options, &func) + +Convenience function to construct an XML string using the functional interface +without affecting an existing globally set I<default> object. The I<default> +object will be set to a newly constructed TUWF::XML object only for the +duration of C<&func>. The given C<%options> are the same as listed for +C<new()>, though only the I<pretty> option makes sense for this function. +Example: + + my $str = xml_string sub { + b class => 'hello', 'Hello!'; + }; + # $str is '<b class="hello">Hello!</b>' + =head2 mkclass(%classes) Dynamically constructs a I<class> attribute, which can be passed to C<tag()> @@ -0,0 +1,22 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Test::More tests => 2; + +BEGIN { use_ok 'TUWF::XML', qw/:html xml_string/ }; + +is xml_string(pretty => 1, sub { + body t => '</a&>', sub { + br; + p; + b '<html &text>'; + end; + }; +}), ' +<body t="</a&>"> + <br /> + <p> + <b><html &text></b> + </p> +</body>'; |