view release on metacpan or  search on metacpan

inc/Pod/Markdown.pm  view on Meta::CPAN

#line 1
# vim: set ts=2 sts=2 sw=2 expandtab smarttab:
#
# This file is part of Pod-Markdown
#
# This software is copyright (c) 2011 by Randy Stauner.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
use 5.008;
use strict;
use warnings;

package Pod::Markdown;
# git description: v3.004-0-g69a7b15

our $AUTHORITY = 'cpan:RWSTAUNER';
# ABSTRACT: Convert POD to Markdown
$Pod::Markdown::VERSION = '3.005';
use Pod::Simple 3.27 (); # detected_encoding and keep_encoding bug fix
use parent qw(Pod::Simple::Methody);
use Encode ();

our %URL_PREFIXES = (
  sco      => 'http://search.cpan.org/perldoc?',
  metacpan => 'https://metacpan.org/pod/',
  man      => 'http://man.he.net/man',
);
$URL_PREFIXES{perldoc} = $URL_PREFIXES{metacpan};

#{
  our $HAS_HTML_ENTITIES;

  # Stolen from Pod::Simple::XHTML 3.28. {{{

  BEGIN {
    $HAS_HTML_ENTITIES = eval "require HTML::Entities; 1";
  }

  my %entities = (
    q{>} => 'gt',
    q{<} => 'lt',
    q{'} => '#39',
    q{"} => 'quot',
    q{&} => 'amp',
  );

  sub encode_entities {
    my $self = shift;
    my $ents = $self->html_encode_chars;
    return HTML::Entities::encode_entities( $_[0], $ents ) if $HAS_HTML_ENTITIES;
    if (defined $ents) {
        $ents =~ s,(?<!\\)([]/]),\\$1,g;
        $ents =~ s,(?<!\\)\\\z,\\\\,;
    } else {
        $ents = join '', keys %entities;
    }
    my $str = $_[0];
    $str =~ s/([$ents])/'&' . ($entities{$1} || sprintf '#x%X', ord $1) . ';'/ge;
    return $str;
  }

  # }}}

  # Add a few very common ones for consistency and readability
  # (in case HTML::Entities isn't available).
  %entities = (
    # Pod::Markdown has always required 5.8 so unicode_to_native will be available.
    chr(utf8::unicode_to_native(0xA0)) => 'nbsp',
    chr(utf8::unicode_to_native(0xA9)) => 'copy',
    %entities
  );

  sub __entity_encode_ord_he {
    my $chr = chr $_[0];
    # Skip the encode_entities() logic and go straight for the substitution
    # since we already have the char we know we want replaced.
    # Both the hash and the function are documented as exportable (so should be reliable).
    return $HTML::Entities::char2entity{ $chr } || HTML::Entities::num_entity( $chr );
  }
  sub __entity_encode_ord_basic {
    return '&' . ($entities{chr $_[0]} || sprintf '#x%X', $_[0]) . ';';
  }

  # From HTML::Entities 3.69
  my $DEFAULT_ENTITY_CHARS = '^\n\r\t !\#\$%\(-;=?-~';

#}

# Use hash for simple "exists" check in `new` (much more accurate than `->can`).
my %attributes = map { ($_ => 1) }
  qw(
    html_encode_chars
    match_encoding

inc/Pod/Markdown.pm  view on Meta::CPAN

  my $url_prefix = $self->perldoc_url_prefix;
  my $url = '';

  # If the link is to another module (external link).
  if ($name) {
    $url = $url_prefix . $name;
  }

  # See https://rt.cpan.org/Ticket/Display.html?id=57776
  # for a discussion on the need to mangle the section.
  if ($section){

    my $method = $url
      # If we already have a prefix on the url it's external.
      ? $self->perldoc_fragment_format
      # Else an internal link points to this markdown doc.
      : $self->markdown_fragment_format;

    $method = 'format_fragment_' . $method
      unless ref($method);

    {
      # Set topic to enable code refs to be simple.
      local $_ = $section;
      $section = $self->$method($section);
    }

    $url .= '#' . $section;
  }

  return $url;
}


# TODO: simple, pandoc, etc?

sub format_fragment_markdown {
  my ($self, $section) = @_;

  # If this is an internal link (to another section in this doc)
  # we can't be sure what the heading id's will look like
  # (it depends on what is rendering the markdown to html)
  # but we can try to follow popular conventions.

  # http://johnmacfarlane.net/pandoc/demo/example9/pandocs-markdown.html#header-identifiers-in-html-latex-and-context
  #$section =~ s/(?![-_.])[[:punct:]]//g;
  #$section =~ s/\s+/-/g;
  $section =~ s/\W+/-/g;
  $section =~ s/-+$//;
  $section =~ s/^-+//;
  $section = lc $section;
  #$section =~ s/^[^a-z]+//;
  $section ||= 'section';

  return $section;
}


{
  # From Pod::Simple::XHTML 3.28.
  # The strings gets passed through encode_entities() before idify().
  # If we don't do it here the substitutions below won't operate consistently.

  sub format_fragment_pod_simple_xhtml {
    my ($self, $t) = @_;

    # encode_entities {
      # We need to use the defaults in case html_encode_chars has been customized
      # (since the purpose is to match what external sources are doing).

      local $self->_private->{html_encode_chars};
      $t = $self->encode_entities($t);
    # }

    # idify {
      for ($t) {
          s/<[^>]+>//g;            # Strip HTML.
          s/&[^;]+;//g;            # Strip entities.
          s/^\s+//; s/\s+$//;      # Strip white space.
          s/^([^a-zA-Z]+)$/pod$1/; # Prepend "pod" if no valid chars.
          s/^[^a-zA-Z]+//;         # First char must be a letter.
          s/[^-a-zA-Z0-9_:.]+/-/g; # All other chars must be valid.
          s/[-:.]+$//;             # Strip trailing punctuation.
      }
    # }

    return $t;
  }
}


sub format_fragment_pod_simple_html {
  my ($self, $section) = @_;

  # From Pod::Simple::HTML 3.28.

  # section_name_tidy {
    $section =~ s/^\s+//;
    $section =~ s/\s+$//;
    $section =~ tr/ /_/;
    $section =~ tr/\x00-\x1F\x80-\x9F//d if 'A' eq chr(65); # drop crazy characters

    #$section = $self->unicode_escape_url($section);
      # unicode_escape_url {
      $section =~ s/([^\x00-\xFF])/'('.ord($1).')'/eg;
        #  Turn char 1234 into "(1234)"
      # }

    $section = '_' unless length $section;
    return $section;
  # }
}


sub format_fragment_metacpan { shift->format_fragment_pod_simple_xhtml(@_); }
sub format_fragment_sco      { shift->format_fragment_pod_simple_html(@_);  }

1;

__END__