File Coverage

blib/lib/Tags/Output/LibXML.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1             package Tags::Output::LibXML;
2              
3             # Pragmas.
4 13     13   46620 use base qw(Tags::Output);
  13         66  
  13         9629  
5 13     13   370492 use strict;
  13         28  
  13         248  
6 13     13   75 use warnings;
  13         30  
  13         362  
7              
8             # Modules.
9 13     13   58 use Error::Pure qw(err);
  13         22  
  13         438  
10 13     13   69 use Readonly;
  13         19  
  13         429  
11 13     13   931985 use XML::LibXML;
  0            
  0            
12              
13             # Constants.
14             Readonly::Scalar my $EMPTY_STR => q{};
15              
16             # Version.
17             our $VERSION = 0.01;
18              
19             # Flush tags in object.
20             sub flush {
21             my ($self, $reset_flag) = @_;
22             my $ret;
23             my $ouf = $self->{'output_handler'};
24             if ($ouf) {
25             no warnings;
26             print {$ouf} $self->{'doc'}->toString(
27             $self->{'set_indent'} ? 2 : 0)
28             or err 'Cannot write to output handler.';
29             } else {
30             $ret = $self->{'doc'}->toString(
31             $self->{'set_indent'} ? 2 : 0);
32             }
33              
34             # Reset.
35             if ($reset_flag) {
36             $self->reset;
37             }
38              
39             return $ret;
40             }
41              
42             # Resets internal variables.
43             sub reset {
44             my $self = shift;
45              
46             # Root node.
47             $self->{'doc'} = XML::LibXML::Document->new(
48             $self->{'xml_version'},
49             $self->{'encoding'},
50             );
51              
52             # First node = root node.
53             $self->{'first'} = 0;
54              
55             # Printed tags.
56             $self->{'printed_tags'} = [];
57              
58             return;
59             }
60              
61             # Check parameters to rigth values.
62             sub _check_params {
63             my $self = shift;
64              
65             # Check to output handler.
66             if (defined $self->{'output_handler'}
67             && ref $self->{'output_handler'} ne 'GLOB') {
68              
69             err 'Output handler is bad file handler.';
70             }
71              
72             return;
73             }
74              
75             # Default parameters.
76             sub _default_parameters {
77             my $self = shift;
78              
79             # CDATA callback.
80             $self->{'cdata_callback'} = undef;
81              
82             # Data callback.
83             $self->{'data_callback'} = undef;
84              
85             # Document encoding.
86             $self->{'encoding'} = 'UTF-8';
87              
88             # No simple tags.
89             # TODO not implemented.
90             $self->{'no_simple'} = [];
91              
92             # Set output handler.
93             $self->{'output_handler'} = undef;
94              
95             # Preserved tags.
96             # TODO not implemented.
97             $self->{'preserved'} = [];
98              
99             # Set indent.
100             $self->{'set_indent'} = 0;
101              
102             # Skip bad tags.
103             $self->{'skip_bad_tags'} = 0;
104              
105             # XML version.
106             $self->{'xml_version'} = '1.1';
107              
108             return;
109             }
110              
111             # Attributes.
112             sub _put_attribute {
113             my ($self, $attr, $value) = @_;
114             $self->{'printed_tags'}->[0]->setAttribute($attr, $value);
115             return;
116             }
117              
118             # Begin of tag.
119             sub _put_begin_of_tag {
120             my ($self, $tag) = @_;
121             my $begin_node = $self->{'doc'}->createElement($tag);
122             if ($self->{'first'} == 0) {
123             $self->{'doc'}->setDocumentElement($begin_node);
124             $self->{'first'} = 1;
125             } else {
126             if (! $self->{'printed_tags'}->[0]) {
127             err "Second root tag '$tag' is bad.";
128             } else {
129             $self->{'printed_tags'}->[0]->addChild($begin_node);
130             }
131             }
132             unshift @{$self->{'printed_tags'}}, $begin_node;
133             return;
134             }
135              
136             # CData.
137             sub _put_cdata {
138             my ($self, @cdata) = @_;
139             $self->_process_callback(\@cdata, 'cdata_callback');
140             my $cdata = join($EMPTY_STR, @cdata);
141             my $cdata_node = $self->{'doc'}->createCDATASection($cdata);
142             $self->{'printed_tags'}->[0]->addChild($cdata_node);
143             return;
144             }
145              
146             # Comment.
147             sub _put_comment {
148             my ($self, @comments) = @_;
149             my $comment = join($EMPTY_STR, @comments);
150              
151             # HACK LibXML has a bug.
152             if ($comment =~ m/-$/ms) {
153             $comment .= ' ';
154             }
155              
156             my $comment_node = $self->{'doc'}->createComment($comment);
157             if (! defined $self->{'printed_tags'}->[0]) {
158             $self->{'doc'}->appendChild($comment_node);
159             } else {
160             $self->{'printed_tags'}->[0]->addChild($comment_node);
161             }
162             return;
163             }
164              
165             # Data.
166             sub _put_data {
167             my ($self, @data) = @_;
168             $self->_process_callback(\@data, 'data_callback');
169             my $data = join($EMPTY_STR, @data);
170             my $data_node = $self->{'doc'}->createTextNode($data);
171             $self->{'printed_tags'}->[0]->addChild($data_node);
172             return;
173             }
174              
175             # End of tag.
176             sub _put_end_of_tag {
177             my ($self, $tag) = @_;
178             shift @{$self->{'printed_tags'}};
179             return;
180             }
181              
182             # Instruction.
183             sub _put_instruction {
184             my ($self, $target, $code) = @_;
185             my $instruction_node = $self->{'doc'}->createProcessingInstruction(
186             $target, $code,
187             );
188             if (! defined $self->{'printed_tags'}->[0]) {
189             $self->{'doc'}->appendChild($instruction_node);
190             } else {
191             $self->{'printed_tags'}->[0]->addChild($instruction_node);
192             }
193             return;
194             }
195              
196             # Raw data.
197             sub _put_raw {
198             my ($self, @raw_data) = @_;
199             return;
200             }
201              
202             1;
203              
204             __END__