File Coverage

blib/lib/XML/Grammar/FictionBase/FromProto/Parser/LineIterator.pm
Criterion Covered Total %
statement 55 85 64.7
branch 4 12 33.3
condition 3 6 50.0
subroutine 15 21 71.4
pod 15 15 100.0
total 92 139 66.1


line stmt bran cond sub pod time code
1             package XML::Grammar::FictionBase::FromProto::Parser::LineIterator;
2              
3 3     3   24290 use strict;
  3         7  
  3         98  
4 3     3   15 use warnings;
  3         5  
  3         81  
5              
6 3     3   626 use MooX 'late';
  3         15085  
  3         18  
7              
8 3     3   43524 use XML::Grammar::Fiction::Err;
  3         6  
  3         2888  
9              
10             extends("XML::Grammar::Fiction::FromProto::Parser");
11              
12             has "_curr_line_idx" => (isa => "Int", is => "rw", reader => "line_idx",);
13             has "_lines" => (isa => "ArrayRef", is => "rw");
14              
15              
16             our $VERSION = '0.14.10';
17              
18              
19             sub setup_text
20             {
21 7     7 1 2142 my ($self, $text) = @_;
22              
23             # We include the lines trailing newlines for safety.
24 7         316 $self->_lines([split(/^/, $text)]);
25              
26 7         2606 $self->_curr_line_idx(0);
27              
28 7         2715 ${$self->curr_line_ref()} =~ m{\A}g;
  7         46  
29              
30 7         261 return;
31             }
32              
33              
34             sub curr_line_ref
35             {
36 49     49 1 2028 my $self = shift;
37              
38 49         1263 return \($self->_lines()->[$self->_curr_line_idx()]);
39             }
40              
41              
42             sub curr_pos
43             {
44 8     8 1 413 my $self = shift;
45              
46 8         14 return pos(${$self->curr_line_ref()});
  8         24  
47             }
48              
49              
50             sub at_line_start
51             {
52 3     3 1 767 my $self = shift;
53              
54 3         17 return ($self->curr_pos == 0);
55             }
56              
57              
58             sub curr_line_and_pos
59             {
60 1     1 1 329 my $self = shift;
61              
62 1         3 return ($self->curr_line_ref(), $self->curr_pos());
63             }
64              
65              
66             sub curr_line_copy
67             {
68 0     0 1 0 my $self = shift;
69              
70 0         0 my $l = ${$self->curr_line_ref()} . "";
  0         0  
71              
72 0         0 pos($l) = $self->curr_pos();
73              
74 0         0 return \$l;
75             }
76              
77              
78             sub next_line_ref
79             {
80 4     4 1 18 my $self = shift;
81              
82 4         86 $self->_curr_line_idx($self->_curr_line_idx()+1);
83              
84 4 50       118 if (! $self->eof() ) {
85 4         118 pos(${$self->curr_line_ref()}) = 0;
  4         11  
86             }
87              
88 4         121 return $self->curr_line_ref();
89             }
90              
91              
92             # Skip the whitespace.
93             sub skip_space
94             {
95 0     0 1 0 my $self = shift;
96              
97 0         0 $self->consume(qr{[ \t]});
98              
99 0         0 return;
100             }
101              
102              
103             sub skip_multiline_space
104             {
105 0     0 1 0 my $self = shift;
106              
107 0 0       0 if (${$self->curr_line_ref()} =~ m{\G.*?\S})
  0         0  
108             {
109 0         0 return;
110             }
111              
112 0         0 $self->consume(qr{\s});
113              
114 0         0 return;
115             }
116              
117              
118             sub curr_line_continues_with
119             {
120 0     0 1 0 my ($self, $re) = @_;
121              
122 0         0 my $l = $self->curr_line_ref();
123              
124 0         0 return $$l =~ m{\G$re}cg;
125             }
126              
127              
128             sub line_num
129             {
130 2     2 1 6 my $self = shift;
131              
132 2         62 return $self->_curr_line_idx()+1;
133             }
134              
135              
136             sub _next_line_ref_wo_leading_space
137             {
138 4     4   10 my $self = shift;
139              
140 4         72 my $l = $self->next_line_ref();
141              
142 4 50       124 if (defined($$l))
143             {
144 4         25 $self->_check_if_line_starts_with_whitespace()
145             }
146              
147 4         166 return $l;
148             }
149              
150             sub consume
151             {
152 4     4 1 52 my ($self, $match_regex) = @_;
153              
154 4         10 my $return_value = "";
155 4         17 my $l = $self->curr_line_ref();
156              
157 4   66     239 while (defined($$l) && ($$l =~ m[\G(${match_regex}*)\z]cgms))
158             {
159 4         11 $return_value .= $$l;
160             }
161             continue
162             {
163 4         35 $l = $self->_next_line_ref_wo_leading_space();
164             }
165              
166 4 50 33     88 if (defined($$l) && ($$l =~ m[\G(${match_regex}*)]cg))
167             {
168 4         15 $return_value .= $1;
169             }
170              
171 4         18 return $return_value;
172             }
173              
174              
175             # TODO : copied and pasted from _consume - abstract
176             sub consume_up_to
177             {
178 0     0 1 0 my ($self, $match_regex) = @_;
179              
180 0         0 my $return_value = "";
181 0         0 my $l = $self->curr_line_ref();
182              
183             LINE_LOOP:
184 0         0 while (defined($$l))
185             {
186             # We assign to a scalar for scalar context, but we're not making
187             # use of the variable.
188 0         0 my $verdict = ($$l =~ m[\G(.*?)((?:${match_regex})|\z)]cgms);
189 0         0 $return_value .= $1;
190              
191             # Find if it matched the regex.
192 0 0       0 if (length($2) > 0)
193             {
194 0         0 last LINE_LOOP;
195             }
196             }
197             continue
198             {
199 0         0 $l = $self->_next_line_ref_wo_leading_space();
200             }
201              
202 0         0 return $return_value;
203             }
204              
205              
206             sub throw_text_error
207             {
208 0     0 1 0 my ($self, $error_class, $text) = @_;
209              
210 0         0 return $error_class->throw(
211             error => $text,
212             line => $self->line_num(),
213             );
214             }
215              
216              
217             sub _check_if_line_starts_with_whitespace
218             {
219 4     4   8 my $self = shift;
220              
221 4 50       6 if (${$self->curr_line_ref()} =~ m{\A[ \t]})
  4         9  
222             {
223 0         0 $self->throw_text_error(
224             'XML::Grammar::Fiction::Err::Parse::LeadingSpace',
225             "Leading space detected in the text.",
226             );
227             }
228             }
229              
230              
231             sub eof
232             {
233 6     6 1 9 my $self = shift;
234              
235 6         10 return (!defined( ${ $self->curr_line_ref() } ));
  6         15  
236             }
237              
238              
239             1;
240              
241             __END__