File Coverage

blib/lib/Text/ZPL/Stream.pm
Criterion Covered Total %
statement 56 57 98.2
branch 16 18 88.8
condition 5 5 100.0
subroutine 13 13 100.0
pod 5 5 100.0
total 95 98 96.9


line stmt bran cond sub pod time code
1             package Text::ZPL::Stream;
2             $Text::ZPL::Stream::VERSION = '0.002002';
3 1     1   18231 use strict; use warnings FATAL => 'all';
  1     1   3  
  1         35  
  1         5  
  1         2  
  1         32  
4 1     1   7 use Carp;
  1         2  
  1         89  
5              
6 1     1   441 use Text::ZPL ();
  1         3  
  1         756  
7              
8              
9              
10             sub BUF_MAX () { 0 }
11             sub BUF () { 1 }
12             sub MAYBE_EXTRA_EOL () { 2 }
13             sub ROOT () { 3 }
14             sub CURRENT () { 4 }
15             sub LEVEL () { 5 }
16             sub TREE () { 6 }
17              
18             sub new {
19             # max_buffer_size =>
20             # string =>
21 6     6 1 4500 my ($class, %param) = @_;
22 6         8 my $root = +{};
23 6   100     44 bless [
24             ($param{max_buffer_size} || 0), # BUF_MAX
25             '', # BUF
26             0, # MAYBE_EXTRA_EOL
27             $root, # ROOT
28             $root, # CURRENT
29             0, # LEVEL
30             [], # TREE
31             ], $class
32             }
33              
34             sub max_buffer_size {
35 1145 50   1145 1 2689 defined $_[0]->[BUF_MAX] ?
36             $_[0]->[BUF_MAX]
37             : ($_[0]->[BUF_MAX] = 0)
38             }
39              
40              
41             sub _maybe_extra_eol {
42 1196     1196   1811 $_[0]->[MAYBE_EXTRA_EOL]
43             }
44              
45             sub _maybe_extra_eol_off {
46 2     2   4 $_[0]->[MAYBE_EXTRA_EOL] = 0
47             }
48              
49             sub _maybe_extra_eol_on {
50 2     2   4 $_[0]->[MAYBE_EXTRA_EOL] = 1
51             }
52              
53              
54             sub _parse_current_buffer {
55 68     68   57 my ($self) = @_;
56 68         75 my $line = $self->[BUF];
57              
58 68 100       105 unless ( Text::ZPL::_decode_prepare_line($line) ) {
59             # skippable:
60 12         12 $self->[BUF] = '';
61             return
62 12         12 }
63              
64             Text::ZPL::_decode_handle_level(
65 56         126 0,
66             $line,
67             $self->[ROOT],
68             $self->[CURRENT],
69             $self->[LEVEL],
70             $self->[TREE],
71             );
72            
73 55 100       142 if ( (my $sep_pos = index($line, '=')) > 0 ) {
74 38         65 my ($k, $v) = Text::ZPL::_decode_parse_kv(
75             0, $line, $self->[LEVEL], $sep_pos
76             );
77 38         69 Text::ZPL::_decode_add_kv(
78             0, $self->[CURRENT], $k, $v
79             );
80              
81 38         36 $self->[BUF] = '';
82             return
83 38         50 }
84              
85 17         16 my $re = $Text::ZPL::ValidName;
86 17 50       141 if (my ($subsect) = $line =~ /^(?:\s+)?($re)(?:\s+?#.*)?$/) {
87 17         33 Text::ZPL::_decode_add_subsection(
88             0, $self->[CURRENT], $subsect, $self->[TREE]
89             );
90              
91 17         19 $self->[BUF] = '';
92             return
93 17         23 }
94              
95 0         0 confess "Parse failed in ZPL stream; bad input '$line'"
96             }
97              
98              
99 5     5 1 34 sub get { shift->[ROOT] }
100              
101 1     1 1 5 sub get_buffer { shift->[BUF] }
102              
103              
104             sub push {
105 291     291 1 829 my $self = shift;
106 291         592 my @chrs = split '', join '', @_;
107              
108 291         234 my $handled = 0;
109              
110 291         241 CHAR: for my $chr (@chrs) {
111 1198 100       1480 if ($chr eq "\015") {
112             # got \r, maybe an unneeded \n coming up, _maybe_extra_eol_on
113 2         5 $self->_maybe_extra_eol_on;
114 2         2 $self->_parse_current_buffer;
115 2         1 ++$handled;
116             next CHAR
117 2         4 }
118 1196 100       1362 if ($chr eq "\012") {
119 67 100       70 if ($self->_maybe_extra_eol) {
120 1         3 $self->_maybe_extra_eol_off;
121             } else {
122 66         71 $self->_parse_current_buffer;
123 65         52 ++$handled;
124             }
125             next CHAR
126 66         93 }
127              
128 1129 100       1131 $self->_maybe_extra_eol_off if $self->_maybe_extra_eol;
129              
130 1129 100 100     1126 confess "Exceeded maximum buffer size for ZPL stream"
131             if $self->max_buffer_size
132             and length($self->[BUF]) >= $self->max_buffer_size;
133              
134 1128         1085 $self->[BUF] .= $chr
135             }
136              
137             $handled
138 289         440 }
139              
140              
141             1;
142              
143             =pod
144              
145             =for Pod::Coverage BUF(_MAX)? MAYBE_EXTRA_EOL ROOT CURRENT LEVEL TREE
146              
147             =head1 NAME
148              
149             Text::ZPL::Stream - Streaming ZPL decoder
150              
151             =head1 SYNOPSIS
152              
153             use Text::ZPL::Stream;
154              
155             my $stream = Text::ZPL::Stream->new;
156              
157             if ( $stream->push($zpl_chrs) ) {
158             # Parsed at least one complete line:
159             my $ref = $stream->get;
160             # ...
161             }
162              
163             # Or in a loop:
164             while ( defined(my $zpl_chrs = magically_get_some_zpl) ) {
165             $stream->push($zpl_chrs);
166             }
167             my $ref = $stream->get;
168             # ...
169              
170             =head1 DESCRIPTION
171              
172             A streaming decoder for C files using L.
173              
174             See the L documentation for more on C and parsing-related
175             details.
176              
177             =head2 new
178              
179             my $stream = Text::ZPL::Stream->new(
180             # Optional:
181             max_buffer_size => 512,
182             );
183              
184             Constructs an object representing a new C stream.
185              
186             Accepts the following options:
187              
188             =over
189              
190             =item max_buffer_size
191              
192             The maximum line length allowed in buffers before an exception is thrown.
193              
194             Defaults to 0 (unlimited).
195              
196             =back
197              
198             =head2 push
199              
200             $stream->push(@chars);
201             $stream->push($string);
202              
203             Takes characters (individually or as strings) and collects until an
204             end-of-line marker (C<\r>, C<\n>, or C<\r\n>) is encountered, at which point a
205             parse is called and the reference returned by L is altered
206             appropriately.
207              
208             An exception is thrown if parsing fails, or if L is reached
209             -- if you're unsure of your incoming data, you may want to wrap C calls
210             with L or similar.
211              
212             Returns the number of complete lines parsed, which can be useful as an
213             indicator that L ought be called:
214              
215             if ( $stream->push($zpl) ) {
216             # Parsed at least one complete line:
217             my $ref = $stream->get;
218             ...
219             }
220              
221             =head2 get
222              
223             my $ref = $stream->get;
224              
225             Returns the C reference to the decoded structure.
226              
227             B<< This is the actual reference in use by the decoder, not a copy! >>
228             Altering the structure of the C may have unintended consequences, in
229             which case you may want to make use of L to create a safe
230             copy.
231              
232             =head2 get_buffer
233              
234             Returns a string containing the current character buffer (that is, any
235             incomplete line).
236              
237             =head1 AUTHOR
238              
239             Jon Portnoy
240              
241             =cut