File Coverage

blib/lib/Spreadsheet/WriteExcelXML/XMLwriter.pm
Criterion Covered Total %
statement 83 83 100.0
branch 25 26 96.1
condition 3 3 100.0
subroutine 13 13 100.0
pod 1 2 50.0
total 125 127 98.4


line stmt bran cond sub pod time code
1             package Spreadsheet::WriteExcelXML::XMLwriter;
2              
3             ###############################################################################
4             #
5             # XMLwriter - A base class for Excel workbooks and worksheets.
6             #
7             #
8             # Used in conjunction with Spreadsheet::WriteExcelXML
9             #
10             # Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
11             #
12             # Documentation after __END__
13             #
14              
15 24     24   967 use Exporter;
  24         49  
  24         1540  
16 24     24   133 use strict;
  24         46  
  24         922  
17              
18              
19              
20              
21              
22              
23              
24              
25 24     24   128 use vars qw($VERSION @ISA);
  24         297  
  24         28228  
26             @ISA = qw(Exporter);
27              
28             $VERSION = '0.14';
29              
30             ###############################################################################
31             #
32             # new()
33             #
34             # Constructor
35             #
36             sub new {
37              
38 101     101 0 307 my $class = $_[0];
39              
40 101         633 my $self = {
41             _filehandle => $_[1],
42             _indentation => " ",
43             _no_encoding => 0,
44             };
45              
46 101         266 bless $self, $class;
47 101         323 return $self;
48             }
49              
50              
51             ###############################################################################
52             #
53             # _format_tag($level, $nl, $list, @attributes)
54             #
55             # This function formats an XML element tag for printing. Adds indentation and
56             # newlines as specified. Keeps attributes, if any, on one line or formats
57             # them one per line.
58             #
59             # Args:
60             # $level = The indentation level (int)
61             # $nl = Number of newlines after tag (int)
62             # $list = List attributes on separate lines (0, 1, 2)
63             # 0 = No list
64             # 1 = Automatic list
65             # 2 = Explicit list
66             # @attributes = Attribute/Value pairs
67             #
68             # The list option puts the attributes on separate lines if there is more
69             # than one attribute. List option 2 generates this effect even when there
70             # is only one attribute.
71             #
72             sub _format_tag {
73              
74 2244     2244   2625 my $self = shift;
75              
76 2244         3160 my $level = shift;
77 2244         2138 my $nl = shift;
78 2244         2133 my $list = shift;
79              
80 2244         4958 my $element = $self->{_indentation} x $level. '<' . shift;
81              
82             # Autolist option. Only use list format if there is more than 1 attribute.
83 2244 100 100     5410 $list = 0 if $list == 1 and @_ <= 2;
84              
85              
86             # Special case. If _indentation is "" avoid all unnecessary whitespace
87 2244 100       4455 $list = 0 if $self->{_indentation} eq "";
88 2244 100       4709 $nl = 0 if $self->{_indentation} eq "";
89              
90              
91 2244         4603 while (@_) {
92 1334         1962 my $attrib = shift;
93 1334         3675 my $value = $self->_encode_xml_escapes(shift);
94              
95 1334 100       2314 if ($list) {$element .= "\n" . $self->{_indentation} x ($level +1);}
  96         251  
  1238         1580  
96             else {$element .= ' '; }
97              
98 1334         1468 $element .= $attrib;
99 1334         3852 $element .= '="' . $value . '"';
100             }
101              
102 2244 100       3967 $nl = $nl ? "\n" x $nl : "";
103              
104 2244         5594 return $element . '>'. $nl;
105             }
106              
107              
108             ###############################################################################
109             #
110             # _encode_xml_escapes()
111             #
112             # Encode standard XML escapes, namely " & < > and \n. The apostrophe character
113             # isn't escaped since it will only occur in double quoted strings.
114             #
115             sub _encode_xml_escapes {
116              
117 1546     1546   6605 my $self = shift;
118 1546         1847 my $value = $_[0];
119              
120             # Print un-encoded entities for debugging
121 1546 50       3407 return $value if $self->{_no_encoding};
122              
123 1546         2555 for ($value) {
124 1546         2320 s/&/&/g;
125 1546         1803 s/
126 1546         1787 s/>/>/g;
127 1546         1990 s/"/"/g; # "
128             #s/'/&pos;/g; # Not used
129 1546         3318 s/\n/ /g;
130             }
131              
132 1546         3324 return $value;
133             }
134              
135              
136             ###############################################################################
137             #
138             # _write_xml_start_tag()
139             #
140             # Creates a formatted XML opening tag. Prints to the current filehandle by
141             # default.
142             #
143             # Ex:
144             #
145             sub _write_xml_start_tag {
146              
147 958     958   9180 my $self = shift;
148              
149 958         1928 my $tag = $self->_format_tag(@_);
150              
151 958         1943 local $\; # Make print() ignore -l on the command line.
152 958 100       2265 print {$self->{_filehandle}} $tag if $self->{_filehandle};
  929         2353  
153              
154 958         2767 return $tag;
155             }
156              
157              
158             ###############################################################################
159             #
160             # _write_xml_directive()
161             #
162             # Creates a formatted XML directive. Prints to the current filehandle by
163             # default.
164             #
165             # Ex:
166             #
167             sub _write_xml_directive {
168              
169 40     40   3027 my $self = shift;
170              
171 40         241 my $tag = $self->_format_tag(@_);
172 40         145 $tag =~ s[<][
173 40         120 $tag =~ s[>][?>];
174              
175 40         156 local $\; # Make print() ignore -l on the command line.
176 40 100       184 print {$self->{_filehandle}} $tag if $self->{_filehandle};
  36         446  
177              
178 40         227 return $tag;
179             }
180              
181              
182             ###############################################################################
183             #
184             # _write_xml_end_tag()
185             #
186             # Creates the closing tag of an XML element. Prints to the current filehandle
187             # by default.
188             #
189             # Ex:
190             #
191             sub _write_xml_end_tag {
192              
193 932     932   3137 my $self = shift;
194              
195 932         1849 my $tag = $self->_format_tag(@_);
196 932         2550 $tag =~ s[<][
197              
198 932         1807 local $\; # Make print() ignore -l on the command line.
199 932 100       2154 print {$self->{_filehandle}} $tag if $self->{_filehandle};
  929         1884  
200              
201 932         2886 return $tag;
202              
203             }
204              
205              
206             ###############################################################################
207             #
208             # _write_xml_element()
209             #
210             # Creates a single open and closed XML element. Prints to the current
211             # filehandle by default.
212             #
213             # Ex: or
214             #
215             sub _write_xml_element {
216              
217 314     314   2684 my $self = shift;
218              
219 314         743 my $tag = $self->_format_tag(@_);
220 314         1214 $tag =~ s[>][/>];
221              
222 314         1222 local $\; # Make print() ignore -l on the command line.
223 314 100       965 print {$self->{_filehandle}} $tag if $self->{_filehandle};
  140         382  
224              
225 314         1539 return $tag;
226             }
227              
228              
229             ###############################################################################
230             #
231             # _write_xml_content()
232             #
233             # Creates an encoded XML element content. Prints to the current filehandle
234             # by default.
235             #
236             # Ex: Hello in Hello
237             #
238             sub _write_xml_content {
239              
240 204     204   1586 my $self = shift;
241              
242 204         428 my $tag = $self->_encode_xml_escapes($_[0]);
243              
244 204         464 local $\; # Make print() ignore -l on the command line.
245 204 100       522 print {$self->{_filehandle}} $tag if $self->{_filehandle};
  202         395  
246              
247 204         574 return $tag;
248              
249             }
250              
251              
252             ###############################################################################
253             #
254             # _write_xml_unencoded_content()
255             #
256             # Creates an un-encoded XML element content. Prints to the current filehandle
257             # by default. Used for numerical or other data that doesn't need to be
258             # encoded.
259             #
260             # Ex: 1.2345 in 1.2345
261             #
262             sub _write_xml_unencoded_content {
263              
264 55     55   2061 my $self = shift;
265              
266 55         770 my $tag = $_[0];
267              
268 55         114 local $\; # Make print() ignore -l on the command line.
269 55 100       175 print {$self->{_filehandle}} $tag if $self->{_filehandle};
  52         153  
270              
271 55         185 return $tag;
272             }
273              
274              
275             ###############################################################################
276             #
277             # set_indentation()
278             #
279             # Set indentation string used to indent the output. The default is 4 spaces.
280             #
281             sub set_indentation {
282              
283 16     16 1 16123 my $self = shift;
284 16 100       69 $self->{_indentation} = defined $_[0] ? $_[0] : ' ';
285             }
286              
287              
288             1;
289              
290              
291             __END__