File Coverage

blib/lib/Mojo/DOM/Role/PrettyPrinter.pm
Criterion Covered Total %
statement 49 60 81.6
branch 15 24 62.5
condition 10 16 62.5
subroutine 6 6 100.0
pod 1 1 100.0
total 81 107 75.7


line stmt bran cond sub pod time code
1             package Mojo::DOM::Role::PrettyPrinter;
2              
3 1     1   707 use Role::Tiny;
  1         3  
  1         8  
4 1     1   241 use Carp 'croak';
  1         3  
  1         76  
5 1     1   8 use Mojo::ByteStream 'b';
  1         3  
  1         795  
6              
7             our $VERSION = '0.03';
8              
9             requires 'tree';
10              
11             # Render as pretty xml
12             sub to_pretty_string {
13 20   100 20 1 4584 my ($self, $i) = (shift, shift // 0);
14 20   66     43 my $tree = shift || $self->tree;
15              
16 20         84 my $e = $tree->[0];
17              
18             # No element
19 20 50 0     29 croak('No element') and return unless $e;
20              
21             # Element is tag
22 20 100       49 if ($e eq 'tag') {
    50          
    50          
    50          
    50          
23 14         20 my $subtree = [@{$tree}[0 .. 2], [@{$tree}[4 .. $#$tree]]];
  14         27  
  14         28  
24              
25 14         41 return $self->_element($i, $subtree);
26             }
27              
28             # Element is text
29             elsif ($e eq 'text') {
30              
31 0         0 my $escaped = $tree->[1];
32              
33 0         0 for ($escaped) {
34 0 0       0 next unless $_;
35              
36             # Escape and trim whitespaces from both ends
37 0         0 $_ = b($_)->xml_escape->trim;
38             }
39              
40 0         0 return $escaped;
41             }
42              
43             # Element is comment
44             elsif ($e eq 'comment') {
45              
46             # Padding for every line
47 0         0 my $p = ' ' x $i;
48 0         0 my $comment = join "\n$p ", split(/;\s+/, $tree->[1]);
49              
50 0         0 return "\n" . (' ' x $i) . "\n";
51              
52             }
53              
54             # Element is processing instruction
55             elsif ($e eq 'pi') {
56 0         0 return (' ' x $i) . '[1] . "?>\n";
57              
58             }
59              
60             # Element is root
61             elsif ($e eq 'root') {
62              
63 6         7 my $content;
64              
65             # Pretty print the content
66 6         24 $content .= $self->to_pretty_string($i, $tree->[$_]) for 1 .. $#$tree;
67              
68 6         31 return $content;
69             }
70             }
71              
72             # Render element with pretty printing
73             sub _element {
74 14     14   28 my ($self, $i) = (shift, shift);
75 14         17 my ($type, $qname, $attr, $child) = @{shift()};
  14         27  
76              
77             # Is the qname valid?
78 14 50       59 croak "$qname is no valid QName" unless $qname =~ /^(?:[a-zA-Z_]+:)?[^\s]+$/;
79              
80             # Start start tag
81 14         36 my $content = (' ' x $i) . "<$qname";
82              
83             # Add attributes
84 14         44 $content .= $self->_attr((' ' x $i) . (' ' x (length($qname) + 2)), $attr);
85              
86             # Has the element a child?
87 14 100       93 if ($child->[0]) {
88              
89             # Close start tag
90 9         13 $content .= '>';
91              
92             # There is only a textual child - no indentation
93 9 100 66     35 if (!$child->[1] && ($child->[0] && $child->[0]->[0] eq 'text')) {
      100        
94             # Escape
95 3         11 $content .= b($child->[0]->[1])->trim->xml_escape;
96             }
97              
98             # There are a couple of children
99             else {
100              
101 6         9 my $offset = 0;
102              
103             # First element is unformatted textual
104 6 50 33     18 if ($child->[0] && $child->[0]->[0] eq 'text') {
105              
106             # Append directly to the last tag
107 0         0 $content .= b($child->[0]->[1])->trim->xml_escape;
108 0         0 $offset = 1;
109             }
110              
111             # Start on a new line
112 6         9 $content .= "\n";
113              
114             # Loop through all child elements
115 6         9 foreach (@{$child}[$offset .. $#$child]) {
  6         11  
116              
117             # Render next element
118 8         19 $content .= $self->to_pretty_string($i + 1, $_);
119             }
120              
121             # Correct Indent
122 6         11 $content .= (' ' x $i);
123             }
124              
125             # End Tag
126 9         185 $content .= "\n";
127             }
128              
129             # No child - close start element as empty tag
130             else {
131 5         6 $content .= " />\n";
132             }
133              
134             # Return content
135 14         50 return $content;
136             }
137              
138             # Render attributes with pretty printing
139             sub _attr {
140 14     14   27 my ($self, $indent_space) = (shift, shift);
141 14         17 my %attr = %{$_[0]};
  14         35  
142              
143             # Prepare attribute values
144 14         34 $_ = b($_)->xml_escape->quote foreach values %attr;
145              
146             # Return indented attribute string
147 14 100       187 if (keys %attr) {
148             return ' ' . join "\n$indent_space",
149 5         16 map { "$_=" . $attr{$_} } sort keys %attr;
  7         27  
150             }
151              
152             # Return nothing
153 9         16 return '';
154             }
155              
156              
157             1;
158              
159             =head1 NAME
160              
161             Mojo::DOM::Role::PrettyPrinter - Add a pretty printer method to Mojo::DOM
162              
163             =head1 SYNOPSIS
164              
165             use Mojo::DOM;
166             my $dom=Mojo::DOM->with_roles('+PrettyPrinter')->new('

Loving it

');
167             warn $dom->to_pretty_string;
168             #
169             #

Loving it

170             #
171              
172             =head1 DESCRIPTION
173              
174             Support pretty printing XML documents. The original source for this function was
175             extracted from L.
176              
177             =head1 METHODS
178              
179             =head2 to_pretty_string
180              
181             Returns the current L structure as indented XML.
182              
183             =head1 COPYRIGHT AND LICENSE
184              
185             Copyright (C) 2008-2017, Marcus Ramberg and Nils Diewald
186              
187             This program is free software, you can redistribute it and/or modify it under
188             the terms of the Artistic License version 2.0.
189              
190             =head1 SEE ALSO
191              
192             L, L, L.
193              
194             =cut