File Coverage

blib/lib/Marpa/R2/HTML/Callback.pm
Criterion Covered Total %
statement 194 225 86.2
branch 71 108 65.7
condition 6 8 75.0
subroutine 23 25 92.0
pod 13 15 86.6
total 307 381 80.5


line stmt bran cond sub pod time code
1             # Copyright 2022 Jeffrey Kegler
2             # This file is part of Marpa::R2. Marpa::R2 is free software: you can
3             # redistribute it and/or modify it under the terms of the GNU Lesser
4             # General Public License as published by the Free Software Foundation,
5             # either version 3 of the License, or (at your option) any later version.
6             #
7             # Marpa::R2 is distributed in the hope that it will be useful,
8             # but WITHOUT ANY WARRANTY; without even the implied warranty of
9             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
10             # Lesser General Public License for more details.
11             #
12             # You should have received a copy of the GNU Lesser
13             # General Public License along with Marpa::R2. If not, see
14             # http://www.gnu.org/licenses/.
15              
16 8     8   178 use 5.010001;
  8         33  
17 8     8   64 use warnings;
  8         18  
  8         219  
18 8     8   44 use strict;
  8         39  
  8         301  
19              
20             package Marpa::R2::HTML::Callback;
21              
22 8     8   52 use vars qw( $VERSION $STRING_VERSION );
  8         21  
  8         633  
23             $VERSION = '13.001_000';
24             $STRING_VERSION = $VERSION;
25             ## use critic (BuiltinFunctions::ProhibitStringyEval)
26             $VERSION = eval $VERSION;
27             ## no critic
28              
29             package Marpa::R2::HTML::Internal::Callback;
30              
31 8     8   77 use English qw( -no_match_vars );
  8         28  
  8         54  
32              
33             sub Marpa::R2::HTML::start_tag {
34              
35 9     9 1 40 my $parse_instance = $Marpa::R2::HTML::Internal::PARSE_INSTANCE;
36 9 50       28 Marpa::R2::exception(q{Attempt to fetch start tag outside of a parse})
37             if not defined $parse_instance;
38 9 100       27 return undef if not defined $Marpa::R2::HTML::Internal::START_TAG_IX;
39              
40             return ${
41 3         6 Marpa::R2::HTML::Internal::token_range_to_original(
  3         9  
42             $parse_instance,
43             $Marpa::R2::HTML::Internal::START_TAG_IX,
44             $Marpa::R2::HTML::Internal::START_TAG_IX
45             )
46             };
47              
48             } ## end sub Marpa::R2::HTML::start_tag
49              
50             # We do not always need the end tag, so it is found lazily,
51             # unlike the start tag which is determined eagerly.
52             # Return the end token ix, or undef if none.
53             # As a side effect set $Marpa::R2::HTML::Internal::END_TAG_IX_REF
54             # to be a reference to that result
55             sub end_tag_set {
56              
57 14     14   24 my $parse_instance = $Marpa::R2::HTML::Internal::PARSE_INSTANCE;
58              
59             # be idempotent -- but this is probably unnecessary
60 14 50       30 return ${$Marpa::R2::HTML::Internal::END_TAG_IX_REF}
  0         0  
61             if defined $Marpa::R2::HTML::Internal::END_TAG_IX_REF;
62              
63             # default to no end tag
64 14         26 $Marpa::R2::HTML::Internal::END_TAG_IX_REF = \undef;
65              
66             # return undef if the current rule is not an element
67 14 50       26 return undef if not $Marpa::R2::HTML::Internal::ELEMENT;
68              
69 14         23 my $arg_n = $Marpa::R2::HTML::Internal::ARG_N;
70 14         26 my $end_tag_tdesc_item = $Marpa::R2::HTML::Internal::STACK->[$arg_n];
71 14         24 my $end_tag_type = $end_tag_tdesc_item->[0];
72              
73 14 50       27 return undef if not defined $end_tag_type;
74 14 100       45 return undef if $end_tag_type ne 'PHYSICAL_TOKEN';
75              
76 6         13 my $end_tag_token_ix =
77             $end_tag_tdesc_item->[Marpa::R2::HTML::Internal::TDesc::END_TOKEN];
78 6         10 my $tokens = $parse_instance->{tokens};
79 6         11 my $html_token = $tokens->[$end_tag_token_ix];
80 6         8 my $html_token_type =
81             $html_token->[Marpa::R2::HTML::Internal::Token::TYPE];
82 6 50       15 return undef if $html_token_type ne 'E';
83 6         8 $Marpa::R2::HTML::Internal::END_TAG_IX_REF = \$end_tag_token_ix;
84 6         12 return $end_tag_token_ix;
85              
86             } ## end sub end_tag_set
87              
88             sub Marpa::R2::HTML::end_tag {
89              
90 9     9 1 19 my $parse_instance = $Marpa::R2::HTML::Internal::PARSE_INSTANCE;
91 9 50       21 Marpa::R2::exception(q{Attempt to fetch an end tag outside of a parse})
92             if not defined $parse_instance;
93 9 50       22 defined $Marpa::R2::HTML::Internal::END_TAG_IX_REF or end_tag_set();
94 9         16 my $end_tag_token_ix = ${$Marpa::R2::HTML::Internal::END_TAG_IX_REF};
  9         14  
95 9 100       28 return undef if not defined $end_tag_token_ix;
96              
97             return ${
98 1         2 Marpa::R2::HTML::Internal::token_range_to_original( $parse_instance,
  1         4  
99             $end_tag_token_ix, $end_tag_token_ix, )
100             };
101             } ## end sub Marpa::R2::HTML::end_tag
102              
103             sub Marpa::R2::HTML::contents {
104              
105 14     14 1 69 my $self = $Marpa::R2::HTML::Internal::PARSE_INSTANCE;
106 14 50       32 Marpa::R2::exception(
107             q{Attempt to fetch an element contents outside of a parse})
108             if not defined $self;
109              
110 14 50       31 return undef if not $Marpa::R2::HTML::Internal::ELEMENT;
111              
112 14 100       34 my $contents_start_ix =
113             defined $Marpa::R2::HTML::Internal::START_TAG_IX
114             ? $Marpa::R2::HTML::Internal::START_TAG_IX + 1
115             : $Marpa::R2::HTML::Internal::START_HTML_TOKEN_IX;
116 14 50       45 defined $Marpa::R2::HTML::Internal::END_TAG_IX_REF or end_tag_set();
117 14         17 my $end_tag_token_ix = ${$Marpa::R2::HTML::Internal::END_TAG_IX_REF};
  14         24  
118 14 100       34 my $contents_end_ix =
119             defined $end_tag_token_ix
120             ? $end_tag_token_ix + 1
121             : $Marpa::R2::HTML::Internal::END_HTML_TOKEN_IX;
122              
123             # An element does not necessarily have any tokens
124 14 100       29 return q{} if not defined $contents_start_ix;
125              
126             my $content_values = [
127 13         29 @{$Marpa::R2::HTML::Internal::STACK}[
  13         30  
128             ( $Marpa::R2::HTML::Internal::ARG_0 + 1 )
129             .. ( $Marpa::R2::HTML::Internal::ARG_N - 1 )
130             ]
131             ];
132             return ${
133 13         23 Marpa::R2::HTML::Internal::range_and_values_to_literal( $self,
  13         36  
134             $contents_start_ix, $contents_end_ix, $content_values )
135             };
136              
137             } ## end sub Marpa::R2::HTML::contents
138              
139             sub Marpa::R2::HTML::values {
140              
141 19     19 1 122 my $parse_instance = $Marpa::R2::HTML::Internal::PARSE_INSTANCE;
142 19 50       46 Marpa::R2::exception(q{Attempt to examine rule while not in a parse})
143             if not defined $parse_instance;
144              
145 19         33 my @flat_tdesc_list = ();
146             STACK_IX:
147 19         49 for my $stack_ix (
148             $Marpa::R2::HTML::Internal::ARG_0 .. $Marpa::R2::HTML::Internal::ARG_N
149             )
150             {
151 61         98 my $tdesc_item = $Marpa::R2::HTML::Internal::STACK->[$stack_ix];
152 61         86 my $type = $tdesc_item->[0];
153 61 50       114 next STACK_IX if not defined $type;
154 61 100       105 if ( $type eq 'VALUES' ) {
155             push @flat_tdesc_list,
156 8         15 @{ $tdesc_item->[Marpa::R2::HTML::Internal::TDesc::VALUE] };
  8         21  
157 8         19 next STACK_IX;
158             }
159 53 100       121 if ( $type eq 'VALUED_SPAN' ) {
160 10         21 push @flat_tdesc_list, $tdesc_item;
161 10         19 next STACK_IX;
162             }
163             } ## end STACK_IX: for my $stack_ix ( $Marpa::R2::HTML::Internal::ARG_0 ...)
164              
165 42         166 return [ grep {defined}
166 19         60 map { $_->[Marpa::R2::HTML::Internal::TDesc::VALUE] }
  42         87  
167             @flat_tdesc_list ];
168             } ## end sub Marpa::R2::HTML::values
169              
170             sub Marpa::R2::HTML::descendants {
171              
172 426     426 1 4575 my ($argspecs) = @_;
173              
174 426         606 my $parse_instance = $Marpa::R2::HTML::Internal::PARSE_INSTANCE;
175 426 50       885 Marpa::R2::exception(q{Attempt to fetch an end tag outside of a parse})
176             if not defined $parse_instance;
177 426         700 my $tokens = $parse_instance->{tokens};
178              
179 426         613 my @argspecs = ();
180 426         1295 for my $argspec ( split /,/xms, $argspecs ) {
181 1278         3853 $argspec =~ s/\A \s* //xms;
182 1278         4107 $argspec =~ s/ \s* \z//xms;
183 1278         2526 push @argspecs, $argspec;
184             }
185              
186 426         741 my @flat_tdesc_list = ();
187             STACK_IX:
188 426         974 for my $stack_ix (
189             $Marpa::R2::HTML::Internal::ARG_0 .. $Marpa::R2::HTML::Internal::ARG_N
190             )
191             {
192 1278         1925 my $tdesc_item = $Marpa::R2::HTML::Internal::STACK->[$stack_ix];
193              
194 1278         1792 my $type = $tdesc_item->[0];
195 1278 100       2178 next STACK_IX if not defined $type;
196 1270 100       2239 next STACK_IX if $type eq 'ZERO_SPAN';
197 1177 100       2344 next STACK_IX if $type eq 'RUBY_SLIPPERS_TOKEN';
198 534 100       912 if ( $type eq 'VALUES' ) {
199             push @flat_tdesc_list,
200 114         172 @{ $tdesc_item->[Marpa::R2::HTML::Internal::TDesc::VALUE] };
  114         253  
201 114         221 next STACK_IX;
202             }
203 420         683 push @flat_tdesc_list, $tdesc_item;
204             } ## end STACK_IX: for my $stack_ix ( $Marpa::R2::HTML::Internal::ARG_0 ...)
205              
206 426         593 my $next_token_ix = $Marpa::R2::HTML::Internal::START_HTML_TOKEN_IX;
207 426         563 my $final_token_ix = $Marpa::R2::HTML::Internal::END_HTML_TOKEN_IX;
208              
209 426         627 my @descendants = ();
210 426         784 TDESC_ITEM: for my $tdesc_item (@flat_tdesc_list) {
211             my ( $tdesc_item_type, $next_explicit_token_ix,
212             $furthest_explicit_token_ix )
213 661         873 = @{$tdesc_item};
  661         1288  
214              
215 661 100       1227 if (not defined $next_explicit_token_ix) {
216             ## An element can contain no HTML tokens -- it may contain
217             ## only Ruby Slippers tokens.
218             ## Treat this as a special case.
219 82 50 33     321 if ( $tdesc_item_type eq 'VALUED_SPAN'
220             and defined $tdesc_item->[Marpa::R2::HTML::Internal::TDesc::VALUE]
221             )
222             {
223 82         165 push @descendants, [ 1, $tdesc_item ];
224             }
225 82         156 next TDESC_ITEM;
226             }
227              
228             push @descendants,
229 579         1022 map { [ 0, $_ ] }
  0         0  
230             ( $next_token_ix .. $next_explicit_token_ix - 1 );
231 579 100 100     1688 if ( $tdesc_item_type eq 'VALUED_SPAN'
232             and defined $tdesc_item->[Marpa::R2::HTML::Internal::TDesc::VALUE]
233             )
234             {
235 367         706 push @descendants, [ 1, $tdesc_item ];
236 367         525 $next_token_ix = $furthest_explicit_token_ix + 1;
237 367         669 next TDESC_ITEM;
238             } ## end if ( $tdesc_item_type eq 'VALUED_SPAN' and defined ...)
239             push @descendants,
240 212         384 map { [ 0, $_ ] }
  212         537  
241             ( $next_explicit_token_ix .. $furthest_explicit_token_ix );
242 212         396 $next_token_ix = $furthest_explicit_token_ix + 1;
243             } ## end TDESC_ITEM: for my $tdesc_item (@flat_tdesc_list)
244              
245 426         644 my @results;
246 426         688 DESCENDANT: for my $descendant (@descendants) {
247 661         946 my @per_descendant_results = ();
248 661         833 my ( $is_valued, $data ) = @{$descendant};
  661         1088  
249 661         1253 ARGSPEC: for my $argspec_ix ( 0 .. $#argspecs ) {
250             ## Work with a copy, so we can change it
251 1983         2922 my $argspec = $argspecs[$argspec_ix];
252 1983         2554 my $deref = 1;
253 1983 50       3964 if ( $argspec =~ s/_ref\z//xms ) {
254 0         0 $deref = 0;
255             }
256 1983 100       3542 if ( $argspec eq 'literal' ) {
257 661 100       1173 if ($is_valued) {
258 449         996 push @per_descendant_results,
259             q{}
260             . $data->[Marpa::R2::HTML::Internal::TDesc::VALUE];
261 449         781 next ARGSPEC;
262             } ## end if ($is_valued)
263 212         297 $argspec = 'original';
264             ## FALL THROUGH
265             } ## end if ( $argspec eq 'literal' )
266 1534 50       2692 if ( $argspec eq 'value' ) {
267 0 0       0 my $value =
268             $is_valued
269             ? $data->[Marpa::R2::HTML::Internal::TDesc::VALUE]
270             : undef;
271              
272 0         0 push @per_descendant_results, $value;
273 0         0 next ARGSPEC;
274             } ## end if ( $argspec eq 'value' )
275 1534 100       2502 if ( $argspec eq 'original' ) {
276             my ( $start_ix, $end_ix ) =
277             $is_valued
278             ? (
279 212 50       521 @{$data}[
  0         0  
280             Marpa::R2::HTML::Internal::TDesc::START_TOKEN,
281             Marpa::R2::HTML::Internal::TDesc::END_TOKEN
282             ]
283             )
284             : ( $data, $data );
285 212         495 my $result =
286             Marpa::R2::HTML::Internal::token_range_to_original(
287             $parse_instance, $start_ix, $end_ix );
288 212 50       457 $result = ${$result} if $deref;
  212         377  
289 212         370 push @per_descendant_results, $result;
290 212         414 next ARGSPEC;
291             } ## end if ( $argspec eq 'original' )
292 1322 100       2248 if ( $argspec eq 'token_type' ) {
293 661 100       1139 if ($is_valued) {
294 449         764 push @per_descendant_results, undef;
295 449         739 next ARGSPEC;
296             }
297 212         279 my $token_ix = $data;
298 212         339 my $html_token = $tokens->[$token_ix];
299 212         422 push @per_descendant_results,
300             $html_token->[Marpa::R2::HTML::Internal::Token::TYPE];
301 212         382 next ARGSPEC;
302             } ## end if ( $argspec eq 'token_type' )
303 661 50       1259 if ( $argspec eq 'element' ) {
304 661 100       1210 if ( not $is_valued ) {
305 212         327 push @per_descendant_results, undef;
306 212         411 next ARGSPEC;
307             }
308 449         690 my $rule_id =
309             $data->[Marpa::R2::HTML::Internal::TDesc::RULE_ID];
310             my $action =
311 449         767 $parse_instance->{action_by_rule_id}->[$rule_id];
312 449 100       857 if ( not defined $action ) {
313 293         409 push @per_descendant_results, undef;
314 293         525 next ARGSPEC;
315             }
316 156 50       374 if ( ( index $action, 'ELE_' ) != 0 ) {
317 0         0 push @per_descendant_results, undef;
318 0         0 next ARGSPEC;
319             }
320 156         318 push @per_descendant_results, ( substr $action, 4 );
321 156         272 next ARGSPEC;
322             } ## end if ( $argspec eq 'element' )
323 0 0       0 if ( $argspec eq 'pseudoclass' ) {
324             ## This argspec needs to be better defined/implemented
325             ## As of VERSION 2.021_000 it has been removed
326             ## from the documentation.
327 0 0       0 if ( not $is_valued ) {
328 0         0 push @per_descendant_results, undef;
329 0         0 next ARGSPEC;
330             }
331 0         0 my $rule_id =
332             $data->[Marpa::R2::HTML::Internal::TDesc::RULE_ID];
333             my $action =
334 0         0 $parse_instance->{action_by_rule_id}->[$rule_id];
335 0 0       0 if ( not defined $action ) {
336 0         0 push @per_descendant_results, undef;
337 0         0 next ARGSPEC;
338             }
339 0 0       0 if ( ( index $action, 'SPE_' ) != 0 ) {
340 0         0 push @per_descendant_results, undef;
341 0         0 next ARGSPEC;
342             }
343 0         0 push @per_descendant_results, ( substr $action, 4 );
344 0         0 push @per_descendant_results, $action;
345 0         0 next ARGSPEC;
346             } ## end if ( $argspec eq 'pseudoclass' )
347 0         0 die "Unimplemented argspec: $argspec";
348              
349             } ## end ARGSPEC: for my $argspec_ix ( 0 .. $#argspecs )
350 661         1395 push @results, \@per_descendant_results;
351             } ## end CHILD: for my $child (@children)
352              
353 426         1451 return \@results;
354             } ## end sub Marpa::R2::HTML::descendants
355              
356             sub Marpa::R2::HTML::attributes {
357 426   100 426 1 2539 return $Marpa::R2::HTML::Internal::ATTRIBUTES // {};
358             } ## end sub Marpa::R2::HTML::attributes
359              
360             # This assumes that a start token, if there is one
361             # with attributes, is the first token
362             sub create_fetch_attribute_closure {
363 24     24   52 my ($attribute) = @_;
364             return sub {
365 7     7   24 my $attributes = $Marpa::R2::HTML::Internal::ATTRIBUTES;
366 7 100       29 return undef if not defined $attributes;
367 4         16 return $attributes->{$attribute};
368 24         80 };
369             } ## end sub create_fetch_attribute_closure
370              
371 8     8   17424 no strict 'refs';
  8         20  
  8         678  
372             *{'Marpa::R2::HTML::id'} = create_fetch_attribute_closure('id');
373             *{'Marpa::R2::HTML::class'} = create_fetch_attribute_closure('class');
374             *{'Marpa::R2::HTML::title'} = create_fetch_attribute_closure('title');
375 8     8   60 use strict;
  8         19  
  8         4247  
376              
377             package Marpa::R2::HTML::Internal::Callback;
378              
379             sub Marpa::R2::HTML::tagname {
380 442     442 1 1896 return $Marpa::R2::HTML::Internal::ELEMENT;
381             }
382              
383             sub Marpa::R2::HTML::is_empty_element {
384 4 50   4 1 22 return undef if not defined $Marpa::R2::HTML::Internal::ELEMENT;
385 4         7 my $self = $Marpa::R2::HTML::Internal::PARSE_INSTANCE;
386 4         9 return $self->{is_empty_element}->{$Marpa::R2::HTML::Internal::ELEMENT};
387             }
388              
389             sub Marpa::R2::HTML::species {
390 0     0 0 0 return $Marpa::R2::HTML::Internal::SPECIES;
391             }
392              
393             sub Marpa::R2::HTML::literal_ref {
394              
395 105     105 1 176 my $self = $Marpa::R2::HTML::Internal::PARSE_INSTANCE;
396 105 50       234 Marpa::R2::exception(
397             q{Attempt to fetch an element contents outside of a parse})
398             if not defined $self;
399              
400 105         153 my $contents_start_ix = $Marpa::R2::HTML::Internal::START_HTML_TOKEN_IX;
401              
402             # A rule does not necessarily have any tokens
403 105 50       198 return \q{} if not defined $contents_start_ix;
404              
405 105         147 my $contents_end_ix = $Marpa::R2::HTML::Internal::END_HTML_TOKEN_IX;
406              
407             my $content_values = [
408 105         213 @{$Marpa::R2::HTML::Internal::STACK}[
  105         293  
409             ($Marpa::R2::HTML::Internal::ARG_0)
410             .. ($Marpa::R2::HTML::Internal::ARG_N)
411             ]
412             ];
413 105         350 return Marpa::R2::HTML::Internal::range_and_values_to_literal( $self,
414             $contents_start_ix, $contents_end_ix, $content_values );
415              
416             } ## end sub Marpa::R2::HTML::literal_ref
417              
418             sub Marpa::R2::HTML::literal {
419 105     105 1 377 return ${Marpa::R2::HTML::literal_ref()};
  105         195  
420             } ## end sub Marpa::R2::HTML::literal
421              
422             sub Marpa::R2::HTML::offset {
423 7     7 1 27 my $self = $Marpa::R2::HTML::Internal::PARSE_INSTANCE;
424 7         9 my $start_token_ix = $Marpa::R2::HTML::Internal::START_HTML_TOKEN_IX;
425 7 100       15 return undef if not defined $start_token_ix;
426 6         12 my $tokens = $self->{tokens};
427 6         13 return $tokens->[$start_token_ix]
428             ->[Marpa::R2::HTML::Internal::Token::START_OFFSET];
429             } ## end sub Marpa::R2::HTML::offset
430              
431             sub Marpa::R2::HTML::token_type {
432 0     0 1 0 my $self = $Marpa::R2::HTML::Internal::PARSE_INSTANCE;
433 0         0 my $start_token_ix = $Marpa::R2::HTML::Internal::START_HTML_TOKEN_IX;
434 0 0       0 return undef if not defined $start_token_ix;
435 0         0 my $tokens = $self->{tokens};
436 0         0 return $tokens->[$start_token_ix]
437             ->[Marpa::R2::HTML::Internal::Token::TYPE];
438             } ## end sub Marpa::R2::HTML::token_type
439              
440             sub Marpa::R2::HTML::original_ref {
441              
442 2     2 0 4 my $self = $Marpa::R2::HTML::Internal::PARSE_INSTANCE;
443 2 50       6 Marpa::R2::exception(q{Attempt to look at a rule while not in a parse})
444             if not defined $self;
445              
446 2         5 my $start_token_ix = $Marpa::R2::HTML::Internal::START_HTML_TOKEN_IX;
447              
448             # An rule does not necessarily have any HTML tokens
449 2 50       5 return q{} if not defined $start_token_ix;
450              
451 2         8 return Marpa::R2::HTML::Internal::token_range_to_original( $self,
452             $start_token_ix, $Marpa::R2::HTML::Internal::END_HTML_TOKEN_IX );
453              
454             } ## end sub Marpa::R2::HTML::original_ref
455              
456             sub Marpa::R2::HTML::original {
457 2     2 1 13 return ${Marpa::R2::HTML::original_ref()};
  2         8  
458             }
459              
460             1;
461              
462             # vim: set expandtab shiftwidth=4: