File Coverage

blib/lib/Tags/Output.pm
Criterion Covered Total %
statement 140 151 92.7
branch 39 44 88.6
condition 9 12 75.0
subroutine 26 27 96.3
pod 7 7 100.0
total 221 241 91.7


line stmt bran cond sub pod time code
1             package Tags::Output;
2              
3 26     26   68848 use strict;
  26         72  
  26         661  
4 26     26   107 use warnings;
  26         40  
  26         633  
5              
6 26     26   12344 use Class::Utils qw(set_params);
  26         613069  
  26         461  
7 26     26   13633 use Encode;
  26         234163  
  26         1910  
8 26     26   181 use Error::Pure qw(err);
  26         48  
  26         5058  
9              
10             our $VERSION = 0.12;
11              
12             # Constructor.
13             sub new {
14 57     57 1 27184 my ($class, @params) = @_;
15              
16             # Create object.
17 57         141 my $self = bless {}, $class;
18              
19             # Get default parameters.
20 57         201 $self->_default_parameters;
21              
22             # Process params.
23 57         219 set_params($self, @params);
24              
25             # Check parameters to right values.
26 53         726 $self->_check_params;
27              
28             # Initialization.
29 50         137 $self->reset;
30              
31             # Object.
32 50         278 return $self;
33             }
34              
35             # Finalize Tags output.
36             sub finalize {
37 0     0 1 0 my $self = shift;
38              
39 0         0 while (@{$self->{'printed_tags'}}) {
  0         0  
40 0         0 $self->put(['e', $self->{'printed_tags'}->[0]]);
41             }
42              
43 0         0 return;
44             }
45              
46             # Flush tags in object.
47             sub flush {
48 72     72 1 454 my ($self, $reset_flag) = @_;
49              
50 72         102 my $ouf = $self->{'output_handler'};
51 72         81 my $ret;
52 72 100       146 if (ref $self->{'flush_code'} eq 'ARRAY') {
53 2         3 $ret = join $self->{'output_sep'}, @{$self->{'flush_code'}};
  2         7  
54             } else {
55 70         99 $ret = $self->{'flush_code'};
56             }
57              
58             # Output callback.
59 72         227 $self->_process_callback(\$ret, 'output_callback');
60              
61 72 100       149 if ($ouf) {
62 26     26   154 no warnings;
  26         50  
  26         29703  
63 13 50       15 print {$ouf} $ret or err 'Cannot write to output handler.';
  13         43  
64 13         167 undef $ret;
65             }
66              
67             # Reset.
68 72 50       147 if ($reset_flag) {
69 0         0 $self->reset;
70             }
71              
72             # Return string.
73 72         166 return $ret;
74             }
75              
76             # Return array of opened elements.
77             sub open_elements {
78 8     8 1 23 my $self = shift;
79              
80 8         11 return @{$self->{'printed_tags'}};
  8         31  
81             }
82              
83             # Deprecated.
84             sub open_tags {
85 4     4 1 204 my $self = shift;
86              
87 4         36 warn "Method open_tags() is deprecated";
88              
89 4         188 return $self->open_elements;
90             }
91              
92             # Put tags code.
93             sub put {
94 83     83 1 3911 my ($self, @data) = @_;
95              
96             # For every data.
97 83         160 foreach my $tags_structure_ar (@data) {
98              
99             # Bad data.
100 271 100       597 if (ref $tags_structure_ar ne 'ARRAY') {
101 1         4 err 'Bad data.';
102             }
103              
104             # Input 'Tags' item callback.
105 270 100       471 if (defined $self->{'input_tags_item_callback'}) {
106 8         12 $self->{'input_tags_item_callback'}->($tags_structure_ar)
107             }
108              
109             # Split to type and main tags structure.
110 270         339 my ($type, @tags_struct) = @{$tags_structure_ar};
  270         464  
111              
112             # Attributes.
113 270 100       837 if ($type eq 'a') {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
114 31         68 $self->_check_arguments(\@tags_struct, 1, 2);
115 31         68 $self->_put_attribute(@tags_struct);
116              
117             # Begin of tag.
118             } elsif ($type eq 'b') {
119 86         262 $self->_check_arguments(\@tags_struct, 1, 1);
120 86         202 $self->_put_begin_of_tag(@tags_struct);
121              
122             # CData.
123             } elsif ($type eq 'cd') {
124 6         18 $self->_put_cdata(@tags_struct);
125              
126             # Comment.
127             } elsif ($type eq 'c') {
128 11         28 $self->_put_comment(@tags_struct);
129              
130             # Data.
131             } elsif ($type eq 'd') {
132 36         87 $self->_put_data(@tags_struct);
133              
134             # End of tag.
135             } elsif ($type eq 'e') {
136 80         202 $self->_check_arguments(\@tags_struct, 1, 1);
137 80         185 $self->_put_end_of_tag(@tags_struct);
138              
139             # Instruction.
140             } elsif ($type eq 'i') {
141 5 50       13 if ($self->{'strict_instruction'}) {
142 5         17 $self->_check_arguments(\@tags_struct, 1, 2);
143             }
144 5         22 $self->_put_instruction(@tags_struct);
145              
146             # Raw data.
147             } elsif ($type eq 'r') {
148 13         29 $self->_put_raw(@tags_struct);
149              
150             # Other.
151             } else {
152 2 100       7 if (! $self->{'skip_bad_tags'}) {
153 1         3 err 'Bad type of data.';
154             }
155             }
156             }
157              
158             # Auto-flush.
159 77 100       192 if ($self->{'auto_flush'}) {
160 12         32 $self->flush;
161 12         21 $self->_reset_flush;
162             }
163              
164 77         143 return;
165             }
166              
167             # Reset.
168             sub reset {
169 3     3 1 5 my $self = shift;
170              
171             # Flush code.
172 3         7 $self->_reset_flush;
173              
174             # Printed tags.
175 3         4 $self->{'printed_tags'} = [];
176              
177 3         5 return;
178             }
179              
180             # Check arguments.
181             sub _check_arguments {
182 202     202   319 my ($self, $tags_struct_ar, $min_arg_num, $max_arg_num) = @_;
183              
184 202         250 my $arg_num = scalar @{$tags_struct_ar};
  202         242  
185 202 50 33     654 if ($arg_num < $min_arg_num || $arg_num > $max_arg_num) {
186             err 'Bad number of arguments.',
187 0         0 '\'Tags\' structure', join ', ', @{$tags_struct_ar};
  0         0  
188             }
189              
190 202         331 return;
191             }
192              
193             # Check parameters to rigth values.
194             sub _check_params {
195 53     53   76 my $self = shift;
196              
197             # Check to output handler.
198 53 100 100     186 if (defined $self->{'output_handler'}
199             && ref $self->{'output_handler'} ne 'GLOB') {
200              
201 1         3 err 'Output handler is bad file handler.';
202             }
203              
204             # Check auto-flush only with output handler.
205 52 100 100     174 if ($self->{'auto_flush'} && ! defined $self->{'output_handler'}) {
206 1         8 err 'Auto-flush can\'t use without output handler.';
207             }
208              
209 51         81 return;
210             }
211              
212             # Default parameters.
213             sub _default_parameters {
214 57     57   83 my $self = shift;
215              
216             # Auto-flush.
217 57         166 $self->{'auto_flush'} = 0;
218              
219             # Input 'Tags' item callback.
220 57         105 $self->{'input_tags_item_callback'} = undef;
221              
222             # Output callback.
223             $self->{'output_callback'} = sub {
224 72     72   124 my ($data_sr, $self) = @_;
225              
226 72 50       154 if (defined $self->{'output_encoding'}) {
227 0         0 ${$data_sr} = Encode::encode(
228             $self->{'output_encoding'},
229 0         0 ${$data_sr},
  0         0  
230             );
231             }
232              
233 72         93 return;
234 57         251 };
235              
236             # Output encoding.
237 57         104 $self->{'output_encoding'} = undef;
238              
239             # Set output handler.
240 57         89 $self->{'output_handler'} = undef;
241              
242             # Output separator.
243 57         107 $self->{'output_sep'} = "\n";
244              
245             # Skip bad tags.
246 57         110 $self->{'skip_bad_tags'} = 0;
247              
248             # Strict instruction.
249 57         121 $self->{'strict_instruction'} = 1;
250              
251 57         96 return;
252             }
253              
254             # Process dala callback.
255             sub _process_callback {
256 147     147   237 my ($self, $data_r, $callback_type) = @_;
257              
258             # Process data callback.
259 147 100 66     519 if (defined $self->{$callback_type}
260             && ref $self->{$callback_type} eq 'CODE') {
261              
262 135         261 $self->{$callback_type}->($data_r, $self);
263             }
264              
265 147         221 return;
266             }
267              
268             # Attributes.
269             sub _put_attribute {
270 2     2   4 my ($self, $attr, $value) = @_;
271              
272 2         3 push @{$self->{'flush_code'}}, 'Attribute';
  2         4  
273              
274 2         3 return;
275             }
276              
277             # Begin of tag.
278             sub _put_begin_of_tag {
279 2     2   5 my ($self, $tag) = @_;
280              
281 2         3 push @{$self->{'flush_code'}}, 'Begin of tag';
  2         3  
282              
283 2         3 return;
284             }
285              
286             # CData.
287             sub _put_cdata {
288 2     2   3 my ($self, @cdata) = @_;
289              
290 2         3 push @{$self->{'flush_code'}}, 'CData';
  2         4  
291              
292 2         3 return;
293             }
294              
295             # Comment.
296             sub _put_comment {
297 2     2   3 my ($self, @comments) = @_;
298              
299 2         3 push @{$self->{'flush_code'}}, 'Comment';
  2         3  
300              
301 2         5 return;
302             }
303              
304             # Data.
305             sub _put_data {
306 2     2   3 my ($self, @data) = @_;
307              
308 2         2 push @{$self->{'flush_code'}}, 'Data';
  2         5  
309              
310 2         3 return;
311             }
312              
313             # End of tag.
314             sub _put_end_of_tag {
315 2     2   4 my ($self, $tag) = @_;
316              
317 2         2 push @{$self->{'flush_code'}}, 'End of tag';
  2         5  
318              
319 2         3 return;
320             }
321              
322             # Instruction.
323             sub _put_instruction {
324 2     2   4 my ($self, $target, $code) = @_;
325              
326 2         3 push @{$self->{'flush_code'}}, 'Instruction';
  2         4  
327              
328 2         3 return;
329             }
330              
331             # Raw data.
332             sub _put_raw {
333 2     2   5 my ($self, @raw_data) = @_;
334              
335 2         1 push @{$self->{'flush_code'}}, 'Raw data';
  2         3  
336              
337 2         4 return;
338             }
339              
340             # Reset flush code.
341             sub _reset_flush {
342 3     3   5 my $self = shift;
343              
344 3         5 $self->{'flush_code'} = [];
345              
346 3         6 return;
347             }
348              
349             1;
350              
351             __END__