cdata results from the CPAN

cdata
Markdown-Perl
view release on metacpan or search on metacpan
lib/Markdown/Perl/Inlines.pm view on Meta::CPAN
# Everywhere here, $that is a Markdown::Perl instance that we carry everywhere
# because it contains the options that we are using.
sub render {
  my ($that, $linkrefs, @lines) = @_;

  my $text = join("\n", @lines);
  my $tree = find_code_and_tag_runs($that, $text);

  # At this point, @runs contains only 'text',  'code', or 'link' elements, that
  # canâ€™t have any children (yet).

  $tree->map(sub { process_char_escaping($that, $_) });

  # At this point, @runs can also contain 'literal' elements, that donâ€™t have
  # children.

  process_links($that, $linkrefs, $tree);

  #â€¯This removes the spurious white-space at the beginning and end of lines and
  # also inserts hard line break as required.
  process_whitespaces($that, $tree);

  # Now, there are more link elements and they can have children instead of
  # content.

  if ($that->get_use_extended_autolinks) {
    $tree->map(sub { create_extended_autolinks($that, $_) });
    $tree->map(sub { create_extended_email_autolinks($that, $_) });
  }

  process_styles($that, $tree);

  # At this point we have added the emphasis, strong emphasis, etc. in the tree.

  $tree->apply(
    sub {
      $_->escape_content($that->get_html_escaped_characters,
        $that->get_html_escaped_code_characters);
    });

  my $out = $tree->render_html();

  return $out;
}

# TODO: share these regex with Perl.pm (but note that we are not matching the
# open and close < > characters here).
my $html_tag_name_re = qr/[a-zA-Z][-a-zA-Z0-9]*/;
my $html_attribute_name_re = qr/[a-zA-Z_:][-a-zA-Z0-9_.:]*/;
my $html_space_re = qr/\n[ \t]*|[ \t][ \t]*\n?[ \t]*/;  # Spaces, tabs, and up to one line ending.
my $opt_html_space_re = qr/[ \t]*\n?[ \t]*/;  # Optional spaces.
my $html_attribute_value_re = qr/ [^ \t\n"'=<>`]+ | '[^']*' | "[^"]*" /x;
my $html_attribute_re =
    qr/ ${html_space_re} ${html_attribute_name_re} (?: ${opt_html_space_re} = ${opt_html_space_re} ${html_attribute_value_re} )? /x;

my $html_open_tag_re = qr/ ${html_tag_name_re} ${html_attribute_re}* ${opt_html_space_re} \/? /x;
my $html_close_tag_re = qr/ \/ ${html_tag_name_re} ${opt_html_space_re} /x;
my $html_comment_re = qr/!--|!---|!--.*?--/s;
my $html_proc_re = qr/\?.*?\?/s;
my $html_decl_re = qr/![a-zA-Z].*?/s;
my $html_cdata_re = qr/!\[CDATA\[.*?\]\]/s;

my $html_tag_re =
    qr/ ${html_open_tag_re} | ${html_close_tag_re} | ${html_comment_re} | ${html_proc_re} | ${html_decl_re} | ${html_cdata_re}/x;

# Bug: there is a bug in that backslash escapes donâ€™t work inside autolinks. But
# we can turn our autolinks into full-links later (where the escape should
# work). However, the spec does not test this corner case so weâ€™re fine.

sub find_code_and_tag_runs {
  my ($that, $text) = @_;

  my $tree = Markdown::Perl::InlineTree->new();

  # We match code-spans and autolinks first as they bind strongest. Raw HTML
  # should be here too, but we donâ€™t support it yet.
  # https://spec.commonmark.org/0.30/#code-spans
  # TODO: https://spec.commonmark.org/0.30/#autolinks
  # TODO: https://spec.commonmark.org/0.30/#raw-html
  # while ($text =~ m/(?<code>\`+)|(?<html>\<)/g) {
  # We are manually handling the backslash escaping here because they are not
  # interpreted inside code blocks. We will then process all the others
  # afterward.
  while ($text =~ m/(?<! \\) (?<backslashes> (?:\\\\)*) (?: (?<code>\`+) | < )/gx) {
    my ($start_before, $start_after) =
        ($LAST_MATCH_START[0] + length($+{backslashes}), $LAST_MATCH_END[0]);
    if ($+{code}) {
      my $fence = $+{code};
      # Weâ€™re searching for a fence of the same length, without any backtick
      # before or after.
      if ($text =~ m/(?<!\`)${fence}(?!\`)/gc) {
        my ($end_before, $end_after) = ($LAST_MATCH_START[0], $LAST_MATCH_END[0]);
        $tree->push(new_text(substr($text, 0, $start_before)))
            if $start_before > 0;
        $tree->push(new_code(substr($text, $start_after, ($end_before - $start_after))));
        substr $text, 0, $end_after, '';  #â€¯This resets pos($text) as we want it to.
      }  # in the else clause, pos($text) == $start_after (because of the /c modifier).
    } else {
      # We matched a single < character.
      my $re = $that->get_autolinks_regex;
      my $email_re = $that->get_autolinks_email_regex;
      # Weâ€™re not using /gc in these to regex because this confuses the ProhibitUnusedCapture
      # PerlCritic policy. Anyway, as we are always resetting pos() in case of
      # successful match, itâ€™s not important to update it.
      if ($text =~ m/\G(?<link>${re})>/) {
        $tree->push(new_text(substr($text, 0, $start_before)))
            if $start_before > 0;
        $tree->push(new_link($+{link}, type => 'autolink', target => $+{link}));
        substr $text, 0, $+[0], '';  #â€¯This resets pos($text) as we want it to.
      } elsif ($text =~ m/\G(?<link>${email_re})>/) {
        $tree->push(new_text(substr($text, 0, $start_before)))
            if $start_before > 0;
        # TODO: we have a bug in to_source_text, that will assume that the
        # mailto: was part of the source text.
        $tree->push(new_link($+{link}, type => 'autolink', target => 'mailto:'.$+{link}));
        substr $text, 0, $+[0], '';  #â€¯This resets pos($text) as we want it to.
      } elsif ($text =~ m/\G(?:${html_tag_re})>/) {
        #â€¯This resets pos($text) as we want it to.
        $tree->push(new_text(substr($text, 0, $start_before, '')))
            if $start_before > 0;
        my $html = substr($text, 0, $LAST_MATCH_END[0] - $start_before, '');
        remove_disallowed_tags($html, $that->get_disallowed_html_tags);
        $tree->push(new_html($html));
      }
( run in 0.822 second using v1.01-cache-2.11-cpan-9581c071862 )