summaryrefslogtreecommitdiff
path: root/lib/TUWF/XML.pm
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2017-12-28 09:40:17 +0100
committerYorhel <git@yorhel.nl>2017-12-28 09:40:17 +0100
commit544e6600522624c18c98aab4df22fc5a127bd776 (patch)
tree4471a8662ff7125dc94477007c501a85c85f63c4 /lib/TUWF/XML.pm
parent759ddcaff7e4ae1bc466c23f13a6ad8fa6735f1f (diff)
TUWF::XML: Fix 'pretty' formatting + disallow end() closing parent tags
Html; Head sub { End; # this would previously generate </html>, now it's an error. };
Diffstat (limited to 'lib/TUWF/XML.pm')
-rw-r--r--lib/TUWF/XML.pm13
1 files changed, 9 insertions, 4 deletions
diff --git a/lib/TUWF/XML.pm b/lib/TUWF/XML.pm
index a1ca83e..8b32344 100644
--- a/lib/TUWF/XML.pm
+++ b/lib/TUWF/XML.pm
@@ -100,6 +100,7 @@ sub new {
$o{write} ||= sub { print @_ };
my $self = bless {
%o,
+ nesting => 0,
stack => [],
}, $pack;
$OBJ = $self if $o{default};
@@ -173,8 +174,8 @@ sub tag {
my $name = shift;
croak "Invalid XML tag name" if !$name || $name =~ /^[^a-z]/i || $name =~ / /;
- my $t = $s->{pretty} ? "\n".(' 'x(@{$s->{stack}}*$s->{pretty})) : '';
- $t .= '<'.$name;
+ my $indent = $s->{pretty} ? "\n".(' 'x($s->{nesting}*$s->{pretty})) : '';
+ my $t = $indent.'<'.$name;
while(@_ > 1) {
my $attr = shift;
croak "Invalid XML attribute name" if !$attr || $attr =~ /^[^a-z]/i || $attr =~ / /;
@@ -184,12 +185,15 @@ sub tag {
if(!@_) {
$s->lit($t.'>');
push @{$s->{stack}}, $name;
+ $s->{nesting}++;
} elsif(!defined $_[0]) {
$s->lit($t.' />');
} elsif(ref $_[0] eq 'CODE') {
$s->lit($t.'>');
+ local $s->{nesting} = $s->{nesting}+1;
+ local $s->{stack} = []; # Call the sub with an empty stack, there's nothing to end() now.
$_[0]->();
- $s->lit('</'.$name.'>');
+ $s->lit($indent.'</'.$name.'>');
} else {
$s->lit($t.'>'.xml_escape(shift).'</'.$name.'>');
}
@@ -204,9 +208,10 @@ sub end {
my $s = ref($_[0]) eq __PACKAGE__ ? shift : $OBJ;
my $w = shift;
my $l = pop @{$s->{stack}};
+ $s->{nesting}--;
croak "No more tags to close" if !$l;
croak "Specified tag to end ($w) is not equal to the last opened tag ($l)" if $w && $w ne $l;
- $s->lit("\n".(' 'x(@{$s->{stack}}*$s->{pretty}))) if $s->{pretty};
+ $s->lit("\n".(' 'x($s->{nesting}*$s->{pretty}))) if $s->{pretty};
$s->lit('</'.$l.'>');
}