summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2020-01-11 10:42:07 +0100
committerYorhel <git@yorhel.nl>2020-01-11 10:42:07 +0100
commit6a5a93013e8e7254d8c91faf9e6fadde7cbb8d08 (patch)
tree55e06741d857072ee2354f010e4b8ff9a25f3bc6
parent96cfe6180a33c90d22b15c2ae95a1938ad3a75b7 (diff)
TUWF::XML: Add xml_string() function + simple test script
-rw-r--r--MANIFEST1
-rw-r--r--lib/TUWF/XML.pm11
-rw-r--r--lib/TUWF/XML.pod14
-rw-r--r--t/xml.t22
4 files changed, 47 insertions, 1 deletions
diff --git a/MANIFEST b/MANIFEST
index 4445574..2042680 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -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()>
diff --git a/t/xml.t b/t/xml.t
new file mode 100644
index 0000000..0490a80
--- /dev/null
+++ b/t/xml.t
@@ -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="&lt;/a&amp;>">
+ <br />
+ <p>
+ <b>&lt;html &amp;text></b>
+ </p>
+</body>';