File Coverage

lib/Wiki/JSON/Parser.pm
Criterion Covered Total %
statement 760 818 92.9
branch 331 384 86.2
condition 31 39 79.4
subroutine 65 67 97.0
pod 0 1 0.0
total 1187 1309 90.6


line stmt bran cond sub pod time code
1             package Wiki::JSON::Parser;
2              
3 8     8   131 use v5.16.3;
  8         29  
4              
5 8     8   47 use strict;
  8         15  
  8         198  
6 8     8   39 use warnings;
  8         13  
  8         416  
7              
8 8     8   47 use Moo;
  8         15  
  8         58  
9 8     8   3916 use Data::Dumper;
  8         15  
  8         489  
10 8     8   44 use Const::Fast;
  8         15  
  8         90  
11              
12             const my $MAX_HX_SIZE => 6;
13             const my $EXTRA_CHARACTERS_BOLD_AND_ITALIC_WHEN_ITALIC => 3;
14             const my $LIST_ELEMENT_INTERRUPT_NUMBER_OF_CHARACTERS_TO_IGNORE => 3;
15             const my $MINIMUM_LINK_SEARCH => 3;
16             const my $MINIMUM_TEMPLATE_SEARCH => 3;
17             const my $LIST_ELEMENT_DELIMITER => "\n* ";
18              
19             has used => ( is => 'rw', default => sub { 0 } );
20             has _current_list_output => ( is => 'rw' );
21             has _parse_options => ( is => 'rw' );
22             has _current_element => ( is => 'rw', default => sub { [] } );
23              
24             sub parse {
25 123     123 0 285 my ( $self, $wiki_text, $options ) = @_;
26 123 50       623 if ( $self->used ) {
27 0         0 die 'Parser already used';
28             }
29 123         369 $self->_parse_options($options);
30 123         223 my @output;
31 123         246 $wiki_text =~ s/\r//g;
32 123         404 $self->_parse_in_array( \@output, $wiki_text );
33 123         418 $self->_strip_all_line_numbers( \@output );
34 123         338 $self->used(1);
35 123         661 return \@output;
36             }
37              
38             sub _strip_all_line_numbers {
39 219     219   426 my ( $self, $output ) = @_;
40 219 100       761 if ( $self->_parse_options->{track_lines_for_errors} ) {
41 52         96 return;
42             }
43 167         420 for my $element (@$output) {
44 252 100       525 if ( 'HASH' ne ref $element ) {
45 156         263 next;
46             }
47 96         160 delete $element->{start_line};
48 96 100       198 if ( defined $element->{output} ) {
49 78         167 @{ $element->{output} } =
50 116         249 map { $self->_strip_line_numbers_element($_) }
51 78         101 @{ $element->{output} };
  78         168  
52             }
53 96         256 $self->_strip_all_line_numbers( $element->{output} );
54             }
55             }
56              
57             sub _search_interrupt {
58 2125     2125   3985 my ( $self, $output, $buffer, $wiki_text, $i, $interrupt ) = @_;
59 2125         3677 my $new_i = $interrupt->( $wiki_text, $i );
60 2125 100       4262 if ( !defined $new_i ) {
61 2045         3647 return;
62             }
63 80         179 $i = $new_i;
64 80         173 return $i;
65             }
66              
67             sub _insert_into_output {
68 234 50   234   521 die 'Wrong number of arguments' if scalar @_ != 3;
69 234         388 my ( $self, $output, $buffer ) = @_;
70 234         681 $buffer =~ s/(\n|\A)(\n)/$1/gs;
71 234 100       754 if ( $buffer =~ /^$/s ) {
72 2         5 $buffer = '';
73 2         6 return ($buffer);
74             }
75 232         575 push @$output, $buffer;
76 232         307 $buffer = '';
77 232         471 return ($buffer);
78             }
79              
80             sub _break_lines_template {
81 0     0   0 my ( $self, $output, $buffer, $current_char, $i ) = @_;
82 0 0       0 if ( $current_char eq "|" ) {
83 0         0 ($buffer) = $self->_insert_into_output( $output, $buffer );
84 0         0 return ( 1, $buffer, $i );
85             }
86 0         0 return ( 0, $buffer, $i );
87             }
88              
89             sub _break_lines {
90 2045     2045   4143 my ( $self, $output, $wiki_text, $buffer, $i, $options ) = @_;
91 2045 50       3998 if ( $options->{is_unordered_list} ) {
92 0         0 return ( 0, $buffer, $i );
93             }
94 2045         3825 return $self->_break_lines_on_newline( $output, $wiki_text, $buffer, $i, );
95             }
96              
97             sub _break_lines_on_newline {
98 2045     2045   3670 my ( $self, $output, $wiki_text, $buffer, $i ) = @_;
99 2045         2493 my $searched = "\n\n";
100 2045         2500 my $size_search = length $searched;
101 2045         3165 my $last_word = substr $wiki_text, $i, $size_search;
102 2045 100       3944 if ( $last_word eq $searched ) {
103 55         112 ($buffer) = $self->_insert_into_output( $output, $buffer );
104 55         179 return ( 1, $buffer, $i + $size_search - 1 );
105             }
106 1990         2622 $searched = "\n* ";
107 1990         2596 $size_search = length $searched;
108 1990         2795 $last_word = substr $wiki_text, $i, $size_search;
109 1990 100       4952 if ( $last_word eq $searched ) {
110 4         14 ($buffer) = $self->_insert_into_output( $output, $buffer );
111 4         16 return ( 1, $buffer, $i );
112             }
113 1986         5724 return ( 0, $buffer, $i );
114             }
115              
116             sub _if_interrupted {
117 80     80   188 my ( $self, $output, $buffer, $options ) = @_;
118 80 100       180 if ( $options->{is_unordered_list} ) {
119 3         11 return $self->_if_interrupted_unordered_list( $output, $buffer,
120             $options );
121             }
122 77 100       182 if ( !$options->{is_nowiki} ) {
123 67         144 ($buffer) = $self->_insert_into_output( $output, $buffer );
124 67 100 100     325 if ( !$options->{is_bold} && !$options->{is_italic} ) {
125 47         113 @$output = map { $self->_strip_line_numbers_element($_) } @$output;
  52         104  
126             }
127             }
128 77         175 return ($buffer);
129             }
130              
131             sub _insert_list_element_never_appending {
132 7     7   19 my ( $self, $output, $buffer ) = @_;
133 7         47 push @$output, { type => 'list_element', output => [$buffer] };
134 7         25 $self->_current_list_output( $output->[-1]{output} );
135 7         13 $buffer = '';
136 7         20 return ($buffer);
137             }
138              
139             sub _if_interrupted_unordered_list {
140 3     3   7 my ( $self, $output, $buffer, $options ) = @_;
141 3 100       10 if ( length $buffer ) {
142 1 50 33     10 if ( $options->{br_found} || $options->{element_found} ) {
143 0         0 ($buffer) =
144             $self->_insert_list_appending_if_possible( $output, $buffer,
145             $options );
146             }
147             else {
148 1         4 ($buffer) =
149             $self->_insert_list_element_never_appending( $output, $buffer );
150             }
151             }
152 3         6 delete $options->{br_found};
153 3         7 delete $options->{element_found};
154 3         4 delete $options->{is_unordered_list};
155 3         8 return ($buffer);
156             }
157              
158             sub _strip_line_numbers_element {
159 168     168   329 my ( $self, $element ) = @_;
160 168 100       351 if ( 'HASH' ne ref $element ) {
161 138         423 return $element;
162             }
163 30         46 delete $element->{start_line};
164 30         64 return $element;
165             }
166              
167             sub _insert_list_appending_if_possible {
168 15     15   34 my ( $self, $output, $buffer, $options ) = @_;
169 15 100       60 if ( defined $self->_current_list_output ) {
170 12         18 push @{ $self->_current_list_output }, $buffer;
  12         44  
171 12         22 $buffer = '';
172 12         35 return ($buffer);
173             }
174 3         11 ($buffer) =
175             $self->_insert_list_element_never_appending( $output, $buffer, );
176 3         7 return ( $buffer, );
177             }
178              
179             sub _insert_new_list_element_after_asterisk {
180 15     15   40 my ( $self, $output, $buffer, $i, $options ) = @_;
181 15         21 my $searched = $LIST_ELEMENT_DELIMITER;
182 15         29 my $size_search = length $searched;
183 15 100       40 if ( length $buffer ) {
184 14         39 ($buffer) =
185             $self->_insert_list_appending_if_possible( $output, $buffer,
186             $options );
187 14         33 $options->{element_found} = 0;
188             }
189 15         29 delete $options->{br_found};
190 15         25 delete $options->{element_found};
191 15         25 $buffer = '';
192 15         52 $i += $size_search;
193 15         68 push @$output, { type => 'list_element', output => [] };
194 15         46 $self->_current_list_output( $output->[-1]{output} );
195 15         21 $buffer = '';
196 15         42 return ( $i, $buffer, );
197             }
198              
199             sub _needs_interruption {
200 2125     2125   4044 my ( $self, $output, $buffer, $wiki_text, $i, $interrupt, $options ) = @_;
201 2125         2671 my $new_i;
202             my $needs_interruption;
203 2125         4173 $new_i =
204             $self->_search_interrupt( $output, $buffer, $wiki_text, $i, $interrupt );
205 2125 100       4019 if ( defined $new_i ) {
206 80         209 ( $buffer, ) = $self->_if_interrupted( $output, $buffer, $options );
207 80         132 $needs_interruption = 1;
208 80         238 return ( $needs_interruption, $new_i, $buffer );
209             }
210 2045         4953 return ( $needs_interruption, $i, $buffer );
211             }
212              
213             sub _unordered_list_pre_syntax_parsing_newline_logic {
214 2045     2045   3656 my ( $self, $output, $buffer, $wiki_text, $i, $options ) = @_;
215 2045 100       3890 if ( !$options->{is_unordered_list} ) {
216 1924         4080 return ( $i, $buffer, );
217             }
218 121         254 ( $i, $buffer, ) =
219             $self->_unordered_list_pre_syntax_parsing_newline_logic_real_line(
220             $output, $buffer, $wiki_text, $i, $options );
221 121         276 ( $i, $buffer, ) =
222             $self->_unordered_list_pre_syntax_parsing_newline_logic_br( $output,
223             $buffer, $wiki_text, $i, $options );
224 121         299 return ( $i, $buffer, );
225             }
226              
227             sub _unordered_list_pre_syntax_parsing_newline_logic_br {
228 121     121   242 my ( $self, $output, $buffer, $wiki_text, $i, $options ) = @_;
229 121         163 my $searched = '
';
230 121         156 my $size_search = length $searched;
231 121         190 my $last_word = substr $wiki_text, $i, $size_search;
232 121 100       255 if ( $last_word eq $searched ) {
233 5         13 $options->{'br_found'} = 1;
234 5 50       13 if ( length $buffer ) {
235 5 100       25 if ( defined $self->_current_list_output ) {
236 1         4 push @{ $self->_current_list_output }, $buffer;
  1         6  
237             }
238             else {
239 4         24 push @$output, { type => 'list_element', output => [$buffer] };
240 4         13 $self->_current_list_output( $output->[-1]{output} );
241             }
242             }
243 5         9 $buffer = '';
244 5         8 $i += $size_search;
245             }
246 121         316 return ( $i, $buffer );
247             }
248              
249             sub _unordered_list_pre_syntax_parsing_newline_logic_real_line {
250 121     121   311 my ( $self, $output, $buffer, $wiki_text, $i, $options ) = @_;
251 121         187 my $searched = $LIST_ELEMENT_DELIMITER;
252 121         178 my $size_search = length $searched;
253 121         211 my $last_word = substr $wiki_text, $i, $size_search;
254 121 100       284 if ( $last_word eq $searched ) {
255 15         61 ( $i, $buffer ) =
256             $self->_insert_new_list_element_after_asterisk( $output,
257             $buffer, $i, $options );
258             }
259 121         315 return ( $i, $buffer );
260             }
261              
262             sub _parse_in_array_pre_char_checks {
263 2125     2125   4160 my ( $self, $output, $buffer, $wiki_text, $i, $interrupt, $options ) = @_;
264 2125         2767 my ( $needs_interruption, $new_i );
265 2125         4357 ( $needs_interruption, $new_i, $buffer ) =
266             $self->_needs_interruption( $output, $buffer, $wiki_text, $i,
267             $interrupt, $options );
268 2125 100       4177 if ($needs_interruption) {
269 80         195 return ( $needs_interruption, $buffer, $new_i, );
270             }
271 2045         4729 ( $i, $buffer, ) =
272             $self->_unordered_list_pre_syntax_parsing_newline_logic( $output,
273             $buffer, $wiki_text, $i, $options );
274 2045         4560 return ( $needs_interruption, $buffer, $i, );
275             }
276              
277             sub _parse_in_array_pre_new_element_parsing {
278 2125     2125   4361 my ( $self, $output, $buffer, $wiki_text, $i, $interrupt, $options ) = @_;
279 2125         2902 my ( $needs_next, $needs_return, $current_char );
280 2125         4298 ( $needs_return, $buffer, $i, ) =
281             $self->_parse_in_array_pre_char_checks( $output, $buffer, $wiki_text, $i,
282             $interrupt, $options );
283 2125 100       3840 if ($needs_return) {
284 80         232 return ( $needs_next, $needs_return, $i, $buffer, $current_char, );
285             }
286 2045         4214 ( $needs_next, $buffer, $i ) =
287             $self->_break_lines( $output, $wiki_text, $buffer, $i, $current_char,
288             $options, );
289 2045         3539 $current_char = substr $wiki_text, $i, 1;
290 2045         5940 return ( $needs_next, $needs_return, $i, $buffer, $current_char, );
291             }
292              
293             sub _parse_in_array_search_new_elements {
294 1986     1986   4509 my ( $self, $output, $buffer, $wiki_text, $i, $options ) = @_;
295 1986         2323 my ($needs_next);
296 1986 100       3827 if ( !$options->{is_nowiki} ) {
297             {
298 1882 100       2240 if ( !$options->{is_header} ) {
  1882         3462  
299 1432         3190 ( $needs_next, $i, $buffer ) =
300             $self->_try_parse_header( $output, $wiki_text, $buffer, $i,
301             $options );
302 1432 100       2864 next if $needs_next;
303             }
304 1822         3958 ( $needs_next, $i, $buffer ) =
305             $self->_try_parse_bold( $output, $wiki_text, $buffer, $i,
306             $options );
307 1822 100       3612 next if $needs_next;
308 1808         3679 ( $needs_next, $i, $buffer ) =
309             $self->_try_parse_italic( $output, $wiki_text, $buffer, $i,
310             $options );
311 1808 100       3345 next if $needs_next;
312 1805 100       3311 if ( !$options->{is_unordered_list} ) {
313 1688         3412 ( $needs_next, $i, $buffer ) =
314             $self->_try_parse_unordered_list( $output, $wiki_text,
315             $buffer, $i, $options );
316 1688 100       3288 next if $needs_next;
317             }
318 1798         3891 ( $needs_next, $i, $buffer ) =
319             $self->_try_parse_template( $output, $wiki_text, $buffer, $i,
320             $options );
321 1798 100       4139 next if $needs_next;
322 1787         4132 ( $needs_next, $i, $buffer ) =
323             $self->_try_parse_nowiki( $output, $wiki_text, $buffer, $i,
324             $options );
325 1787 100       3239 next if $needs_next;
326 1779         3770 ( $needs_next, $i, $buffer ) =
327             $self->_try_parse_image( $output, $wiki_text, $buffer, $i,
328             $options );
329 1779 100       3226 next if $needs_next;
330 1762         3649 ( $needs_next, $i, $buffer ) =
331             $self->_try_parse_link( $output, $wiki_text, $buffer, $i,
332             $options );
333 1762 100       3561 next if $needs_next;
334             }
335             }
336 1986         4125 return ( $needs_next, $i, $buffer, );
337             }
338              
339             sub _parse_in_array {
340 226     226   536 my ( $self, $output, $wiki_text, $i, $buffer, $interrupt, $options, ) = @_;
341              
342 226   100     754 $i //= 0;
343 226   100     613 $buffer //= '';
344 226   66 1161   902 $interrupt //= sub { return };
  1161         1583  
345 226   100     613 $options //= {};
346              
347 226         575 for ( ; $i < length $wiki_text ; $i++ ) {
348 2125         2820 my ( $needs_next, $needs_return, $current_char );
349 2125         4559 ( $needs_next, $needs_return, $i, $buffer, $current_char, ) =
350             $self->_parse_in_array_pre_new_element_parsing( $output, $buffer,
351             $wiki_text, $i, $interrupt, $options );
352 2125 100       4119 if ($needs_next) {
353 59         147 next;
354             }
355 2066 100       3564 if ($needs_return) {
356 80         227 return ( $i, $buffer );
357             }
358 1986         4018 ( $needs_next, $i, $buffer ) =
359             $self->_parse_in_array_search_new_elements( $output, $buffer,
360             $wiki_text, $i, $options );
361 1986 100       3832 if ($needs_next) {
362 132         346 next;
363             }
364 1854         4598 $buffer .= $current_char;
365             }
366 146 100 100     691 if ( !$options->{is_nowiki} && length $buffer ) {
367             {
368 74 100       153 if ( $options->{is_unordered_list} ) {
  74         271  
369 4 100 66     28 if ( $options->{element_found} || $options->{br_found} ) {
370 1         6 ($buffer) =
371             $self->_insert_list_appending_if_possible( $output,
372             $buffer, $options );
373 1         4 next;
374             }
375 3         12 ($buffer) =
376             $self->_insert_list_element_never_appending( $output,
377             $buffer );
378 3         8 next;
379             }
380 70         161 ($buffer) = $self->_insert_into_output( $output, $buffer );
381             }
382 74         157 $buffer = '';
383             }
384 146 100 100     650 if ( $options->{is_bold} || $options->{is_italic} ) {
385             say STDERR 'Detected bold or italic unterminated syntax WIKI_LINE: '
386 6         297 . $self->_current_element->[-1]{start_line};
387             }
388 146         680 return ( $i, $buffer );
389             }
390              
391             sub _try_parse_nowiki {
392 2766     2766   5422 my ( $self, $output, $wiki_text, $buffer, $i, $options ) = @_;
393 2766         3426 my $tag = '';
394 2766         4044 my $next_word = substr $wiki_text, $i, length $tag;
395 2766 100       4685 if ( $tag ne $next_word ) {
396 2754         6006 return ( 0, $i, $buffer );
397             }
398 12         19 $i += length $tag;
399             ( $i, $buffer ) = $self->_parse_in_array(
400             $output,
401             $wiki_text,
402             $i, $buffer,
403             sub {
404 114     114   180 my ( $wiki_text, $i ) = @_;
405 114         217 return $self->_try_interrupt_nowiki( $wiki_text, $i );
406             },
407 12         133 { is_nowiki => 1 }
408             );
409 12         75 return ( 1, $i, $buffer );
410             }
411              
412             sub _try_interrupt_nowiki {
413 114     114   179 my ( $self, $wiki_text, $i ) = @_;
414 114         199 my $tag = '';
415 114         186 my $next_word = substr $wiki_text, $i, length $tag;
416 114 100       221 if ( $tag ne $next_word ) {
417 104         225 return;
418             }
419 10         29 return $i + ( length $tag ) - 1;
420             }
421              
422             sub _try_parse_italic {
423 1808     1808   3218 my ( $self, $output, $wiki_text, $buffer, $i, $options ) = @_;
424 1808         2323 my $searched = q/''/;
425 1808         2304 my $size_search = length $searched;
426 1808         2721 my $last_word = substr $wiki_text, $i, $size_search;
427 1808         2949 my $is_bold_and_italic_single_step =
428             $self->_check_bold_and_italic_in_single_step( $wiki_text, $i );
429 1808         2240 my $start_bold_or_italic = $i;
430 1808 50       3118 if ( !$is_bold_and_italic_single_step ) {
431 1808 100       3173 if ( $last_word ne $searched ) {
432 1805         4413 return ( 0, $i, $buffer, $options );
433             }
434             }
435 3 50       13 if ( $last_word ne $searched ) {
436 0         0 return ( 0, $i, $buffer, $options );
437             }
438 3         9 $options->{is_italic} = 1;
439 3 50       8 if ($is_bold_and_italic_single_step) {
440 0         0 $options->{is_bold} = 1;
441             }
442 3         6 $i += $size_search;
443 3 50       9 if ($is_bold_and_italic_single_step) {
444 0         0 $i += $EXTRA_CHARACTERS_BOLD_AND_ITALIC_WHEN_ITALIC;
445             }
446 3         24 return $self->_recurse_pending_bold_or_italic( $output, $wiki_text, $i,
447             $start_bold_or_italic, $buffer, $options );
448              
449             }
450              
451             sub _check_bold_and_italic_in_single_step {
452 3630     3630   5874 my ( $self, $wiki_text, $i ) = @_;
453 3630         4435 my $searched = q/'''''/;
454 3630         4193 my $size_search = length $searched;
455 3630         4873 my $last_word = substr $wiki_text, $i, $size_search;
456 3630 100       6388 if ( $last_word eq $searched ) {
457 5         14 return 1;
458             }
459 3625         5981 return;
460             }
461              
462             sub _try_parse_unordered_list {
463 1688     1688   3124 my ( $self, $output, $wiki_text, $buffer, $i, $options ) = @_;
464             my $start_line =
465 1688         2043 scalar @{ [ split "\n", substr( $wiki_text, 0, $i ) ] };
  1688         5976  
466 1688 100       4072 if ( 0 < length $buffer ) {
467 1434         3243 return ( 0, $i, $buffer, $options );
468             }
469 254         309 my $searched = q/* /;
470 254         301 my $size_search = length $searched;
471 254         433 my $last_word = substr $wiki_text, $i, $size_search;
472 254 100       517 if ( $last_word ne $searched ) {
473 247         625 return ( 0, $i, $buffer, $options );
474             }
475 7         12 $i += $size_search;
476 7         22 $options->{is_unordered_list} = 1;
477 7         29 my $element = { type => 'unordered_list', output => [], };
478 7         17 $element->{start_line} = $start_line;
479             ( $i, $buffer ) = $self->_parse_in_array(
480             $element->{output},
481             $wiki_text,
482             $i, $buffer,
483             sub {
484 124     124   248 my ( $wiki_text, $i ) = @_;
485 124 100       266 if ( $self->_try_discard_interrupt_list( $wiki_text, $i ) ) {
486 106         210 return;
487             }
488 18         45 return $self->_try_interrupt_list( $wiki_text, $i );
489             },
490 7         70 $options,
491             );
492 7         31 @{ $element->{output} } =
493 7         41 grep { @{ $_->{output} } } @{ $element->{output} };
  31         41  
  31         64  
  7         26  
494 7         18 push @$output, $element;
495 7         24 return ( 1, $i, $buffer, $options );
496             }
497              
498             sub _try_interrupt_list {
499 18     18   40 my ( $self, $wiki_text, $i ) = @_;
500 18         60 my $searched = $LIST_ELEMENT_DELIMITER;
501 18         29 my $size_search = length $searched;
502 18         31 my $last_word = substr $wiki_text, $i, $size_search;
503 18 100       38 if ( $last_word ne $searched ) {
504 3         11 return $i + $size_search -
505             $LIST_ELEMENT_INTERRUPT_NUMBER_OF_CHARACTERS_TO_IGNORE;
506             }
507 15         37 return;
508             }
509              
510             sub _try_discard_interrupt_list {
511 124     124   219 my ( $self, $wiki_text, $i ) = @_;
512 124         162 my $searched = "\n";
513 124         161 my $size_search = length $searched;
514 124         212 my $last_word = substr $wiki_text, $i, $size_search;
515 124 100       349 if ( $last_word ne $searched ) {
516 106         301 return 1;
517             }
518 18         49 return 0;
519             }
520              
521             sub _save_before_new_element {
522 124     124   283 my ( $self, $output, $buffer, $options ) = @_;
523 124 100       292 if ( $options->{is_unordered_list} ) {
524 8 100 66     35 if ( length $buffer || !@$output ) {
525 5         37 push @$output, { type => 'list_element', output => [] };
526             }
527 8         21 $output = $output->[-1]{output};
528 8         27 $self->_current_list_output($output);
529 8         15 $options->{element_found} = 1;
530             }
531 124 100       271 if ( !length $buffer ) {
532 86         222 return ( $output, $buffer );
533             }
534 38         104 ($buffer) = $self->_insert_into_output( $output, $buffer );
535 38         95 return ( $output, $buffer );
536             }
537              
538             sub _try_parse_bold {
539 1822     1822   3351 my ( $self, $output, $wiki_text, $buffer, $i, $options ) = @_;
540 1822         2293 my $searched = q/'''/;
541 1822         2276 my $start_bold_or_italic = $i;
542 1822         2160 my $size_search = length $searched;
543 1822         2762 my $last_word = substr $wiki_text, $i, $size_search;
544 1822         3521 my $is_bold_and_italic_single_step =
545             $self->_check_bold_and_italic_in_single_step( $wiki_text, $i );
546 1822 100       3175 if ( !$is_bold_and_italic_single_step ) {
547 1817 100       5119 if ( $last_word ne $searched ) {
548 1808         4462 return ( 0, $i, $buffer, $options );
549             }
550             }
551 14         43 $options->{is_bold} = 1;
552 14 100       32 if ($is_bold_and_italic_single_step) {
553 5         12 $options->{is_italic} = 1;
554             }
555 14         38 $i += $size_search;
556 14 100       33 if ($is_bold_and_italic_single_step) {
557 5         7 $i += 2;
558             }
559 14         51 my @return =
560             $self->_recurse_pending_bold_or_italic( $output, $wiki_text, $i,
561             $start_bold_or_italic, $buffer, $options );
562 14         20 $return[0] = 1;
563 14         44 return @return;
564             }
565              
566             sub _calculate_bold_or_italic_type {
567 36     36   68 my ( $self, $element, $options ) = @_;
568 36 100       94 if ( $options->{is_italic} ) {
569 15         36 $element->{type} = 'italic';
570             }
571 36 100       78 if ( $options->{is_bold} ) {
572 16         39 $element->{type} = 'bold';
573             }
574 36   100     111 my $is_bold_and_italic = $options->{is_italic} && $options->{is_bold};
575 36 100       76 if ($is_bold_and_italic) {
576 7         11 $element->{type} = 'bold_and_italic';
577             }
578 36         78 return $is_bold_and_italic;
579             }
580              
581             sub _recurse_pending_bold_or_italic {
582 36     36   89 my ( $self, $output, $wiki_text, $i, $start_bold_or_italic, $buffer,
583             $options )
584             = @_;
585 36         115 my $element = { output => [], };
586 36         83 my $is_bold_and_italic =
587             $self->_calculate_bold_or_italic_type( $element, $options );
588             my $start_line =
589 36         57 scalar @{ [ split "\n", substr( $wiki_text, 0, $start_bold_or_italic ) ]
  36         168  
590             };
591 36         57 push @{ $self->_current_element }, $element;
  36         147  
592 36         73 $element->{start_line} = $start_line;
593             # say $element->{start_line} . '';
594 36 100       84 if ( !defined $element->{type} ) {
595 12         41 return ( 0, $i, $buffer, $options );
596             }
597 24         70 ( $output, $buffer ) =
598             $self->_save_before_new_element( $output, $buffer, $options );
599             ( $i, $buffer ) = $self->_parse_in_array(
600             $element->{output},
601             $wiki_text,
602             $i, $buffer,
603             sub {
604 230     230   424 my ( $wiki_text, $i ) = @_;
605 230 100       529 if ($is_bold_and_italic) {
606 111         155 my $searched = q/'''''/;
607 111         154 my $size_search = length $searched;
608 111         186 my $last_word = substr $wiki_text, $i, $size_search;
609 111 100       272 if ( $last_word eq $searched ) {
610 1         4 delete $options->{is_bold};
611 1         3 delete $options->{is_italic};
612 1         3 return $i + $size_search - 1;
613             }
614             }
615 229         346 my $searched = q/'''/;
616 229         299 my $size_search = length $searched;
617 229         344 my $last_word = substr $wiki_text, $i, $size_search;
618 229 100       471 if ( $last_word eq $searched ) {
619 12         38 $options->{is_bold} = !$options->{is_bold};
620 12 100       34 if ( $options->{is_italic} ) {
621 5         8 $i++;
622             }
623 12         36 return $i + $size_search - 1;
624             }
625 217         292 $searched = q/''/;
626 217         285 $size_search = length $searched;
627 217         396 $last_word = substr $wiki_text, $i, $size_search;
628 217 100       393 if ( $last_word eq $searched ) {
629 8         26 $options->{is_italic} = !$options->{is_italic};
630 8 100       25 if ( $options->{is_bold} ) {
631 2         4 $i++;
632             }
633 8         39 return $i + $size_search - 1;
634             }
635 209         417 return;
636             },
637             {
638             is_italic => $options->{is_italic},
639             is_bold => $options->{is_bold},
640             }
641 24         341 );
642 24         282 push @$output, $element;
643 24 100       76 if ( $i + 1 >= length $wiki_text ) {
644 5         24 return ( 1, $i, $buffer, $options );
645             }
646 19         29 pop @{ $self->_current_element };
  19         68  
647 19         67 my @return =
648             $self->_recurse_pending_bold_or_italic( $output, $wiki_text, $i,
649             $start_bold_or_italic, $buffer, $options );
650 19         33 $return[0] = 1;
651 19         62 return @return;
652             }
653              
654             sub _try_parse_image_find_url_size {
655 17     17   40 my ( $self, $wiki_text, $valid_characters, $i, $size_search ) = @_;
656 17         30 for ( $size_search = $size_search + 1 ; ; $size_search++ ) {
657 178         307 my $last_word = substr $wiki_text, $i, $size_search;
658 178 100       900 if ( $last_word !~ /^\[\[File:$valid_characters+$/x ) {
659 17         68 last;
660             }
661             }
662 17         42 return $size_search;
663             }
664              
665             sub _try_parse_image {
666 1779     1779   3154 my ( $self, $output, $wiki_text, $buffer, $i, $options ) = @_;
667 1779         2283 my $searched = '[[File:';
668 1779         2171 my $size_search = length $searched;
669 1779         2221 my $orig_size_search = $size_search;
670 1779         2582 my $last_word = substr $wiki_text, $i, $size_search;
671             my $start_line =
672 1779         2157 scalar @{ [ split "\n", substr( $wiki_text, 0, $i ) ] };
  1779         4944  
673 1779 100       3743 if ( $last_word ne $searched ) {
674 1762         4086 return ( 0, $i, $buffer );
675             }
676 17         75 my $valid_characters = qr/[A-Za-z0-9\-._~:\/?#@!\$&\'\(\)\*\+,;=\ ]/x;
677 17         50 ($size_search) =
678             $self->_try_parse_image_find_url_size( $wiki_text, $valid_characters, $i,
679             $size_search );
680 17         24 $size_search--;
681 17 50       40 if ( $size_search < $orig_size_search + 1 ) {
682 0         0 return ( 0, $i, $buffer );
683             }
684 17         46 $last_word = substr $wiki_text, $i, $size_search + 2;
685 17 100       181 if ( $last_word =~ /^\[\[File:($valid_characters+)\]\]$/x ) {
686 1         4 ( $output, $buffer ) =
687             $self->_save_before_new_element( $output, $buffer, $options );
688 1         7 push @$output,
689             {
690             type => 'image',
691             link => $1,
692             caption => '',
693             options => {},
694             start_line => $start_line,
695             };
696 1         3 return ( 1, $i + $size_search + 2, $buffer );
697             }
698 16         60 my ( $got_link, $link ) =
699             $self->_try_parse_image_get_url( $wiki_text, $valid_characters, $i,
700             $size_search );
701 16 50       44 if ( !$got_link ) {
702 0         0 return ( 0, $i, $buffer );
703             }
704              
705 16         89 ( $output, $buffer ) =
706             $self->_save_before_new_element( $output, $buffer, $options );
707              
708 16         28 my $tmp_buffer = '';
709 16         19 my $is_caption = 0;
710 16         22 my $element_options = {};
711 16         23 my $caption;
712 16         43 for ( $i = $i + $size_search + 1 ; $i < length $wiki_text ; $i++ ) {
713 907         997 my $last_component;
714 907         1578 ( $last_component, $caption, $tmp_buffer ) =
715             $self->_try_parse_image_parse_end( $wiki_text, $tmp_buffer, $i,
716             $caption, $element_options );
717 907 100       1659 if ($last_component) {
718 16         23 last;
719             }
720 891         1090 $searched = '|';
721 891         1049 $size_search = length $searched;
722 891         1150 $last_word = substr $wiki_text, $i, $size_search;
723 891 100       1411 if ( $searched eq $last_word ) {
724 58         131 ($caption) =
725             $self->_try_parse_link_component( $tmp_buffer, $caption,
726             $element_options );
727 58         98 $tmp_buffer = '';
728 58         159 next;
729             }
730 833         846 my $need_next;
731 833         2013 ( $need_next, $i, $buffer ) =
732             $self->_try_parse_nowiki( $output, $wiki_text, $buffer, $i,
733             $options );
734 833 50       1602 if ($need_next) {
735 0         0 $is_caption = 1;
736 0         0 next;
737             }
738              
739 833         1933 $tmp_buffer .= substr $wiki_text, $i, 1;
740             }
741              
742 16         112 my $template = {
743             type => 'image',
744             link => $link,
745             caption => $caption,
746             options => $element_options,
747             start_line => $start_line,
748             };
749 16         43 push @$output, $template;
750 16         23 $i += 1;
751 16         24 $buffer = '';
752 16         75 return ( 1, $i, $buffer );
753             }
754              
755             sub _try_parse_image_parse_end {
756 907     907   1561 my ( $self, $wiki_text, $tmp_buffer, $i, $caption, $element_options ) = @_;
757 907         1052 my $searched = ']]';
758 907         1065 my $size_search = length $searched;
759 907         1158 my $last_word = substr $wiki_text, $i, $size_search;
760 907 100       1542 if ( $searched eq $last_word ) {
761 16         37 ($caption) =
762             $self->_try_parse_link_component( $tmp_buffer, $caption,
763             $element_options );
764 16         26 $tmp_buffer = '';
765 16         45 return ( 1, $caption, $tmp_buffer );
766             }
767 891         2031 return ( 0, $caption, $tmp_buffer );
768             }
769              
770             sub _try_parse_image_get_url {
771 16     16   39 my ( $self, $wiki_text, $valid_characters, $i, $size_search ) = @_;
772 16         38 my $last_word = substr $wiki_text, $i, $size_search + 1;
773 16 50       188 if ( $last_word =~ /^\[\[File:($valid_characters+)\|/x ) {
774 16         94 return ( 1, $1 );
775             }
776 0         0 return (0);
777             }
778              
779             sub _is_defined_image_format_exclusive {
780 10     10   20 my ( $self, $element_options ) = @_;
781 10         24 for my $option (qw/frameless frame framed thumb thumbnail/) {
782 38 100       95 if ( defined $element_options->{format}{$option} ) {
783 4         18 return 1;
784             }
785             }
786 6         19 return;
787             }
788              
789             sub _try_parse_link_component_formats {
790 74     74   130 my ( $self, $tmp_buffer, $caption, $element_options ) = @_;
791 74 100       183 if ( $tmp_buffer =~ /^border$/x ) {
792 1         5 $element_options->{format}{border} = 1;
793 1         4 return 1;
794             }
795 73 100       135 if ( $tmp_buffer =~ /^frameless$/x ) {
796 1 50       5 return 1
797             if $self->_is_defined_image_format_exclusive($element_options);
798 0         0 $element_options->{format}{frameless} = 1;
799 0         0 return 1;
800             }
801 72 100       155 if ( $tmp_buffer =~ /^frame$/x ) {
802 5 100       15 return 1
803             if $self->_is_defined_image_format_exclusive($element_options);
804 4         14 $element_options->{format}{frame} = 1;
805 4         10 return 1;
806             }
807 67 100       133 if ( $tmp_buffer =~ /^framed$/x ) {
808 1 50       5 return 1
809             if $self->_is_defined_image_format_exclusive($element_options);
810 1         3 $element_options->{format}{frame} = 1;
811 1         4 return 1;
812             }
813 66 100       117 if ( $tmp_buffer =~ /^thumb$/x ) {
814 2 100       8 return 1
815             if $self->_is_defined_image_format_exclusive($element_options);
816 1         4 $element_options->{format}{thumb} = 1;
817 1         3 return 1;
818             }
819 64 100       109 if ( $tmp_buffer =~ /^thumbnail$/x ) {
820 1 50       4 return 1
821             if $self->_is_defined_image_format_exclusive($element_options);
822 0         0 $element_options->{format}{thumb} = 1;
823 0         0 return 1;
824             }
825 63         110 return;
826             }
827              
828             sub _try_parse_link_component_halign {
829 52     52   101 my ( $self, $tmp_buffer, $caption, $element_options ) = @_;
830 52 100       106 if ( $tmp_buffer =~ /^left$/x ) {
831 1 50       5 return $caption
832             if $self->_is_defined_image_halign_exclusive($element_options);
833 1         4 $element_options->{halign} = 'left';
834 1         3 return $caption;
835             }
836 51 100       92 if ( $tmp_buffer =~ /^right$/x ) {
837 1 50       6 return $caption
838             if $self->_is_defined_image_halign_exclusive($element_options);
839 0         0 $element_options->{halign} = 'right';
840 0         0 return $caption;
841             }
842 50 100       98 if ( $tmp_buffer =~ /^center$/x ) {
843 1 50       2 return $caption
844             if $self->_is_defined_image_halign_exclusive($element_options);
845 0         0 $element_options->{halign} = 'center';
846 0         0 return $caption;
847             }
848 49 100       87 if ( $tmp_buffer =~ /^none$/x ) {
849 1 50       4 return $caption
850             if $self->_is_defined_image_halign_exclusive($element_options);
851 0         0 $element_options->{halign} = 'none';
852 0         0 return $caption;
853             }
854 48         81 return;
855             }
856              
857             sub _try_parse_link_component_valign {
858 48     48   91 my ( $self, $tmp_buffer, $caption, $element_options ) = @_;
859 48 100       88 if ( $tmp_buffer =~ /^baseline$/x ) {
860 1 50       7 return $caption
861             if $self->_is_defined_image_valign_exclusive($element_options);
862 1         4 $element_options->{valign} = 'baseline';
863 1         2 return $caption;
864             }
865 47 100       81 if ( $tmp_buffer =~ /^sub$/x ) {
866 1 50       4 return $caption
867             if $self->_is_defined_image_valign_exclusive($element_options);
868 0         0 $element_options->{valign} = 'sub';
869 0         0 return $caption;
870             }
871 46 100       109 if ( $tmp_buffer =~ /^super$/x ) {
872 1 50       5 return $caption
873             if $self->_is_defined_image_valign_exclusive($element_options);
874 0         0 $element_options->{valign} = 'super';
875 0         0 return $caption;
876             }
877 45 100       84 if ( $tmp_buffer =~ /^top$/x ) {
878 1 50       5 return $caption
879             if $self->_is_defined_image_valign_exclusive($element_options);
880 0         0 $element_options->{valign} = 'top';
881 0         0 return $caption;
882             }
883 44 100       111 if ( $tmp_buffer =~ /^text-top$/x ) {
884 1 50       5 return $caption
885             if $self->_is_defined_image_valign_exclusive($element_options);
886 0         0 $element_options->{valign} = 'text-top';
887 0         0 return $caption;
888             }
889 43 100       82 if ( $tmp_buffer =~ /^middle$/x ) {
890 1 50       5 return $caption
891             if $self->_is_defined_image_valign_exclusive($element_options);
892 0         0 $element_options->{valign} = 'middle';
893 0         0 return $caption;
894             }
895 42 100       76 if ( $tmp_buffer =~ /^bottom$/x ) {
896 1 50       5 return $caption
897             if $self->_is_defined_image_valign_exclusive($element_options);
898 0         0 $element_options->{valign} = 'bottom';
899 0         0 return $caption;
900             }
901 41 100       77 if ( $tmp_buffer =~ /^text-bottom$/x ) {
902 1 50       6 return $caption
903             if $self->_is_defined_image_valign_exclusive($element_options);
904 0         0 $element_options->{valign} = 'text-bottom';
905 0         0 return $caption;
906             }
907 40         69 return;
908             }
909              
910             sub _try_parse_link_component_extra_options_video_controls {
911 39     39   74 my ( $self, $tmp_buffer, $caption, $element_options ) = @_;
912 39 100       94 if ( my ($thumbtime) =
913             $tmp_buffer =~ /^thumbtime=((?:\d+:)?(?:\d+:)\d+)$/x )
914             {
915 2 100       11 return 1 if defined $element_options->{thumbtime};
916 1         3 $element_options->{thumbtime} = $thumbtime;
917 1         3 return 1;
918             }
919 37 100       85 if ( my ($start) = $tmp_buffer =~ /^start=((?:\d+:)?(?:\d+:)\d+)$/x ) {
920 2 100       11 return 1 if defined $element_options->{start};
921 1         3 $element_options->{start} = $start;
922 1         4 return 1;
923             }
924 35 100       70 if ( $tmp_buffer =~ /^muted$/x ) {
925 1 50       7 return 1 if defined $element_options->{muted};
926 1         3 $element_options->{muted} = 1;
927 1         3 return 1;
928             }
929 34 100       66 if ( $tmp_buffer =~ /^loop$/x ) {
930 1 50       25 return 1 if defined $element_options->{loop};
931 1         6 $element_options->{loop} = 1;
932 1         4 return 1;
933             }
934 33         61 return;
935             }
936              
937             sub _try_parse_link_component_extra_options {
938 48     48   86 my ( $self, $tmp_buffer, $caption, $element_options ) = @_;
939 48 100       104 if ( my ($link) = $tmp_buffer =~ /^link=(.*)$/x ) {
940 1 50       6 return 1 if defined $element_options->{link};
941 1         4 $element_options->{link} = $link;
942 1         6 return 1;
943             }
944 47 100       137 if ( my ($alt) = $tmp_buffer =~ /^alt=(.*)$/x ) {
945 4 50       14 return 1 if defined $element_options->{alt};
946 4         15 $element_options->{alt} = $alt;
947 4         8 return 1;
948             }
949 43 100       103 if ( my ($page) = $tmp_buffer =~ /^page=(\d+)$/x ) {
950 2 50       12 return 1 if defined $element_options->{page};
951 2         7 $element_options->{page} = $page;
952 2         6 return 1;
953             }
954 41 100       83 if ( my ($loosy) = $tmp_buffer =~ /^loosy=(.*)$/x ) {
955 1 50       6 return 1 if ( $loosy ne 'false' );
956 1 50       5 return 1 if defined $element_options->{not_loosy};
957 1         3 $element_options->{not_loosy} = 1;
958 1         7 return 1;
959             }
960 40 100       90 if ( my ($class_string) = $tmp_buffer =~ /^class=(.*)$/x ) {
961 1 50       5 return 1 if defined $element_options->{classes};
962 1         4 $element_options->{classes} = [];
963 1         6 for my $class ( split /\s+/x, $class_string ) {
964 2         3 push @{ $element_options->{classes} }, $class;
  2         24  
965             }
966 1         4 return 1;
967             }
968 39         84 my $return_video =
969             $self->_try_parse_link_component_extra_options_video_controls(
970             $tmp_buffer, $caption, $element_options );
971 39 100       84 return 1 if defined $return_video;
972 33         56 return;
973             }
974              
975             sub _try_parse_link_component {
976 74     74   196 my ( $self, $tmp_buffer, $caption, $element_options ) = @_;
977 74         165 my $found_something =
978             $self->_try_parse_link_component_formats( $tmp_buffer, $caption,
979             $element_options );
980 74 100       145 if ( defined $found_something ) {
981 11         25 return $caption;
982             }
983 63         70 my $return_now;
984 63         139 ($return_now) =
985             $self->_try_parse_image_resizing( $tmp_buffer, $element_options );
986 63 100       119 return $caption if $return_now;
987 52         115 my $return_caption_halign =
988             $self->_try_parse_link_component_halign( $tmp_buffer, $caption,
989             $element_options );
990 52 100       96 return $return_caption_halign if defined $return_caption_halign;
991 48         112 my $return_caption_valign =
992             $self->_try_parse_link_component_valign( $tmp_buffer, $caption,
993             $element_options );
994 48 50       85 return $return_caption_valign if defined $return_caption_halign;
995 48         98 my $return_component_extra =
996             $self->_try_parse_link_component_extra_options( $tmp_buffer, $caption,
997             $element_options );
998 48 100       113 return $caption if defined $return_component_extra;
999              
1000 33 100       65 if ( !defined $caption ) {
1001 16         36 return $tmp_buffer;
1002             }
1003 17         37 return $caption;
1004             }
1005              
1006             sub _is_defined_image_valign_exclusive {
1007 8     8   15 my ( $self, $element_options ) = @_;
1008 8 100       22 if ( defined $element_options->{valign} ) {
1009 7         67 return 1;
1010             }
1011 1         4 return 0;
1012             }
1013              
1014             sub _is_defined_image_halign_exclusive {
1015 4     4   6 my ( $self, $element_options ) = @_;
1016 4 100       12 if ( defined $element_options->{halign} ) {
1017 3         42 return 1;
1018             }
1019 1         3 return 0;
1020             }
1021              
1022             sub _is_defined_image_resizing_exclusive {
1023 11     11   20 my ( $self, $element_options ) = @_;
1024 11         23 for my $option (qw/width height upright/) {
1025 23 100       54 if ( defined $element_options->{resize}{$option} ) {
1026 5         22 return 1;
1027             }
1028             }
1029 6         15 return 0;
1030             }
1031              
1032             sub _try_parse_image_resizing {
1033 63     63   125 my ( $self, $tmp_buffer, $element_options ) = @_;
1034 63 100       200 if ( my ($width) = $tmp_buffer =~ /^(\d+)(?:\ |)px$/x ) {
1035 2 100       8 return 1
1036             if $self->_is_defined_image_resizing_exclusive($element_options);
1037 1         6 $element_options->{resize}{width} = 0 + $width;
1038 1         3 return 1;
1039             }
1040 61 100       176 if ( my ($height) = $tmp_buffer =~ /^x(\d+)(?:\ |)px$/x ) {
1041 4 100       12 return 1
1042             if $self->_is_defined_image_resizing_exclusive($element_options);
1043 2         11 $element_options->{resize}{height} = 0 + $height;
1044 2         7 return 1;
1045             }
1046 57 50       128 if ( my ( $width, $height ) = $tmp_buffer =~ /^(\d+)x(\d+)(?:\ |)px$/x ) {
1047 0 0       0 return 1
1048             if $self->_is_defined_image_resizing_exclusive($element_options);
1049 0         0 $element_options->{resize}{width} = 0 + $width;
1050 0         0 $element_options->{resize}{height} = 0 + $height;
1051 0         0 return 1;
1052             }
1053 57 100       133 if ( my ($upright) = $tmp_buffer =~ /^upright(?:\ |=)(\d+\.\d+)$/x ) {
1054 5 100       12 return 1
1055             if $self->_is_defined_image_resizing_exclusive($element_options);
1056 3         7 $element_options->{resize}{upright} = $upright;
1057 3         81 return 1;
1058             }
1059 52         102 return 0;
1060             }
1061              
1062             sub _try_parse_link_find_size_url {
1063 12     12   25 my ( $self, $wiki_text, $valid_characters, $i ) = @_;
1064 12         15 my $size_search;
1065 12         18 for ( $size_search = $MINIMUM_LINK_SEARCH ; ; $size_search++ ) {
1066 163         199 my $last_word = substr $wiki_text, $i, $size_search;
1067 163 100       670 if ( $last_word !~ /^\[\[$valid_characters+$/x ) {
1068 12         24 last;
1069             }
1070             }
1071 12         22 return $size_search;
1072             }
1073              
1074             sub _try_parse_link_try_determine_url {
1075 5     5   11 my ( $self, $wiki_text, $valid_characters, $i, $size_search ) = @_;
1076 5         8 my $last_word = substr $wiki_text, $i, $size_search + 1;
1077 5 50       59 if ( $last_word =~ /^\[\[($valid_characters+)\|/x ) {
1078 5         18 return ( 1, $1 );
1079             }
1080 0         0 return (0);
1081             }
1082              
1083             sub _try_parse_link {
1084 1762     1762   3371 my ( $self, $output, $wiki_text, $buffer, $i, $options ) = @_;
1085 1762         2163 my $searched = '[[';
1086 1762         2356 my $size_search = length $searched;
1087 1762         2599 my $last_word = substr $wiki_text, $i, $size_search;
1088 1762 100       3218 if ( $last_word ne $searched ) {
1089 1750         3809 return ( 0, $i, $buffer );
1090             }
1091 12         49 my $valid_characters = qr/[A-Za-z0-9\-._~:\/?#@!\$&\'\(\)\*\+,;=\ ]/x;
1092 12         39 $size_search =
1093             $self->_try_parse_link_find_size_url( $wiki_text, $valid_characters, $i );
1094 12         16 $size_search--;
1095 12 50       26 if ( $size_search < $MINIMUM_LINK_SEARCH ) {
1096 0         0 return ( 0, $i, $buffer );
1097             }
1098 12         25 $last_word = substr $wiki_text, $i, $size_search + 2;
1099 12 100       154 if ( $last_word =~ /^\[\[($valid_characters+)\]\]$/x ) {
1100 7         28 ( $output, $buffer ) =
1101             $self->_save_before_new_element( $output, $buffer, $options );
1102 7         47 push @$output,
1103             {
1104             type => 'link',
1105             link => $1,
1106             title => $1,
1107             };
1108 7         34 return ( 1, $i + $size_search + 1, $buffer );
1109             }
1110 5         15 my ( $got_url, $link ) =
1111             $self->_try_parse_link_try_determine_url( $wiki_text, $valid_characters,
1112             $i, $size_search );
1113 5 50       11 if ( !$got_url ) {
1114 0         0 return ( 0, $i, $buffer );
1115             }
1116              
1117 5         12 ( $output, $buffer ) =
1118             $self->_save_before_new_element( $output, $buffer, $options );
1119              
1120 5         12 for ( $i = $i + $size_search + 1 ; $i < length $wiki_text ; $i++ ) {
1121 71 100       78 last if $self->_try_parse_link_find_end_title( $wiki_text, $i );
1122 66         61 my $need_next;
1123 66         66 ( $need_next, $i, $buffer ) =
1124             $self->_try_parse_nowiki( $output, $wiki_text, $buffer, $i,
1125             $options );
1126 66 100       74 next if $need_next;
1127              
1128 65         80 $buffer .= substr $wiki_text, $i, 1;
1129             }
1130              
1131 5   33     24 my $template = {
1132             type => 'link',
1133             link => $link,
1134             title => $buffer || $link,
1135             };
1136 5         9 push @$output, $template;
1137 5         6 $buffer = '';
1138 5         5 $i += 1;
1139 5         16 return ( 1, $i, $buffer );
1140             }
1141              
1142             sub _try_parse_link_find_end_title {
1143 71     71   68 my ( $self, $wiki_text, $i ) = @_;
1144 71         48 my $searched = ']]';
1145 71         49 my $size_search = length $searched;
1146 71         65 my $last_word = substr $wiki_text, $i, $size_search;
1147 71 100       69 if ( $searched eq $last_word ) {
1148 5         9 return 1;
1149             }
1150 66         74 return 0;
1151             }
1152              
1153             sub _try_parse_template_find_size_name_template {
1154 15     15   17 my ( $self, $wiki_text, $i ) = @_;
1155 15         15 my $size_search;
1156 15         14 for ( $size_search = $MINIMUM_TEMPLATE_SEARCH ; ; $size_search++ ) {
1157 59         51 my $last_word = substr $wiki_text, $i, $size_search;
1158 59 100       124 if ( $last_word !~ /^\{\{[a-zA-Z]+$/x ) {
1159 15         17 last;
1160             }
1161             }
1162 15         21 return $size_search;
1163             }
1164              
1165             sub _try_parse_template {
1166 1798     1798   3282 my ( $self, $output, $wiki_text, $buffer, $i, $options ) = @_;
1167 1798         2197 my $searched = '{{';
1168 1798         2219 my $size_search = length $searched;
1169 1798         2645 my $last_word = substr $wiki_text, $i, $size_search;
1170             my $start_line =
1171 1798         2223 scalar @{ [ split "\n", substr( $wiki_text, 0, $i ) ] };
  1798         4971  
1172 1798 100       3835 if ( $last_word ne $searched ) {
1173 1783         4307 return ( 0, $i, $buffer );
1174             }
1175             $size_search =
1176 15         25 $self->_try_parse_template_find_size_name_template( $wiki_text, $i );
1177 15         13 $size_search--;
1178 15 100       20 if ( $size_search < $MINIMUM_TEMPLATE_SEARCH ) {
1179 4         7 return ( 0, $i, $buffer );
1180             }
1181 11         15 $last_word = substr $wiki_text, $i, $size_search + 2;
1182 11 100       36 if ( $last_word =~ /^\{\{([a-zA-Z]+)}}$/x ) {
1183 4         10 ( $output, $buffer ) =
1184             $self->_save_before_new_element( $output, $buffer, $options );
1185 4         26 push @$output,
1186             {
1187             type => 'template',
1188             template_name => $1,
1189             output => [],
1190             start_line => $start_line,
1191             };
1192 4         9 return ( 1, $i + $size_search + 1, $buffer );
1193             }
1194 7         15 my ( $got_template_name, $template_name ) =
1195             $self->_try_parse_template_get_template_name( $wiki_text, $i,
1196             $size_search );
1197 7 50       11 if ( !$got_template_name ) {
1198 0         0 return ( 0, $i, $buffer );
1199             }
1200              
1201 7         13 ( $output, $buffer ) =
1202             $self->_save_before_new_element( $output, $buffer, $options );
1203              
1204 7         22 my $template = {
1205             type => 'template',
1206             template_name => $template_name,
1207             output => [],
1208             start_line => $start_line,
1209             };
1210 7         9 my $current_buffer = '';
1211 7         5 my $needs_arg = 0;
1212 7         13 for ( $i += $size_search + 1 ; $i < length $wiki_text ; $i++ ) {
1213 98         89 my $searched = '|';
1214 98         62 my $size_search = length $searched;
1215 98         78 my $last_word = substr $wiki_text, $i, $size_search;
1216 98 100       103 if ( $searched eq $last_word ) {
1217 13         11 push @{ $template->{output} }, $current_buffer;
  13         20  
1218 13         8 $current_buffer = '';
1219 13         13 $needs_arg = 1;
1220 13         19 next;
1221             }
1222 85         66 $needs_arg = 0;
1223 85         42 $searched = '}}';
1224 85         67 $size_search = length $searched;
1225 85         72 $last_word = substr $wiki_text, $i, $size_search;
1226 85 100       121 if ( $searched eq $last_word ) {
1227 5         4 push @{ $template->{output} }, $current_buffer;
  5         11  
1228 5         4 $current_buffer = '';
1229 5         5 $i += 1;
1230 5         6 last;
1231             }
1232 80         42 my $needs_next;
1233             ( $needs_next, $i, $current_buffer ) =
1234 80         90 $self->_try_parse_nowiki( $template->{output}, $wiki_text,
1235             $current_buffer, $i, {} );
1236 80 100       100 next if $needs_next;
1237 77         107 $current_buffer .= substr $wiki_text, $i, 1;
1238             }
1239 7 100 100     19 if ( length $current_buffer || $needs_arg ) {
1240 2         3 push @{ $template->{output} }, $current_buffer;
  2         3  
1241 2         2 $current_buffer = '';
1242             }
1243 7         8 push @$output, $template;
1244 7         13 return ( 1, $i, $buffer );
1245             }
1246              
1247             sub _try_parse_template_try_to_interrupt {
1248 0     0   0 my ( $self, $wiki_text, $i ) = @_;
1249 0         0 my $last_word = substr $wiki_text, $i, 2;
1250 0 0       0 if ( $last_word ne "}}" ) {
1251 0         0 return;
1252             }
1253 0         0 return $i + 1;
1254             }
1255              
1256             sub _try_parse_template_get_template_name {
1257 7     7   11 my ( $self, $wiki_text, $i, $size_search ) = @_;
1258 7         10 my $last_word = substr $wiki_text, $i, $size_search + 1;
1259 7 50       18 if ( $last_word =~ /^\{\{([a-zA-Z]+)\|/x ) {
1260 7         23 return ( 1, $1 );
1261             }
1262 0         0 return (0);
1263             }
1264              
1265             sub _try_parse_header {
1266 1432     1432   2636 my ( $self, $output, $wiki_text, $buffer, $i, $options ) = @_;
1267 1432         2213 my $last_char = substr $wiki_text, $i, 1;
1268 1432 100       2631 if ( $last_char ne '=' ) {
1269 1372         3144 return ( 0, $i, $buffer );
1270             }
1271             my $start_line =
1272 60         73 scalar @{ [ split "\n", substr( $wiki_text, 0, $i ) ] };
  60         255  
1273 60         184 ( $output, $buffer ) =
1274             $self->_save_before_new_element( $output, $buffer, $options );
1275 60         147 my $matching = 1;
1276 60         79 while (1) {
1277 196         316 my $last_chars = substr $wiki_text, $i, $matching + 1;
1278 196 100       528 if ( $last_chars ne ( '=' x ( $matching + 1 ) ) ) {
1279 60         120 last;
1280             }
1281 136         161 $matching++;
1282 136 50       228 if ( $matching > $MAX_HX_SIZE ) {
1283 0         0 $matching = $MAX_HX_SIZE;
1284 0         0 last;
1285             }
1286 136 50       252 if ( $i + $matching > length $wiki_text ) {
1287 0         0 $matching--;
1288 0         0 last;
1289             }
1290             }
1291 60         93 $i += $matching;
1292 60         286 my $header = {
1293             hx_level => $matching,
1294             output => [],
1295             type => 'hx',
1296             };
1297 60         145 $header->{start_line} = $start_line;
1298             ( $i, $buffer ) = $self->_parse_in_array(
1299             $header->{output},
1300             $wiki_text,
1301             $i, $buffer,
1302             sub {
1303 496     496   893 my ( $wiki_text, $i ) = @_;
1304 496         899 my $char = substr $wiki_text, $i, 1;
1305 496 100       953 if ( $char eq "\n" ) {
1306 12         23 return $i;
1307             }
1308 484 100       970 if ( $char ne '=' ) {
1309 450         798 return;
1310             }
1311 34         79 for ( ; $i < length $wiki_text ; $i++ ) {
1312 88 100       229 if ( "\n" eq substr $wiki_text, $i, 1 ) {
1313 4         10 return $i;
1314             }
1315              
1316 84 100       213 if ( '=' ne substr $wiki_text, $i, 1 ) {
1317 4         6 return --$i;
1318             }
1319             }
1320 26         56 return $i;
1321             },
1322 60         491 { is_header => 1 }
1323             );
1324 60 50       468 if ( scalar @{ $header->{output} } ) {
  60         174  
1325 60 50       161 if ( !ref $header->{output}[0] ) {
1326 60         484 ( $header->{output}[0] ) = $header->{output}[0] =~ /^\s*(.*?)$/;
1327 60 100       156 if ( !$header->{output}[0] ) {
1328 1         1 @{ $header->{output} } = splice @{ $header->{output} }, 1;
  1         1  
  1         3  
1329             }
1330             }
1331 60         94 my $last_index = -1 + scalar @{ $header->{output} };
  60         125  
1332 60         107 my $last_element = $header->{output}[$last_index];
1333 60 100 66     273 if ( defined $last_element && !ref $last_element ) {
1334             ( $header->{output}[$last_index] ) =
1335 59         291 $header->{output}[$last_index] =~ /^(.*?)\s*$/;
1336 59 100       164 if ( !$header->{output}[$last_index] ) {
1337 1         2 @{ $header->{output} } = splice @{ $header->{output} }, 0,
  1         3  
  1         4  
1338             $last_index;
1339             }
1340             }
1341             }
1342 60         112 push @$output, $header;
1343 60         172 return ( 1, $i, $buffer );
1344             }
1345             1;
1346              
1347             =encoding utf8
1348              
1349             =head1 NAME
1350              
1351             Wiki::JSON - Parse wiki-like articles to a data-structure transformable to JSON.
1352              
1353             =head1 SYNOPSIS
1354              
1355             use Wiki::JSON;
1356              
1357             my $structure = Wiki::JSON->new->parse(<<'EOF');
1358             = This is a wiki title =
1359             '''This is bold'''
1360             ''This is italic''
1361             '''''This is bold and italic'''''
1362             == This is a smaller title, the user can use no more than 6 equal signs ==
1363             ''This is printed without expanding the special characters
1364             * This
1365             * Is
1366             * A
1367             * Bullet
1368             * Point
1369             * List
1370             {{foo|Templates are generated|with their arguments}}
1371             {{stub|This is under heavy development}}
1372             The parser has some quirks == This will generate a title ==
1373             ''' == '' Unterminated syntaxes will still be parsed until the end of file
1374             This is a link to a wiki article: [[Cool Article]]
1375             This is a link to a wiki article with an alias: [[Cool Article|cool article]]
1376             This is a link to a URL with an alias: [[https://example.com/cool-source.html|cool article]]
1377             This is a link to a Image [[File:https:/example.com/img.png|50x50px|frame|This is a caption]]
1378             EOF
1379              
1380             =head1 DESCRIPTION
1381              
1382             A parser for a subset of a mediawiki-like syntax, quirks include some
1383             supposedly inline elements are parsed multi-line like headers, templates*,
1384             italic and bolds.
1385              
1386             =head1 DESCRIPTION
1387              
1388             A parser for a subset of a mediawiki-like syntax, quirks include some
1389             supposedly inline elements are parsed multi-line like headers, templates*,
1390             italic and bolds.
1391              
1392             Lists are only one level and not everything in mediawiki is supported by the
1393             moment.
1394              
1395             =head2 INSTALLING
1396              
1397             cpanm https://github.com/sergiotarxz/Perl-Wiki-JSON.git
1398              
1399             =head2 USING AS A COMMAND
1400              
1401             wiki2json file.wiki > output.json
1402              
1403             =head1 INSTANCE METHODS
1404              
1405             =head2 new
1406              
1407             my $wiki_parser = Wiki::JSON->new;
1408              
1409             =head1 SUBROUTINES/METHODS
1410              
1411             =head2 parse
1412              
1413             my $structure = $wiki_parser->parse($wiki_string);
1414              
1415             Parses the wiki format into a serializable to JSON or YAML Perl data structure.
1416              
1417             =head1 RETURN FROM METHODS
1418              
1419             =head2 parse
1420              
1421             The return is an ArrayRef in which each element is either a string or a HashRef.
1422              
1423             HashRefs can be classified by the key type which can be one of these:
1424              
1425             =head3 hx
1426              
1427             A header to be printed as h1..h6 in HTML, has the following fields:
1428              
1429             =over 4
1430              
1431             =item hx_level
1432              
1433             A number from 1 to 6 defining the header level.
1434              
1435             =item output
1436              
1437             An ArrayRef defined by the return from parse.
1438              
1439             =back
1440              
1441             =head3 template
1442              
1443             A template thought for developer defined expansions of how some data shoudl be represented.
1444              
1445             =over 4
1446              
1447             =item template_name
1448              
1449             The name of the template.
1450              
1451             =item output
1452              
1453             An ArrayRef defined by the return from parse.
1454              
1455             =back
1456              
1457             =head3 bold
1458              
1459             A set of elements that must be represented as bold text.
1460              
1461             =over 4
1462              
1463             =item output
1464              
1465             An ArrayRef defined by the return from parse.
1466              
1467             =back
1468              
1469             =head3 italic
1470              
1471             A set of elements that must be represented as italic text.
1472              
1473             =over 4
1474              
1475             =item output
1476              
1477             An ArrayRef defined by the return from parse.
1478              
1479             =back
1480              
1481             =head3 bold_and_italic
1482              
1483             A set of elements that must be represented as bold and italic text.
1484              
1485             =over 4
1486              
1487             =item output
1488              
1489             An ArrayRef defined by the return from parse.
1490              
1491             =back
1492              
1493             =head3 unordered_list
1494              
1495             A bullet point list.
1496              
1497             =over 4
1498              
1499             =item output
1500              
1501             A ArrayRef of HashRefs from the type list_element.
1502              
1503             =back
1504              
1505             =head3 list_element
1506              
1507             An element in a list, this element must not appear outside of the output element of a list.
1508              
1509             =over 4
1510              
1511             =item output
1512              
1513             An ArrayRef defined by the return from parse.
1514              
1515             =back
1516              
1517             =head3 link
1518              
1519             An URL or a link to other Wiki Article.
1520              
1521             =over 4
1522              
1523             =item link
1524              
1525             The String containing the URL or link to other Wiki Article.
1526              
1527             =item title
1528              
1529             The text that should be used while showing this URL to point the user where it is going to be directed.
1530              
1531             =back
1532              
1533             =head3 image
1534              
1535             An Image, PDF, or Video.
1536              
1537             =over 4
1538              
1539             =item link
1540              
1541             Where to find the File.
1542              
1543             =item caption
1544              
1545             What to show the user if the image is requested to explain to the user what he is seeing.
1546              
1547             =item options
1548              
1549             =back
1550              
1551             Undocumented by the moment.
1552              
1553             =head1 DEPENDENCIES
1554              
1555             The module will pull all the dependencies it needs on install, the minimum supported Perl is v5.38.2.
1556              
1557             =head1 CONFIGURATION AND ENVIRONMENT
1558              
1559             If your OS Perl is too old perlbrew can be used instead.
1560              
1561             =head1 BUGS AND LIMITATIONS
1562              
1563             The author thinks it is possible the parser hanging forever, use it in
1564             a subprocess the program can kill if it takes too long.
1565              
1566             The developer can use fork, waitpid, pipe, and non-blocking IO for that.
1567              
1568             =head1 DIAGNOSTICS
1569              
1570             If a string halting forever this module is found, send it to me in the Github issue tracker.
1571              
1572             =head1 LICENSE AND COPYRIGHT
1573              
1574             Copyright ©Sergiotarxz (2025)
1575              
1576             Licensed under the The GNU General Public License, Version 3, June 2007 L.
1577              
1578             You can use this software under the terms of the GPLv3 license or a new later
1579             version provided by the FSF or the GNU project.
1580              
1581             =head1 INCOMPATIBILITIES
1582              
1583             None known.
1584              
1585             =head1 VERSION
1586              
1587             0.0.x
1588              
1589             =head1 AUTHOR
1590              
1591             Sergio Iglesias
1592              
1593             =head1 SEE ALSO
1594              
1595             Look what is supported and how in the tests: L
1596              
1597             =cut