line
stmt
bran
cond
sub
pod
time
code
1
package Markdown::Perl::BlockParser;
2
3
31
31
194
use strict;
31
85
31
1214
4
31
31
140
use warnings;
31
56
31
1583
5
31
31
150
use utf8;
31
49
31
301
6
31
31
1231
use feature ':5.24';
31
166
31
5814
7
8
31
31
291
use feature 'refaliasing';
31
131
31
1169
9
31
31
174
no warnings 'experimental::refaliasing';
31
109
31
1554
10
11
31
31
156
use Carp;
31
67
31
2380
12
31
31
168
use English;
31
70
31
193
13
31
31
12763
use Hash::Util 'lock_keys_plus';
31
55
31
213
14
31
31
2245
use List::MoreUtils 'first_index';
31
56
31
197
15
31
31
22508
use List::Util 'pairs', 'min';
31
59
31
2515
16
31
31
19267
use Markdown::Perl::HTML 'html_escape', 'decode_entities', 'remove_disallowed_tags';
31
87
31
2653
17
31
31
16171
use Markdown::Perl::Util ':all';
31
92
31
5664
18
31
31
22741
use YAML::Tiny;
31
235048
31
377451
19
20
our $VERSION = '0.02';
21
22
=pod
23
24
=encoding utf8
25
26
=cut
27
28
sub new {
29
# $md must be a reference
30
41203
41203
0
67210
my ($class, $pmarkdown, $md) = @_;
31
32
41203
387561
my $this = bless {
33
pmarkdown => $pmarkdown,
34
blocks => [],
35
blocks_stack => [],
36
paragraph => [],
37
last_line_is_blank => 0,
38
last_line_was_blank => 0,
39
skip_next_block_matching => 0,
40
is_lazy_continuation => 0,
41
md => undef,
42
last_pos => 0,
43
line_ending => '',
44
continuation_re => qr//,
45
linkrefs => {},
46
matched_prefix_size => 0,
47
}, $class;
48
41203
62561
lock_keys_plus(%{$this}, qw(forced_line));
41203
113312
49
50
41203
730561
\$this->{md} = $md; # aliasing to avoid copying the input, does this work? is it useful?
51
52
41203
65676
return $this;
53
}
54
55
# This autoload method allows to call option accessors from the parent object
56
# transparently.
57
my $pkg = __PACKAGE__;
58
59
sub AUTOLOAD { ## no critic (ProhibitAutoloading, RequireArgUnpacking)
60
693502
693502
708310
our $AUTOLOAD; # Automatically populated when the method is called.
61
693502
1873951
$AUTOLOAD =~ s/${pkg}:://;
62
693502
100
1198306
return if $AUTOLOAD eq 'DESTROY';
63
656418
50
1004343
confess "Undefined method ${AUTOLOAD}" unless $AUTOLOAD =~ m/^get_/;
64
656418
694133
my $this = shift @_;
65
656418
1318810
return $this->{pmarkdown}->$AUTOLOAD(@_);
66
}
67
68
my $eol_re = qr/ \r\n | \n | \r /x;
69
70
sub next_line {
71
180493
180493
0
217501
my ($this) = @_;
72
# When we are forcing a line, we don’t recompute the line_ending, but it
73
# should already be correct because the forced one is a substring of the last
74
# line.
75
180493
100
305313
return delete $this->{forced_line} if exists $this->{forced_line};
76
156092
100
330921
return if pos($this->{md}) == length($this->{md});
77
129598
177061
$this->{last_pos} = pos($this->{md});
78
129598
50
615683
$this->{md} =~ m/\G([^\n\r]*)(${eol_re})?/g or confess 'Should not happen';
79
129598
321155
my ($t, $e) = ($1, $2);
80
129598
100
254503
if ($1 =~ /^[ \t]+$/) {
81
1501
100
100
4931
$this->{line_ending} = $t.($e // '') if $this->get_preserve_white_lines;
82
1501
3858
return '';
83
} else {
84
128097
100
100
256318
$this->{line_ending} = $e // ($this->get_force_final_new_line ? "\n" : '');
85
128097
286807
return $t;
86
}
87
}
88
89
sub line_ending {
90
29100
29100
0
33831
my ($this) = @_;
91
29100
73765
return $this->{line_ending};
92
}
93
94
# last_pos should be passed whenever set_pos can be followed by a "return;" in
95
# one of the _do_..._block method (so, if the method fails), to reset the parser
96
# to its previous state, when the pos was manipulated.
97
# TODO: add a better abstraction to save and restore parser state.
98
sub set_pos {
99
22128
22128
0
34402
my ($this, $pos, $last_pos) = @_;
100
22128
44296
pos($this->{md}) = $pos;
101
22128
100
42416
$this->{last_pos} = $last_pos if defined $last_pos;
102
22128
26940
return;
103
}
104
105
sub get_pos {
106
20659
20659
0
25487
my ($this) = @_;
107
20659
33117
return pos($this->{md});
108
}
109
110
sub redo_line {
111
9610
9610
0
12647
my ($this) = @_;
112
9610
50
16820
confess 'Cannot push back more than one line' unless exists $this->{last_pos};
113
9610
24328
$this->set_pos(delete $this->{last_pos});
114
9610
11076
return;
115
}
116
117
# Takes a string and converts it to HTML. Can be called as a free function or as
118
# class method. In the latter case, provided options override those set in the
119
# class constructor.
120
# Both the input and output are unicode strings.
121
sub process {
122
17563
17563
0
27541
my ($this) = @_;
123
17563
45350
pos($this->{md}) = 0;
124
125
# https://spec.commonmark.org/0.30/#characters-and-lines
126
# TODO: The spec asks for this, however we can’t apply it, because md is a
127
# reference to the value passed by the user and we don’t want to modify it (it
128
# may even be a read-only value). I’m too lazy to find another place to
129
# implement this behavior.
130
# $this->{md} =~ s/\000/\xfffd/g;
131
132
# https://spec.commonmark.org/0.30/#tabs
133
# TODO: nothing to do at this stage.
134
135
# https://spec.commonmark.org/0.30/#backslash-escapes
136
# https://spec.commonmark.org/0.30/#entity-and-numeric-character-references
137
# Done at a later stage, as escaped characters don’t have their Markdown
138
# meaning, we need a way to represent that.
139
140
17563
100
87208
$this->_parse_yaml_metadata() if $this->get_parse_file_metadata eq 'yaml';
141
142
17562
44043
while (defined (my $l = $this->next_line())) {
143
# This field might be set to true at the beginning of the processing, while
144
# we’re looking at the conditions of the currently open containers.
145
125322
153156
$this->{is_lazy_continuation} = 0;
146
125322
184868
$this->_parse_blocks($l);
147
}
148
17562
38649
$this->_finalize_paragraph();
149
17562
19682
while (@{$this->{blocks_stack}}) {
24864
44384
150
7302
14974
$this->_restore_parent_block();
151
}
152
17562
57580
return delete $this->{linkrefs}, delete $this->{blocks};
153
}
154
155
# The $force_loose_test parameter is used when we are actually starting a new
156
# block. In that case, or if we are actually after a paragraph, then we possibly
157
# convert the enclosing list to a loose list.
158
# TODO: the logic to decide if a list is loose is extremely complex and split in
159
# many different place. It would be great to rewrite it in a simpler way.
160
sub _finalize_paragraph {
161
125561
125561
175350
my ($this, $force_loose_test) = @_;
162
125561
100
100
117953
if (@{$this->{paragraph}} || $force_loose_test) {
125561
279915
163
87821
100
145945
if ($this->{last_line_was_blank}) {
164
5889
100
100
7045
if (@{$this->{blocks_stack}}
5889
15130
165
&& $this->{blocks_stack}[-1]{block}{type} eq 'list_item') {
166
133
265
$this->{blocks_stack}[-1]{block}{loose} = 1;
167
}
168
}
169
}
170
125561
100
124683
return unless @{$this->{paragraph}};
125561
185973
171
54574
56677
push @{$this->{blocks}}, {type => 'paragraph', content => $this->{paragraph}};
54574
168272
172
54574
87501
$this->{paragraph} = [];
173
54574
66085
return;
174
}
175
176
# Whether the list_item match the most recent list (should we add to the same
177
# list or create a new one).
178
sub _list_match {
179
35781
35781
46083
my ($this, $item) = @_;
180
35781
100
34111
return 0 unless @{$this->{blocks}};
35781
78115
181
25835
38502
my $list = $this->{blocks}[-1];
182
return
183
$list->{type} eq 'list'
184
&& $list->{style} eq $item->{style}
185
25835
100
98912
&& $list->{marker} eq $item->{marker};
186
}
187
188
sub _add_block {
189
37102
37102
49878
my ($this, $block) = @_;
190
37102
100
67324
if ($block->{type} eq 'list_item') {
191
16915
32572
$this->_finalize_paragraph(0);
192
# https://spec.commonmark.org/0.30/#lists
193
16915
100
32501
if ($this->_list_match($block)) {
194
2560
3274
push @{$this->{blocks}[-1]{items}}, $block;
2560
6501
195
2560
100
9344
$this->{blocks}[-1]{loose} ||= $block->{loose};
196
} else {
197
my $list = {
198
type => 'list',
199
style => $block->{style},
200
marker => $block->{marker},
201
start_num => $block->{num},
202
items => [$block],
203
loose => $block->{loose}
204
14355
74624
};
205
14355
16961
push @{$this->{blocks}}, $list;
14355
28557
206
}
207
} else {
208
20187
41026
$this->_finalize_paragraph(1);
209
20187
22176
push @{$this->{blocks}}, $block;
20187
33939
210
}
211
37102
44902
return;
212
}
213
214
# Anything passed to $prefix_re must necessary accept an empty string unless the
215
# block cannot accept lazy continuations. This is a best effort simulation of
216
# the block condition, to be used for some complex multi-line constructs that
217
# are parsed through a single regex.
218
sub _enter_child_block {
219
30824
30824
55666
my ($this, $new_block, $cond, $prefix_re, $forced_next_line) = @_;
220
30824
61032
$this->_finalize_paragraph(1);
221
30824
100
43800
if (defined $forced_next_line) {
222
28260
47603
$this->{forced_line} = $forced_next_line;
223
}
224
30824
126337
push @{$this->{blocks_stack}}, {
225
cond => $cond,
226
block => $new_block,
227
parent_blocks => $this->{blocks},
228
continuation_re => $this->{continuation_re}
229
30824
38713
};
230
30824
364123
$this->{continuation_re} = qr/$this->{continuation_re} $prefix_re/x;
231
30824
50443
$this->{blocks} = [];
232
30824
39954
return;
233
}
234
235
sub _restore_parent_block {
236
26700
26700
39048
my ($this) = @_;
237
# TODO: rename the variables here with something better.
238
26700
28819
my $last_block = pop @{$this->{blocks_stack}};
26700
35680
239
26700
37775
my $block = delete $last_block->{block};
240
# TODO: maybe rename content to blocks here.
241
26700
53991
$block->{content} = $this->{blocks};
242
26700
38129
$this->{blocks} = delete $last_block->{parent_blocks};
243
26700
52938
$this->{continuation_re} = delete $last_block->{continuation_re};
244
26700
55053
$this->_add_block($block);
245
26700
151978
return;
246
}
247
248
# Returns true if $l would be parsed as the continuation of a paragraph in the
249
# context of $this (which is not modified).
250
sub _test_lazy_continuation {
251
30109
30109
45383
my ($this, $l) = @_;
252
30109
100
29341
return unless @{$this->{paragraph}};
30109
63501
253
23640
59807
my $tester = new(ref($this), $this->{pmarkdown}, \'');
254
23640
50542
pos($tester->{md}) = 0;
255
# What is a paragraph depends on whether we already have a paragraph or not.
256
23640
50
31785
$tester->{paragraph} = [@{$this->{paragraph}} ? ('foo') : ()];
23640
63321
257
# We use this field both in the tester and in the actual object when we
258
# matched a lazy continuation.
259
23640
28891
$tester->{is_lazy_continuation} = 1;
260
# We’re ignoring the eol of the original line as it should not affect parsing.
261
23640
48929
$tester->_parse_blocks($l);
262
# BUG: there is a bug here which is that a construct like a fenced code block
263
# or a link ref definition, whose validity depends on more than one line,
264
# might be misclassified. The probability of that is low.
265
23640
100
25811
if (@{$tester->{paragraph}}) {
23640
40391
266
12866
16442
$this->{is_lazy_continuation} = 1;
267
12866
56110
return 1;
268
}
269
10774
45131
return 0;
270
}
271
272
sub _count_matching_blocks {
273
153238
153238
189946
my ($this, $lr) = @_; # $lr is a scalar *reference* to the current line text.
274
153238
167499
$this->{matched_prefix_size} = 0;
275
153238
148445
for my $i (0 .. $#{$this->{blocks_stack}}) {
153238
335355
276
38901
70297
local *::_ = $lr;
277
38901
71742
my $r = $this->{blocks_stack}[$i]{cond}();
278
38901
100
100
105422
$this->{matched_prefix_size} += $r if defined $r && $r > 0; # $r < 0 means match but no prefix.
279
38901
100
96897
return $i unless $r;
280
}
281
133438
146799
return @{$this->{blocks_stack}};
133438
230840
282
}
283
284
sub _all_blocks_match {
285
28677
28677
35996
my ($this, $lr) = @_;
286
28677
26941
return @{$this->{blocks_stack}} == $this->_count_matching_blocks($lr);
28677
46736
287
}
288
289
my $thematic_break_re = qr/^\ {0,3} (?: (?:-[ \t]*){3,} | (_[ \t]*){3,} | (\*[ \t]*){3,} ) $/x;
290
my $block_quotes_re = qr/^ {0,3}>/;
291
my $indented_code_re = qr/^(?: {0,3}\t| {4})/;
292
my $list_item_marker_re = qr/ [-+*] | (?\d{1,9}) (?[.)])/x;
293
my $list_item_re =
294
qr/^ (?\ {0,3}) (?${list_item_marker_re}) (?(?:[ \t].*)?) $/x;
295
my $supported_html_tags = join('|',
296
qw(address article aside base basefont blockquote body caption center col colgroup dd details dialog dir div dl dt fieldset figcaption figure footer form frame frameset h1 h2 h3 h4 h5 h6 head header hr html iframe legend li link main menu menuitem nav noframes ol optgroup option p param search section summary table tbody td tfoot th thead title tr track ul)
297
);
298
299
my $directive_name_re = qr/(? [-\w]+ )?/x;
300
my $directive_content_re = qr/(?: \s* \[ (? [^\]]+ ) \] )?/x;
301
my $directive_attribute_re = qr/(?: \s* \{ (? .* ) \} )?/x;
302
my $directive_data_re = qr/${directive_name_re} ${directive_content_re} ${directive_attribute_re}/x;
303
my $directive_block_re = qr/^\ {0,3} (? :{3,} ) \s* ${directive_data_re} \s* :* \s* $/x;
304
305
# TODO: Share these regex with the Inlines.pm file that has a copy of them.
306
my $html_tag_name_re = qr/[a-zA-Z][-a-zA-Z0-9]*/;
307
my $html_attribute_name_re = qr/[a-zA-Z_:][-a-zA-Z0-9_.:]*/;
308
# We include new lines in these regex as the spec mentions them, but we can’t
309
# match them for now as the regex will see lines one at a time.
310
my $html_space_re = qr/\n[ \t]*|[ \t][ \t]*\n?[ \t]*/; # Spaces, tabs, and up to one line ending.
311
my $opt_html_space_re = qr/[ \t]*\n?[ \t]*/; # Optional spaces.
312
my $html_attribute_value_re = qr/ [^ \t\n"'=<>`]+ | '[^']*' | "[^"]*" /x;
313
my $html_attribute_re =
314
qr/ ${html_space_re} ${html_attribute_name_re} (?: ${opt_html_space_re} = ${opt_html_space_re} ${html_attribute_value_re} )? /x;
315
my $html_open_tag_re =
316
qr/ < ${html_tag_name_re} ${html_attribute_re}* ${opt_html_space_re} \/? > /x;
317
my $html_close_tag_re = qr/ <\/ ${html_tag_name_re} ${opt_html_space_re} > /x;
318
319
# Parse at least one line of text to build a new block; and possibly several
320
# lines, depending on the block type.
321
# https://spec.commonmark.org/0.30/#blocks-and-inlines
322
our $l; # global variable, localized during the call to _parse_blocks.
323
324
sub _parse_blocks { ## no critic (RequireArgUnpacking)
325
148962
148962
191209
my $this = shift @_;
326
# TODO do the localization in process to avoid the copy (but this will need
327
# change in the continuation tester).
328
148962
195672
local $l = shift @_; ## no critic (ProhibitLocalVars)
329
330
148962
100
219597
if (!$this->{skip_next_block_matching}) {
331
124561
200917
my $matched_block = $this->_count_matching_blocks(\$l);
332
124561
100
135253
if (@{$this->{blocks_stack}} > $matched_block) {
124561
215620
333
18145
35610
$this->_finalize_paragraph();
334
18145
21370
while (@{$this->{blocks_stack}} > $matched_block) {
37543
64184
335
19398
31667
$this->_restore_parent_block();
336
}
337
}
338
} else {
339
24401
29092
$this->{skip_next_block_matching} = 0;
340
}
341
342
# There are two different cases. The first one, handled here, is when we have
343
# multiple blocks inside a list item separated by a blank line. The second
344
# case (when the list items themselves are separated by a blank line) is
345
# handled when parsing the list item itself (based on the last_line_was_blank
346
# setting).
347
148962
100
234660
if ($this->{last_line_is_blank}) {
348
15205
100
100
16433
if (@{$this->{blocks_stack}}
15205
34288
349
&& $this->{blocks_stack}[-1]{block}{type} eq 'list_item') {
350
# $this->{blocks_stack}[-1]{block}{loose} = 1;
351
}
352
}
353
148962
202836
$this->{last_line_was_blank} = $this->{last_line_is_blank};
354
148962
192502
$this->{last_line_is_blank} = 0;
355
356
148962
50
100
214475
_do_atx_heading($this)
100
100
100
100
100
100
100
100
100
100
100
100
66
357
|| ($this->get_use_setext_headings && _do_setext_heading($this))
358
# Thematic breaks are described first in the spec, but the setext headings has
359
# precedence in case of conflict, so we test for the break after the heading.
360
|| _do_thematic_break($this)
361
|| _do_indented_code_block($this)
362
|| ($this->get_use_fenced_code_blocks && _do_fenced_code_block($this))
363
|| _do_html_block($this)
364
|| _do_block_quotes($this)
365
|| _do_list_item($this)
366
|| _do_directive_block($this)
367
|| _do_link_reference_definition($this)
368
|| ($this->get_use_table_blocks && _do_table_block($this))
369
|| _do_paragraph($this)
370
|| croak "Current line could not be parsed as anything: $l";
371
148962
401545
return;
372
}
373
374
sub _load_yaml_module {
375
1
1
3
my ($module_name) = @_;
376
1
50
203
if (!eval "require $module_name; 1") { ## no critic (BuiltinFunctions::ProhibitStringyEval)
377
0
0
croak "Cannot load module $module_name: ${EVAL_ERROR}";
378
}
379
1
12
return;
380
}
381
382
sub _call_yaml_parser {
383
9
9
70
my ($this, $yaml) = @_;
384
9
50
my $parser = $this->get_yaml_parser;
385
9
16
my $metadata;
386
9
100
33
74
if ($parser eq 'YAML::Tiny') {
50
387
8
17
return eval { YAML::Tiny->read_string($yaml)->[0] };
8
53
388
} elsif ($parser eq 'YAML::PP' || $parser eq 'YAML::PP::LibYAML') {
389
1
6
_load_yaml_module($parser);
390
1
2
return eval { ($parser->new()->load_string($yaml))[0] };
1
7
391
}
392
0
0
croak "Unsupported YAML parser: $parser";
393
}
394
395
sub _parse_yaml_metadata {
396
4235
4235
7216
my ($this) = @_;
397
398
# At this point, pos(md) is guaranteed to be 0.
399
4235
100
14988
my $line_re = $this->get_yaml_file_metadata_allows_empty_lines ? qr/.*\n/ : qr/.+\n/;
400
4235
100
25595
if ($this->{md} =~ m/ ^ ---\n (? (?: $line_re )+? ) (?: --- | \.\.\. ) \n /gxc) { ## no critic (ProhibitUnusedCapture)
401
9
59
my $metadata = $this->_call_yaml_parser($+{YAML});
402
9
100
9519
if ($EVAL_ERROR) {
403
2
8
pos($this->{md}) = 0;
404
2
50
21
carp 'YAML Metadata (Markdown frontmatter) is invalid' if $this->get_warn_for_unused_input();
405
2
19
return;
406
}
407
7
100
42
if (exists($this->{pmarkdown}{hooks}{yaml_metadata})) {
408
5
31
$this->{pmarkdown}{hooks}{yaml_metadata}->($metadata);
409
}
410
}
411
4232
23209
return;
412
}
413
414
# https://spec.commonmark.org/0.30/#atx-headings
415
sub _do_atx_heading {
416
148962
148962
173837
my ($this) = @_;
417
148962
100
281003
if ($l =~ /^ \ {0,3} (\#{1,6}) (?:[ \t]+(.+?))?? (?:[ \t]+\#+)? [ \t]* $/x) {
418
# Note: heading breaks can interrupt a paragraph or a list
419
# TODO: the content of the header needs to be interpreted for inline content.
420
590
100
3886
$this->_add_block({
421
type => 'heading',
422
level => length($1),
423
content => $2 // '',
424
debug => 'atx'
425
});
426
590
1223
return 1;
427
}
428
148372
532082
return;
429
}
430
431
# https://spec.commonmark.org/0.30/#setext-headings
432
sub _do_setext_heading {
433
103642
103642
124653
my ($this) = @_;
434
103642
100
481945
return unless $l =~ /^ {0,3}(-+|=+)[ \t]*$/;
435
1587
100
66
1989
if ( !@{$this->{paragraph}}
1587
100
5410
436
|| indent_size($this->{paragraph}[0]) >= 4
437
|| $this->{is_lazy_continuation}) {
438
1065
3385
return;
439
}
440
# TODO: this should not interrupt a list if the heading is just one -
441
522
1437
my $c = substr $1, 0, 1;
442
522
754
my $p = $this->{paragraph};
443
522
1788
my $m = $this->get_multi_lines_setext_headings;
444
522
100
66
2696
if ($m eq 'single_line' && @{$p} > 1) {
1
100
66
2
100
445
1
2
my $last_line = pop @{$p};
1
2
446
1
4
$this->_finalize_paragraph();
447
1
3
$p = [$last_line];
448
} elsif ($m eq 'break' && $l =~ m/${thematic_break_re}/) {
449
1
16
$this->_finalize_paragraph();
450
1
5
$this->_add_block({type => 'break', debug => 'setext_as_break'});
451
1
3
return 1;
452
} elsif ($m eq 'ignore') {
453
# TODO: maybe we should just do nothing and return 0 here.
454
1
2
push @{$this->{paragraph}}, $l;
1
2
455
1
3
return 1;
456
}
457
520
957
$this->{paragraph} = [];
458
520
100
3271
$this->_add_block({
459
type => 'heading',
460
level => ($c eq '=' ? 1 : 2),
461
content => $p,
462
debug => 'setext'
463
});
464
520
1649
return 1;
465
}
466
467
# https://spec.commonmark.org/0.30/#thematic-breaks
468
sub _do_thematic_break {
469
147850
147850
175550
my ($this) = @_;
470
147850
100
583537
if ($l !~ /${thematic_break_re}/) {
471
147558
358291
return;
472
}
473
292
1344
$this->_add_block({type => 'break', debug => 'native_break'});
474
292
753
return 1;
475
}
476
477
# https://spec.commonmark.org/0.30/#indented-code-blocks
478
sub _do_indented_code_block {
479
147558
147558
172423
my ($this) = @_;
480
# Indented code blocks cannot interrupt a paragraph.
481
147558
100
100
139316
if (@{$this->{paragraph}} || $l !~ m/${indented_code_re}/) {
147558
447628
482
146419
528723
return;
483
}
484
1139
4434
my $convert_tabs = $this->get_code_blocks_convert_tabs_to_spaces;
485
1139
100
5133
tabs_to_space($l, $this->{matched_prefix_size}) if $convert_tabs;
486
1139
2798
my @code_lines = scalar(remove_prefix_spaces(4, $l.$this->line_ending()));
487
1139
1810
my $count = 1; # The number of lines we have read
488
1139
1432
my $valid_count = 1; # The number of lines we know are in the code block.
489
1139
2291
my $valid_pos = $this->get_pos();
490
1139
2188
while (defined (my $nl = $this->next_line())) {
491
1239
100
2508
if ($this->_all_blocks_match(\$nl)) {
492
994
1224
$count++;
493
994
100
4846
if ($nl =~ m/${indented_code_re}/) {
100
494
49
104
$valid_pos = $this->get_pos();
495
49
71
$valid_count = $count;
496
49
100
115
tabs_to_space($nl, $this->{matched_prefix_size}) if $convert_tabs;
497
49
136
push @code_lines, scalar(remove_prefix_spaces(4, $nl.$this->line_ending()));
498
} elsif ($nl eq '') {
499
244
628
push @code_lines, scalar(remove_prefix_spaces(4, $nl.$this->line_ending(), !$convert_tabs));
500
} else {
501
701
1350
last;
502
}
503
} else {
504
245
475
last;
505
}
506
}
507
1139
2261
splice @code_lines, $valid_count;
508
1139
2717
$this->set_pos($valid_pos);
509
1139
2821
my $code = join('', @code_lines);
510
1139
5011
$this->_add_block({type => 'code', content => $code, debug => 'indented'});
511
1139
3409
return 1;
512
}
513
514
# https://spec.commonmark.org/0.30/#fenced-code-blocks
515
sub _do_fenced_code_block {
516
109809
109809
129675
my ($this) = @_;
517
109809
100
445705
return unless $l =~ /^ (?\ {0,3}) (?`{3,}|~{3,}) [ \t]* (?.*?) [ \t]* $/x; ## no critic (ProhibitComplexRegexes)
518
10123
55773
my $f = substr $+{fence}, 0, 1;
519
10123
100
100
51294
if ($f eq '`' && index($+{info}, '`') != -1) {
520
1588
4809
return;
521
}
522
8535
22533
my $fl = length($+{fence});
523
8535
20619
my $info = $+{info};
524
8535
20502
my $indent = length($+{indent});
525
# This is one of the few case where we need to process character escaping
526
# outside of the full inlines rendering process.
527
# TODO: Consider if it would be cleaner to do it inside the render_html method.
528
8535
15347
$info =~ s/\\(\p{PosixPunct})/$1/g;
529
# The spec does not describe what we should do with fenced code blocks inside
530
# other containers if we don’t match them.
531
8535
9454
my @code_lines; # The first line is not part of the block.
532
8535
11319
my $end_fence_seen = 0;
533
8535
16930
my $start_pos = $this->get_pos();
534
8535
15467
while (defined (my $nl = $this->next_line())) {
535
22167
100
34342
if ($this->_all_blocks_match(\$nl)) {
536
21372
100
72143
if ($nl =~ m/^ {0,3}${f}{$fl,}[ \t]*$/) {
537
404
657
$end_fence_seen = 1;
538
404
828
last;
539
} else {
540
# We’re adding one line to the fenced code block
541
20968
34019
push @code_lines, scalar(remove_prefix_spaces($indent, $nl.$this->line_ending()));
542
}
543
} else {
544
# We’re out of our enclosing block and we haven’t seen the end of the
545
# fence. If we accept enclosed fence, then that last line must be tried
546
# again (and, otherwise, we will start again from start_pos).
547
795
100
3210
$this->redo_line() if !$this->get_fenced_code_blocks_must_be_closed;
548
795
1667
last;
549
}
550
}
551
552
8535
100
100
33352
if (!$end_fence_seen && $this->get_fenced_code_blocks_must_be_closed) {
553
3496
8317
$this->set_pos($start_pos);
554
3496
13443
return;
555
}
556
5039
13628
my $code = join('', @code_lines);
557
5039
23508
$this->_add_block({
558
type => 'code',
559
content => $code,
560
info => $info,
561
debug => 'fenced'
562
});
563
5039
20558
return 1;
564
}
565
566
# https://spec.commonmark.org/0.31.2/#html-blocks
567
sub _do_html_block {
568
141380
141380
175509
my ($this) = @_;
569
# HTML blocks can interrupt a paragraph.
570
# TODO: add an option so that they don’t interrupt a paragraph (make it be
571
# the default?).
572
# TODO: PERF: test that $l =~ m/^ {0,3} to short circuit all these regex.
573
141380
138056
my $html_end_condition;
574
141380
100
100
804838
if ($l =~ m/ ^\ {0,3} < (?:pre|script|style|textarea) (?:\ |\t|>|$) /x) {
100
100
100
100
100
100
575
16
47
$html_end_condition = qr/ <\/ (?:pre|script|style|textarea) > /x;
576
} elsif ($l =~ m/^ {0,3}/;
578
} elsif ($l =~ m/^ {0,3}<\?/) {
579
2
9
$html_end_condition = qr/\?>/;
580
} elsif ($l =~ m/^ {0,3}
581
2
35
$html_end_condition = qr/=>/;
582
} elsif ($l =~ m/^ {0,3}
583
2
8
$html_end_condition = qr/]]>/;
584
} elsif ($l =~ m/^\ {0,3} < \/? (?:${supported_html_tags}) (?:\ |\t|\/?>|$) /x) {
585
2759
6501
$html_end_condition = qr/^$/; ## no critic (ProhibitFixedStringMatches)
586
138589
521795
} elsif (!@{$this->{paragraph}}
587
&& $l =~ m/^\ {0,3} (?: ${html_open_tag_re} | ${html_close_tag_re} ) [ \t]* $ /x) {
588
# TODO: the spec seem to say that the tag can take more than one line, but
589
# this is not tested, so we don’t implement this for now.
590
23
85
$html_end_condition = qr/^$/; ## no critic (ProhibitFixedStringMatches)
591
}
592
# TODO: Implement rule 7 about any possible tag.
593
141380
100
209993
if (!$html_end_condition) {
594
138566
320181
return;
595
}
596
# TODO: see if some code could be shared with the code blocks
597
2814
6526
my @html_lines = $l.$this->line_ending();
598
# TODO: add an option to not parse a tag if it’s closing condition is never
599
# seen.
600
2814
100
10394
if ($l !~ m/${html_end_condition}/) {
601
# The end condition can occur on the opening line.
602
2804
5390
while (defined (my $nl = $this->next_line())) {
603
5271
100
8881
if ($this->_all_blocks_match(\$nl)) {
604
4656
100
13801
if ($nl !~ m/${html_end_condition}/) {
100
605
3870
5849
push @html_lines, $nl.$this->line_ending();
606
} elsif ($nl eq '') {
607
# This can only happen for rules 6 and 7 where the end condition
608
# line is not part of the HTML block.
609
770
1989
$this->redo_line();
610
770
1520
last;
611
} else {
612
16
153
push @html_lines, $nl.$this->line_ending();
613
16
39
last;
614
}
615
} else {
616
615
1441
$this->redo_line();
617
615
1149
last;
618
}
619
}
620
}
621
2814
7728
my $html = join('', @html_lines);
622
2814
8554
remove_disallowed_tags($html, $this->get_disallowed_html_tags);
623
2814
11451
$this->_add_block({type => 'html', content => $html});
624
2814
10647
return 1;
625
}
626
627
# https://spec.commonmark.org/0.30/#block-quotes
628
sub _do_block_quotes {
629
138566
138566
163447
my ($this) = @_;
630
138566
100
509490
return unless $l =~ /${block_quotes_re}/;
631
# TODO: handle laziness (block quotes where the > prefix is missing)
632
my $cond = sub {
633
27181
100
27181
102933
if (s/(${block_quotes_re})/' ' x length($1)/e) {
13908
55466
634
# We remove the '>' character that we replaced by a space, and the
635
# optional space after it. We’re using this approach to correctly handle
636
# the case of a line like '>\t\tfoo' where we need to retain the 6
637
# spaces of indentation, to produce a code block starting with two
638
# spaces.
639
13908
14532
my $m;
640
13908
38885
($_, $m) = remove_prefix_spaces(length($1) + 1, $_);
641
# Returns the matched horizontal size.
642
13908
30986
return $m;
643
}
644
13273
22140
return $this->_test_lazy_continuation($_);
645
11884
54255
};
646
{
647
11884
15995
local *::_ = \$l;
11884
21120
648
11884
22070
$this->{matched_prefix_size} += $cond->();
649
}
650
11884
17870
$this->{skip_next_block_matching} = 1;
651
11884
54962
$this->_enter_child_block({type => 'quotes'}, $cond, qr/ {0,3}(?:> ?)?/, $l);
652
11884
39174
return 1;
653
}
654
655
# https://spec.commonmark.org/0.30/#list-items
656
sub _do_list_item {
657
126682
126682
156062
my ($this) = @_;
658
126682
100
551509
return unless $l =~ m/${list_item_re}/;
659
# There is a note in the spec on thematic breaks that are not list items,
660
# it’s not exactly clear what is intended, and there are no examples.
661
24366
280412
my ($indent_outside, $marker, $text, $digits, $symbol) = @+{qw(indent marker text digits symbol)};
662
24366
67310
my $indent_marker = length($indent_outside) + length($marker);
663
24366
100
66722
my $type = $marker =~ m/[-+*]/ ? 'ul' : 'ol';
664
# The $indent_marker is passed in case the text starts with tabs, to properly
665
# compute the tab stops. This is better than nothing but won’t work inside
666
# other container blocks. In all cases, using tabs instead of space should not
667
# be encouraged.
668
24366
61597
my $text_indent = indent_size($text, $indent_marker + $this->{matched_prefix_size});
669
# When interrupting a paragraph, the rules are stricter.
670
24366
73813
my $mode = $this->get_lists_can_interrupt_paragraph;
671
24366
100
29327
if (@{$this->{paragraph}}) {
24366
40585
672
12920
100
25792
return if $mode eq 'never';
673
12914
100
100
26766
if ($mode eq 'within_list'
100
674
&& !(@{$this->{blocks_stack}} && $this->{blocks_stack}[-1]{block}{type} eq 'list_item')) {
675
5415
21403
return;
676
}
677
7499
100
100
38235
if ($mode eq 'strict' && ($text eq '' || ($type eq 'ol' && $digits != 1))) {
100
678
79
446
return;
679
}
680
}
681
18866
50
66
58647
return if $text ne '' && $text_indent == 0;
682
# in the current implementation, $text_indent is enough to know if $text
683
# is matching $indented_code_re, but let’s not depend on that.
684
18866
40491
my $first_line_blank = $text =~ m/^[ \t]*$/;
685
18866
100
48754
my $discard_text_indent = $first_line_blank || indented(4 + 1, $text); # 4 + 1 is an indented code block, plus the required space after marker.
686
18866
100
30873
my $indent_inside = $discard_text_indent ? 1 : $text_indent;
687
18866
21342
my $indent = $indent_inside + $indent_marker;
688
my $cond = sub {
689
23439
100
100
23439
50168
if ($first_line_blank && m/^[ \t]*$/) {
690
# A list item can start with at most one blank line
691
287
493
return 0;
692
} else {
693
23152
27605
$first_line_blank = 0;
694
}
695
23152
100
49259
if (indent_size($_) >= $indent) {
696
631
1331
$_ = remove_prefix_spaces($indent, $_);
697
# Returns the matched horizontal size.
698
631
1304
return $indent;
699
}
700
# TODO: we probably don’t need to test the list_item_re case here, just
701
# the lazy continuation and the emptiness is enough.
702
22521
100
122233
return (!m/${list_item_re}/ && $this->_test_lazy_continuation($_))
703
|| $_ eq '';
704
18866
70747
};
705
18866
24915
my $forced_next_line = undef;
706
18866
100
30592
if (!$first_line_blank) {
707
# We are doing a weird compensation for the fact that we are not
708
# processing the condition and to correctly handle the case where the
709
# list marker was followed by tabs.
710
16376
49247
$forced_next_line = remove_prefix_spaces($indent, (' ' x $indent_marker).$text);
711
16376
26497
$this->{matched_prefix_size} = $indent;
712
16376
22612
$this->{skip_next_block_matching} = 1;
713
}
714
# Note that we are handling the creation of the lists themselves in the
715
# _add_block method. See https://spec.commonmark.org/0.30/#lists for
716
# reference.
717
# TODO: handle tight and loose lists.
718
18866
66
88719
my $item = {
100
719
type => 'list_item',
720
style => $type,
721
marker => $symbol // $marker,
722
num => int($digits // 1),
723
};
724
$item->{loose} =
725
18866
100
37117
$this->_list_match($item) && $this->{last_line_was_blank};
726
18866
199321
$this->_enter_child_block($item, $cond, qr/ {0,${indent}}/, $forced_next_line);
727
18866
86725
return 1;
728
}
729
730
# https://talk.commonmark.org/t/generic-directives-plugins-syntax/444
731
# See also https://github.com/mkende/pmarkdown/issues/5
732
sub _do_directive_block {
733
107816
107816
127157
my ($this) = @_;
734
107816
100
279528
return unless $this->get_use_directive_blocks();
735
# marker, name, content, attributes
736
32509
100
142930
return unless $l =~ /${directive_block_re}/; # TODO: add an option to allow this block type.
737
74
489
my $lm = length($+{marker});
738
my $cond = sub {
739
165
100
165
1240
if (m/^\ {0,3} :{$lm,} \s* $/x) {
740
12
26
$_ = '';
741
12
26
return 0;
742
}
743
153
241
return -1;
744
74
346
};
745
# At rendering time, a hook should be able to intercept the name and
746
# attributes of the directive to do fancy things with it.
747
$this->_enter_child_block({
748
type => 'directive',
749
name => $+{name},
750
inline => $+{content},
751
attributes => $+{attributes}
752
},
753
74
1067
$cond,
754
qr/ {0,3}/); # Unclear if we need the continuation prefix here.
755
74
360
return 1;
756
}
757
758
# https://spec.commonmark.org/0.31.2/#link-reference-definitions
759
sub _do_link_reference_definition {
760
107742
107742
128001
my ($this) = @_;
761
# Link reference definitions cannot interrupt paragraphs
762
#
763
# This construct needs to be parsed across multiple lines, so we are directly
764
# using the {md} string rather than our parsed $l line
765
# TODO: another maybe much simpler approach would be to parse the block as a
766
# normal paragraph but immediately try to parse the content as a link
767
# reference definition (and otherwise to keep it as a normal paragraph).
768
# That would allow to use the higher lever InlineTree parsing constructs.
769
107742
100
100
103365
return if @{$this->{paragraph}} || $l !~ m/^ {0,3}\[/;
107742
472719
770
2850
5060
my $last_pos = $this->{last_pos};
771
2850
6513
my $init_pos = $this->get_pos();
772
2850
7272
$this->redo_line();
773
2850
4698
my $start_pos = $this->get_pos();
774
775
# We consume the continuation prefix of enclosing blocks. Note that in the big
776
# regex we allow any number of space after the continuation because it’s what
777
# cmark does.
778
2850
4636
my $cont = $this->{continuation_re};
779
2850
50
21974
confess 'Unexpected regex match failure' unless $this->{md} =~ m/\G${cont}/g;
780
781
# TODO:
782
# - Support for escaped or balanced parenthesis in naked destination
783
# - break this up in smaller pieces and test them independently.
784
# - The need to disable ProhibitUnusedCapture seems to be buggy...
785
# - most of the regex parses only \n and not other eol sequence. The regex
786
# should either be fixed or the entry be normalized.
787
## no critic (ProhibitComplexRegexes, ProhibitUnusedCapture)
788
2850
100
172299
if (
789
$this->{md} =~ m/\G
790
\ {0,3} \[
791
(?>(? # The link label (in square brackets), matched as an atomic group
792
(?:
793
[^\\\[\]]{0,100} (?:(?:\\\\)* \\ .)? # The label cannot contain unescaped ]
794
# With 5.38 this could be (?(*{ ...}) (*FAIL)) which will be more efficient.
795
1705
21504
(*COMMIT) (?(?{ pos() > $start_pos + 1004 }) (*FAIL) ) # As our block can be repeated, we prune the search when we are far enough.
796
)+
797
)) \]:
798
[ \t]* (?:\n ${cont})? [ \t]* # optional spaces and tabs with up to one line ending
799
(?>(? # the destination can be either:
800
< (?: [^\n>]* (? # - enclosed in <> and containing no unescaped >
801
| [^< [:cntrl:]] [^ [:cntrl:]]* # - not enclosed but cannot contains spaces, new lines, etc. and only balanced or escaped parenthesis
802
))
803
(?:
804
# Note that this is an atomic pattern so that we don’t backtrack in it
805
# (so the pattern must not erroneously accept one of its branch).
806
(?> [ \t]* (?:\n ${cont}) [ \t]* | [ \t]+ ) # The spec says that spaces must be present here, but it seems that a new line is fine too.
807
(? # The title can be between ", ' or (). The matching characters can’t appear unescaped in the title
808
" (:?[^\n"]* (?: (?
809
| ' (:?[^\n']* (?: (?
810
| \( (:?[^\n"()]* (?: (?
811
)
812
)?
813
[ \t]*(:?\r\n|\n|\r|$) # The spec says that no characters can occur after the title, but it seems that whitespace is tolerated.
814
/gx
815
## use critic
816
) {
817
218
2277
my ($ref, $target, $title) = @LAST_PAREN_MATCH{qw(LABEL TARGET TITLE)};
818
218
973
$ref = normalize_label($ref);
819
218
100
509
if ($ref ne '') {
820
196
528
$this->_finalize_paragraph(1);
821
# TODO: option to keep the last appearance instead of the first one.
822
196
100
466
if (exists $this->{linkrefs}{$ref}) {
823
# We keep the first appearance of a label.
824
# TODO: mention the link label.
825
4
50
25
carp 'Only the first appearance of a link reference definition is kept'
826
if $this->get_warn_for_unused_input();
827
4
13
return 1;
828
}
829
192
100
404
if (defined $title) {
830
71
311
$title =~ s/^.(.*).$/$1/s;
831
71
151
_unescape_char($title);
832
}
833
192
356
$target =~ s/^<(.*)>$/$1/;
834
192
393
_unescape_char($target);
835
192
100
900
$this->{linkrefs}{$ref} = {
836
target => $target,
837
(defined $title ? ('title' => $title) : ())
838
};
839
192
667
return 1;
840
}
841
#pass-through intended;
842
}
843
2654
9857
$this->set_pos($init_pos, $last_pos);
844
2654
13449
return;
845
}
846
847
# https://github.github.com/gfm/#tables-extension-
848
sub _do_table_block {
849
54215
54215
70272
my ($this) = @_;
850
851
# TODO: add an option to prevent interrupting a paragraph with a table (and
852
# make it be true for pmarkdown, but not for github where tables can interrupt
853
# a paragraph).
854
# TODO: github supports omitting the first | even on the first line when we
855
# are not interrupting a paragraph and when subsequent the delimiter line has
856
# more than one dash per cell.
857
54215
51868
my $i = !!@{$this->{paragraph}};
54215
78556
858
54215
100
100
124639
return if $i && !$this->get_table_blocks_can_interrupt_paragraph;
859
37555
92006
my $m = $this->get_table_blocks_pipes_requirements;
860
# The tests here are quite lenient and there are many ways in which parsing
861
# the table can fail even if these tests pass.
862
37555
100
66
115817
if ($m eq 'strict' || ($m eq 'loose' && $i)) {
100
863
24828
100
87413
return unless $l =~ m/^ {0,3}\|/;
864
} else {
865
12727
100
54521
return unless $l =~ m/ (?
866
}
867
5236
8272
my $last_pos = $this->{last_pos};
868
5236
10774
my $init_pos = $this->get_pos();
869
5236
11728
$this->redo_line();
870
5236
9701
my $table = $this->_parse_table_structure();
871
5236
100
11026
if (!$table) {
872
5229
11834
$this->set_pos($init_pos, $last_pos);
873
5229
18528
return;
874
}
875
876
7
31
$this->_add_block({type => 'table', content => $table});
877
878
7
30
return 1;
879
}
880
881
sub _parse_table_structure { ## no critic (ProhibitExcessComplexity)
882
5236
5236
6942
my ($this) = @_;
883
884
5236
14220
my $m = $this->get_table_blocks_pipes_requirements;
885
5236
6290
my $i = !!@{$this->{paragraph}};
5236
8829
886
887
# A regexp that matches no back-slashes or an even number of them, so that the
888
# next character cannot be escaped.
889
5236
13517
my $e = qr/(?
890
891
# We consume the continuation prefix of enclosing blocks. Note that,
892
# as opposed to what happens for links, subsequent lines can have at most
893
# 3 more spaces than the initial one with the GitHub implementation (but not
894
# some other GFM implementations).
895
5236
8328
my $cont = $this->{continuation_re};
896
5236
50
65605
confess 'Unexpected regex match failure' unless $this->{md} =~ m/\G${cont}/g;
897
# We want to allow successive 0 length matches. For more details on this
898
# behavior, see:
899
# https://perldoc.perl.org/perlre#Repeated-Patterns-Matching-a-Zero-length-Substring
900
5236
13322
pos($this->{md}) = pos($this->{md});
901
902
# Now we consume the initial | marking the beginning of the table that we know
903
# is here because of the initial match against $l in _do_table_block.
904
5236
50
17636
confess 'Unexpected missing table markers' unless $this->{md} =~ m/\G (\ {0,3}) (\|)?/gcx;
905
906
5236
10642
my $n = length($1) + 3; # Maximum amount of space allowed on subsequent line
907
5236
8155
my $has_pipe = defined $2;
908
909
# We parse the header row
910
5236
75323
my @headers = $this->{md} =~ m/\G [ \t]* (.*? [ \t]* $e) \| /gcx;
911
5236
100
11216
return unless @headers;
912
# We parse the last header if it is not followed by a pipe, and the newline.
913
# The only failure case here is if we have reached the end of the file.
914
4447
100
29090
return unless $this->{md} =~ m/\G [ \t]* (.+)? [ \t]* ${eol_re} /gcx;
915
3823
100
9194
if (defined $1) {
916
3378
7268
push @headers, $1;
917
3378
4799
$has_pipe = 0;
918
}
919
920
3823
100
100
27061
return if ($m eq 'strict' || ($m eq 'loose' && $i) || @headers == 1) && !$has_pipe;
100
921
922
# We consume the continuation marker at the beginning of the delimiter row.
923
3155
50
55029
return unless $this->{md} =~ m/\G ${cont} \ {0,$n} (\|)? /gx;
924
925
3155
100
7734
$has_pipe &&= defined $1;
926
927
3155
10101
my @separators = $this->{md} =~ m/\G [ \t]* ( :? -+ :? ) [ \t]* \| /gcx;
928
3155
100
23607
return unless $this->{md} =~ m/\G [ \t]* (:? -+ :?)? [ \t]* (:? ${eol_re} | $ ) /gcx;
929
605
100
1683
if (defined $1) {
930
66
187
push @separators, $1;
931
66
157
$has_pipe = 0;
932
}
933
605
100
2630
return unless @separators == @headers;
934
my @align =
935
9
100
20
map { s/^(:)?-+(:)?$/ $1 ? ($2 ? 'center' : 'left') : ($2 ? 'right' : '') /er } @separators;
17
100
71
17
100
103
936
937
9
50
66
90
return if ($m eq 'strict' || ($m eq 'loose' && $i) || @headers == 1) && !$has_pipe;
66
938
9
50
66
34
return if $m ne 'lax' && @headers == 1 && !$has_pipe;
66
939
9
100
66
38
return if $m ne 'lax' && !$has_pipe && min(map { length } @separators) < 2;
6
100
28
940
941
# And now we try to read as many lines as possible
942
7
9
my @table;
943
7
8
while (1) {
944
16
100
43
last if pos($this->{md}) == length($this->{md});
945
11
50
73
last unless $this->{md} =~ m/\G ${cont} \ {0,$n} (\|)? /gcx;
946
# TODO: use a simulator to decide whether we are entering a new block-level
947
# structure, rather than using this half baked regex.
948
11
100
46
$has_pipe &&= defined $1;
949
11
100
100
159
last if !defined $1 && $this->{md} =~ m/\G (?: [ ] | > | ${list_item_marker_re} )/x;
950
10
118
my @cells = $this->{md} =~ m/\G [ \t]* (.*? [ \t]* $e) \| /gcx;
951
10
30
pos($this->{md}) = pos($this->{md});
952
confess 'Unexpected match failure'
953
10
50
277
unless $this->{md} =~ m/\G [ \t]* (.+)? [ \t]* (?: ${eol_re} | $ ) /gcx;
954
10
100
26
if (defined $1) {
955
2
7
push @cells, $1;
956
2
5
$has_pipe = 0;
957
}
958
# There is a small bug when we exit here which is that we have consumed a
959
# blank line. The only case where it would matter would be to decide whether
960
# a list is loose or not, which is a pretty "edge" case with tables.
961
# Otherwise, we will start a new paragraph in all cases.
962
10
100
21
last unless @cells;
963
9
100
15
if (@cells != @headers) {
964
3
9
$#cells = @headers - 1;
965
# TODO: mention the line number in the file (if possible to track
966
# correctly).
967
3
50
33
6
carp 'Excess cells in table row are ignored'
968
if @cells > @headers && $this->get_warn_for_unused_input();
969
}
970
# Pipes need to be escaped inside table, and we need to unescape them here
971
# in case one would appear in a code block for example (where the escaping
972
# would appear literally otherwise). Given that pipes don’t have other
973
# meaning by default, there is not a big risk to do that (and this is
974
# mandated) by the GitHub Spec anyway.
975
9
100
17
push @table, [map { defined ? s/($e)\\\|/${1}|/gr : undef } @cells];
16
112
976
}
977
978
7
51
return {headers => \@headers, align => \@align, table => \@table};
979
}
980
981
# https://spec.commonmark.org/0.30/#paragraphs
982
sub _do_paragraph {
983
107539
107539
139865
my ($this) = @_;
984
# We need to test for blank lines here (not just emptiness) because after we
985
# have removed the markers of container blocks our line can become empty. The
986
# fact that we need to do this, seems to imply that we don’t really need to
987
# check for emptiness when initially building $l.
988
# TODO: check if the blank-line detection in next_line() is needed or not.
989
107539
100
238668
if ($l !~ m/^[ \t]*$/) {
990
85809
87374
push @{$this->{paragraph}}, $l;
85809
161477
991
85809
181499
return 1;
992
}
993
994
# https://spec.commonmark.org/0.30/#blank-lines
995
# if ($l eq '')
996
21730
46882
$this->_finalize_paragraph();
997
# Needed to detect loose lists. But ignore blank lines when they are inside
998
# block quotes
999
$this->{last_line_is_blank} =
1000
21730
100
22597
!@{$this->{blocks_stack}} || $this->{blocks_stack}[-1]{block}{type} ne 'quotes';
1001
21730
53377
return 1;
1002
}
1003
1004
sub _unescape_char {
1005
# TODO: configure the set of escapable character. Note that this regex is
1006
# shared with Inlines.pm process_char_escaping.
1007
263
263
439
$_[0] =~ s/\\(\p{PosixPunct})/$1/g;
1008
263
332
return;
1009
}
1010
1011
1;