s around # "paragraphs" that are wrapped in non-block-level tags, such as anchors, # phrase emphasis, and spans. The list of tags we're looking for is # hard-coded: my $block_tags_a = qr/p|div|h[1-6]|blockquote|pre|table|dl|ol|ul|script|noscript|form|fieldset|iframe|math|ins|del/; my $block_tags_b = qr/p|div|h[1-6]|blockquote|pre|table|dl|ol|ul|script|noscript|form|fieldset|iframe|math/; # First, look for nested blocks, e.g.: #
#
#
# The outermost tags must start at the left margin for this to match, and
# the inner nested divs must be indented.
# We need to do this before the next, more liberal match, because the next
# match will start at the first `
# tags for inner block must be indented.
#
# ` and stop at the first `
`.
$text =~ s{
( # save in $1
^ # start of line (with /m)
<($block_tags_a) # start tag = $2
\b # word break
(.*\n)*? # any number of lines, minimally matching
# the matching end tag
[ \t]* # trailing spaces/tabs
(?=\n+|\Z) # followed by a newline or end of document
)
}{
my $key = md5_hex($1);
$g_html_blocks{$key} = $1;
"\n\n" . $key . "\n\n";
}egmx;
#
# Now match more liberally, simply from `\n. It was easier to make a special case than # to make the other regex more complicated. $text =~ s{ (?: (?<=\n\n) # Starting after a blank line | # or \A\n? # the beginning of the doc ) ( # save in $1 [ ]{0,$less_than_tab} <(hr) # start tag = $2 \b # word break ([^<>])*? # /?> # the matching end tag [ \t]* (?=\n{2,}|\Z) # followed by a blank line or end of document ) }{ my $key = md5_hex($1); $g_html_blocks{$key} = $1; "\n\n" . $key . "\n\n"; }egx; # Special case for standalone HTML comments: $text =~ s{ (?: (?<=\n\n) # Starting after a blank line | # or \A\n? # the beginning of the doc ) ( # save in $1 [ ]{0,$less_than_tab} (?s: ) [ \t]* (?=\n{2,}|\Z) # followed by a blank line or end of document ) }{ my $key = md5_hex($1); $g_html_blocks{$key} = $1; "\n\n" . $key . "\n\n"; }egx; return $text; } sub _RunBlockGamut { # # These are all the transformations that form block-level # tags like paragraphs, headers, and list items. # my $text = shift; $text = _DoHeaders($text); # Do Horizontal Rules: $text =~ s{^[ ]{0,2}([ ]?\*[ ]?){3,}[ \t]*$}{\n
tags.
# my $tags_to_skip = qr!<(/?)(?:pre|code|kbd|script|math)[\s>]!;
foreach my $cur_token (@$tokens) {
if ($cur_token->[0] eq "tag") {
# Within tags, encode * and _ so they don't conflict
# with their use in Markdown for italics and strong.
# We're replacing each such character with its
# corresponding MD5 checksum value; this is likely
# overkill, but it should prevent us from colliding
# with the escape values by accident.
$cur_token->[1] =~ s! \* !$g_escape_table{'*'}!gx;
$cur_token->[1] =~ s! _ !$g_escape_table{'_'}!gx;
$text .= $cur_token->[1];
} else {
my $t = $cur_token->[1];
$t = _EncodeBackslashEscapes($t);
$text .= $t;
}
}
return $text;
}
sub _DoAnchors {
#
# Turn Markdown link shortcuts into XHTML tags.
#
my $text = shift;
#
# First, handle reference-style links: [link text] [id]
#
$text =~ s{
( # wrap whole match in $1
\[
($g_nested_brackets) # link text = $2
\]
[ ]? # one optional space
(?:\n[ ]*)? # one optional newline followed by spaces
\[
(.*?) # id = $3
\]
)
}{
my $result;
my $whole_match = $1;
my $link_text = $2;
my $link_id = lc $3;
if ($link_id eq "") {
$link_id = lc $link_text; # for shortcut links like [this][].
}
if (defined $g_urls{$link_id}) {
my $url = $g_urls{$link_id};
$url =~ s! \* !$g_escape_table{'*'}!gx; # We've got to encode these to avoid
$url =~ s! _ !$g_escape_table{'_'}!gx; # conflicting with italics/bold.
$result = "? # href = $3
[ \t]*
( # $4
(['"]) # quote char = $5
(.*?) # Title = $6
\5 # matching quote
)? # title is optional
\)
)
}{
my $result;
my $whole_match = $1;
my $link_text = $2;
my $url = $3;
my $title = $6;
$url =~ s! \* !$g_escape_table{'*'}!gx; # We've got to encode these to avoid
$url =~ s! _ !$g_escape_table{'_'}!gx; # conflicting with italics/bold.
$result = " tags.
#
my $text = shift;
#
# First, handle reference-style labeled images: ![alt text][id]
#
$text =~ s{
( # wrap whole match in $1
!\[
(.*?) # alt text = $2
\]
[ ]? # one optional space
(?:\n[ ]*)? # one optional newline followed by spaces
\[
(.*?) # id = $3
\]
)
}{
my $result;
my $whole_match = $1;
my $alt_text = $2;
my $link_id = lc $3;
if ($link_id eq "") {
$link_id = lc $alt_text; # for shortcut links like ![this][].
}
$alt_text =~ s/"/"/g;
if (defined $g_urls{$link_id}) {
my $url = $g_urls{$link_id};
$url =~ s! \* !$g_escape_table{'*'}!gx; # We've got to encode these to avoid
$url =~ s! _ !$g_escape_table{'_'}!gx; # conflicting with italics/bold.
$result = "![\"$alt_text\"";](\"$url\")
? # src url = $3
[ \t]*
( # $4
(['"]) # quote char = $5
(.*?) # title = $6
\5 # matching quote
[ \t]*
)? # title is optional
\)
)
}{
my $result;
my $whole_match = $1;
my $alt_text = $2;
my $url = $3;
my $title = '';
if (defined($6)) {
$title = $6;
}
$alt_text =~ s/"/"/g;
$title =~ s/"/"/g;
$url =~ s! \* !$g_escape_table{'*'}!gx; # We've got to encode these to avoid
$url =~ s! _ !$g_escape_table{'_'}!gx; # conflicting with italics/bold.
$result = "" . _RunSpanGamut($1) . "\n\n";
}egmx;
$text =~ s{ ^(.+)[ \t]*\n-+[ \t]*\n+ }{
"" . _RunSpanGamut($1) . "
\n\n";
}egmx;
# atx-style headers:
# # Header 1
# ## Header 2
# ## Header 2 with closing hashes ##
# ...
# ###### Header 6
#
$text =~ s{
^(\#{1,6}) # $1 = string of #'s
[ \t]*
(.+?) # $2 = Header text
[ \t]*
\#* # optional closing #'s (not counted)
\n+
}{
my $h_level = length($1);
"" . _RunSpanGamut($2) . " \n\n";
}egmx;
return $text;
}
sub _DoLists {
#
# Form HTML ordered (numbered) and unordered (bulleted) lists.
#
my $text = shift;
my $less_than_tab = $g_tab_width - 1;
# Re-usable patterns to match list item bullets and number markers:
my $marker_ul = qr/[*+-]/;
my $marker_ol = qr/\d+[.]/;
my $marker_any = qr/(?:$marker_ul|$marker_ol)/;
# Re-usable pattern to match any entirel ul or ol list:
my $whole_list = qr{
( # $1 = whole list
( # $2
[ ]{0,$less_than_tab}
(${marker_any}) # $3 = first list item marker
[ \t]+
)
(?s:.+?)
( # $4
\z
|
\n{2,}
(?=\S)
(?! # Negative lookahead for another list item marker
[ \t]*
${marker_any}[ \t]+
)
)
)
}mx;
# We use a different prefix before nested lists than top-level lists.
# See extended comment in _ProcessListItems().
#
# Note: There's a bit of duplication here. My original implementation
# created a scalar regex pattern as the conditional result of the test on
# $g_list_level, and then only ran the $text =~ s{...}{...}egmx
# substitution once, using the scalar as the pattern. This worked,
# everywhere except when running under MT on my hosting account at Pair
# Networks. There, this caused all rebuilds to be killed by the reaper (or
# perhaps they crashed, but that seems incredibly unlikely given that the
# same script on the same server ran fine *except* under MT. I've spent
# more time trying to figure out why this is happening than I'd like to
# admit. My only guess, backed up by the fact that this workaround works,
# is that Perl optimizes the substition when it can figure out that the
# pattern will never change, and when this optimization isn't on, we run
# afoul of the reaper. Thus, the slightly redundant code to that uses two
# static s/// patterns rather than one conditional pattern.
if ($g_list_level) {
$text =~ s{
^
$whole_list
}{
my $list = $1;
my $list_type = ($3 =~ m/$marker_ul/) ? "ul" : "ol";
# Turn double returns into triple returns, so that we can make a
# paragraph for the last item in a list, if necessary:
$list =~ s/\n{2,}/\n\n\n/g;
my $result = _ProcessListItems($list, $marker_any);
$result = "<$list_type>\n" . $result . "\n";
$result;
}egmx;
}
else {
$text =~ s{
(?:(?<=\n\n)|\A\n?)
$whole_list
}{
my $list = $1;
my $list_type = ($3 =~ m/$marker_ul/) ? "ul" : "ol";
# Turn double returns into triple returns, so that we can make a
# paragraph for the last item in a list, if necessary:
$list =~ s/\n{2,}/\n\n\n/g;
my $result = _ProcessListItems($list, $marker_any);
$result = "<$list_type>\n" . $result . "\n";
$result;
}egmx;
}
return $text;
}
sub _ProcessListItems {
#
# Process the contents of a single ordered or unordered list, splitting it
# into individual list items.
#
my $list_str = shift;
my $marker_any = shift;
# The $g_list_level global keeps track of when we're inside a list.
# Each time we enter a list, we increment it; when we leave a list,
# we decrement. If it's zero, we're not in a list anymore.
#
# We do this because when we're not inside a list, we want to treat
# something like this:
#
# I recommend upgrading to version
# 8. Oops, now this line is treated
# as a sub-list.
#
# As a single paragraph, despite the fact that the second line starts
# with a digit-period-space sequence.
#
# Whereas when we're inside a list (or sub-list), that line will be
# treated as the start of a sub-list. What a kludge, huh? This is
# an aspect of Markdown's syntax that's hard to parse perfectly
# without resorting to mind-reading. Perhaps the solution is to
# change the syntax rules such that sub-lists must start with a
# starting cardinal number; e.g. "1." or "a.".
$g_list_level++;
# trim trailing blank lines:
$list_str =~ s/\n{2,}\z/\n/;
$list_str =~ s{
(\n)? # leading line = $1
(^[ \t]*) # leading whitespace = $2
($marker_any) [ \t]+ # list marker = $3
((?s:.+?) # list item text = $4
(\n{1,2}))
(?= \n* (\z | \2 ($marker_any) [ \t]+))
}{
my $item = $4;
my $leading_line = $1;
my $leading_space = $2;
if ($leading_line or ($item =~ m/\n{2,}/)) {
$item = _RunBlockGamut(_Outdent($item));
}
else {
# Recursion for sub-lists:
$item = _DoLists(_Outdent($item));
chomp $item;
$item = _RunSpanGamut($item);
}
"" . $item . " \n";
}egmx;
$g_list_level--;
return $list_str;
}
sub _DoCodeBlocks {
#
# Process Markdown `` blocks.
#
my $text = shift;
$text =~ s{
(?:\n\n|\A)
( # $1 = the code block -- one or more lines, starting with a space/tab
(?:
(?:[ ]{$g_tab_width} | \t) # Lines must start with a tab or a tab-width of spaces
.*\n+
)+
)
((?=^[ ]{0,$g_tab_width}\S)|\Z) # Lookahead for non-space at line-start, or end of doc
}{
my $codeblock = $1;
my $result; # return value
$codeblock = _EncodeCode(_Outdent($codeblock));
$codeblock = _Detab($codeblock);
$codeblock =~ s/\A\n+//; # trim leading newlines
$codeblock =~ s/\s+\z//; # trim trailing whitespace
$result = "\n\n" . $codeblock . "\n
\n\n";
$result;
}egmx;
return $text;
}
sub _DoCodeSpans {
#
# * Backtick quotes are used for Just type foo `bar` baz at the prompt.
#
# There's no arbitrary limit to the number of backticks you
# can use as delimters. If you need three consecutive backticks
# in your code, use four for delimiters, etc.
#
# * You can use spaces to get literal backticks at the edges:
#
# ... type `` `bar` `` ...
#
# Turns to:
#
# ... type `bar` ...
#
my $text = shift;
$text =~ s@
(`+) # $1 = Opening run of `
(.+?) # $2 = The code block
(?$c";
@egsx;
return $text;
}
sub _EncodeCode {
#
# Encode/escape certain characters inside Markdown code runs.
# The point is that in code, these characters are literals,
# and lose their special Markdown meanings.
#
local $_ = shift;
# Encode all ampersands; HTML entities are not
# entities within a Markdown code span.
s/&/&/g;
# Encode $'s, but only if we're running under Blosxom.
# (Blosxom interpolates Perl variables in article bodies.)
{
no warnings 'once';
if (defined($blosxom::version)) {
s/\$/$/g;
}
}
# Do the angle bracket song and dance:
s! < !<!gx;
s! > !>!gx;
# Now, escape characters that are magic in Markdown:
s! \* !$g_escape_table{'*'}!gx;
s! _ !$g_escape_table{'_'}!gx;
s! { !$g_escape_table{'{'}!gx;
s! } !$g_escape_table{'}'}!gx;
s! \[ !$g_escape_table{'['}!gx;
s! \] !$g_escape_table{']'}!gx;
s! \\ !$g_escape_table{'\\'}!gx;
return $_;
}
sub _DoItalicsAndBold {
my $text = shift;
# must go first:
$text =~ s{ (\*\*|__) (?=\S) (.+?[*_]*) (?<=\S) \1 }
{$2}gsx;
$text =~ s{ (\*|_) (?=\S) (.+?) (?<=\S) \1 }
{$2}gsx;
return $text;
}
sub _DoBlockQuotes {
my $text = shift;
$text =~ s{
( # Wrap whole match in $1
(
^[ \t]*>[ \t]? # '>' at the start of a line
.+\n # rest of the first line
(.+\n)* # subsequent consecutive lines
\n* # blanks
)+
)
}{
my $bq = $1;
$bq =~ s/^[ \t]*>[ \t]?//gm; # trim one level of quoting
$bq =~ s/^[ \t]+$//mg; # trim whitespace-only lines
$bq = _RunBlockGamut($bq); # recurse
$bq =~ s/^/ /g;
# These leading spaces screw with content, so we need to fix that:
$bq =~ s{
(\s*.+?
)
}{
my $pre = $1;
$pre =~ s/^ //mg;
$pre;
}egsx;
"\n$bq\n
\n\n";
}egmx;
return $text;
}
sub _FormParagraphs {
#
# Params:
# $text - string to process with html tags
#
my $text = shift;
# Strip leading and trailing lines:
$text =~ s/\A\n+//;
$text =~ s/\n+\z//;
my @grafs = split(/\n{2,}/, $text);
#
# Wrap
tags.
#
foreach (@grafs) {
unless (defined( $g_html_blocks{$_} )) {
$_ = _RunSpanGamut($_);
s/^([ \t]*)/
/;
$_ .= "
";
}
}
#
# Unhashify HTML blocks
#
foreach (@grafs) {
if (defined( $g_html_blocks{$_} )) {
$_ = $g_html_blocks{$_};
}
}
return join "\n\n", @grafs;
}
sub _EncodeAmpsAndAngles {
# Smart processing for ampersands and angle brackets that need to be encoded.
my $text = shift;
# Ampersand-encoding based entirely on Nat Irons's Amputator MT plugin:
# http://bumppo.net/projects/amputator/
$text =~ s/&(?!#?[xX]?(?:[0-9a-fA-F]+|\w+);)/&/g;
# Encode naked <'s
$text =~ s{<(?![a-z/?\$!])}{<}gi;
return $text;
}
sub _EncodeBackslashEscapes {
#
# Parameter: String.
# Returns: The string, with after processing the following backslash
# escape sequences.
#
local $_ = shift;
s! \\\\ !$g_escape_table{'\\'}!gx; # Must process escaped backslashes first.
s! \\` !$g_escape_table{'`'}!gx;
s! \\\* !$g_escape_table{'*'}!gx;
s! \\_ !$g_escape_table{'_'}!gx;
s! \\\{ !$g_escape_table{'{'}!gx;
s! \\\} !$g_escape_table{'}'}!gx;
s! \\\[ !$g_escape_table{'['}!gx;
s! \\\] !$g_escape_table{']'}!gx;
s! \\\( !$g_escape_table{'('}!gx;
s! \\\) !$g_escape_table{')'}!gx;
s! \\> !$g_escape_table{'>'}!gx;
s! \\\# !$g_escape_table{'#'}!gx;
s! \\\+ !$g_escape_table{'+'}!gx;
s! \\\- !$g_escape_table{'-'}!gx;
s! \\\. !$g_escape_table{'.'}!gx;
s{ \\! }{$g_escape_table{'!'}}gx;
return $_;
}
sub _DoAutoLinks {
my $text = shift;
$text =~ s{<((https?|ftp):[^'">\s]+)>}{$1}gi;
# Email addresses:
$text =~ s{
<
(?:mailto:)?
(
[-.\w]+
\@
[-a-z0-9]+(\.[-a-z0-9]+)*\.[a-z]+
)
>
}{
_EncodeEmailAddress( _UnescapeSpecialChars($1) );
}egix;
return $text;
}
sub _EncodeEmailAddress {
#
# Input: an email address, e.g. "foo@example.com"
#
# Output: the email address as a mailto link, with each character
# of the address encoded as either a decimal or hex entity, in
# the hopes of foiling most address harvesting spam bots. E.g.:
#
# foo
# @example.com
#
# Based on a filter by Matthew Wickline, posted to the BBEdit-Talk
# mailing list:
#
my $addr = shift;
srand;
my @encode = (
sub { '&#' . ord(shift) . ';' },
sub { '&#x' . sprintf( "%X", ord(shift) ) . ';' },
sub { shift },
);
$addr = "mailto:" . $addr;
$addr =~ s{(.)}{
my $char = $1;
if ( $char eq '@' ) {
# this *must* be encoded. I insist.
$char = $encode[int rand 1]->($char);
} elsif ( $char ne ':' ) {
# leave ':' alone (to spot mailto: later)
my $r = rand;
# roughly 10% raw, 45% hex, 45% dec
$char = (
$r > .9 ? $encode[2]->($char) :
$r < .45 ? $encode[1]->($char) :
$encode[0]->($char)
);
}
$char;
}gex;
$addr = qq{$addr};
$addr =~ s{">.+?:}{">}; # strip the mailto: from the visible part
return $addr;
}
sub _UnescapeSpecialChars {
#
# Swap back in all the special characters we've hidden.
#
my $text = shift;
while( my($char, $hash) = each(%g_escape_table) ) {
$text =~ s/$hash/$char/g;
}
return $text;
}
sub _TokenizeHTML {
#
# Parameter: String containing HTML markup.
# Returns: Reference to an array of the tokens comprising the input
# string. Each token is either a tag (possibly with nested,
# tags contained therein, such as , or a
# run of text between tags. Each element of the array is a
# two-element array; the first is either 'tag' or 'text';
# the second is the actual value.
#
#
# Derived from the _tokenize() subroutine from Brad Choate's MTRegex plugin.
#
#
my $str = shift;
my $pos = 0;
my $len = length $str;
my @tokens;
my $depth = 6;
my $nested_tags = join('|', ('(?:<[a-z/!$](?:[^<>]') x $depth) . (')*>)' x $depth);
my $match = qr/(?s: ) | # comment
(?s: <\? .*? \?> ) | # processing instruction
$nested_tags/ix; # nested tags
while ($str =~ m/($match)/g) {
my $whole_tag = $1;
my $sec_start = pos $str;
my $tag_start = $sec_start - length $whole_tag;
if ($pos < $tag_start) {
push @tokens, ['text', substr($str, $pos, $tag_start - $pos)];
}
push @tokens, ['tag', $whole_tag];
$pos = pos $str;
}
push @tokens, ['text', substr($str, $pos, $len - $pos)] if $pos < $len;
\@tokens;
}
sub _Outdent {
#
# Remove one level of line-leading tabs or spaces
#
my $text = shift;
$text =~ s/^(\t|[ ]{1,$g_tab_width})//gm;
return $text;
}
sub _Detab {
#
# Cribbed from a post by Bart Lateur:
#
#
my $text = shift;
$text =~ s{(.*?)\t}{$1.(' ' x ($g_tab_width - length($1) % $g_tab_width))}ge;
return $text;
}
1;
__END__
=pod
=head1 NAME
B
=head1 SYNOPSIS
B [ B<--html4tags> ] [ B<--version> ] [ B<-shortversion> ]
[ I ... ]
=head1 DESCRIPTION
Markdown is a text-to-HTML filter; it translates an easy-to-read /
easy-to-write structured text format into HTML. Markdown's text format
is most similar to that of plain text email, and supports features such
as headers, *emphasis*, code blocks, blockquotes, and links.
Markdown's syntax is designed not as a generic markup language, but
specifically to serve as a front-end to (X)HTML. You can use span-level
HTML tags anywhere in a Markdown document, and you can use block level
HTML tags (like and as well).
For more information about Markdown's syntax, see:
http://daringfireball.net/projects/markdown/
=head1 OPTIONS
Use "--" to end switch parsing. For example, to open a file named "-z", use:
Markdown.pl -- -z
=over 4
=item B<--html4tags>
Use HTML 4 style for empty element tags, e.g.:
instead of Markdown's default XHTML style tags, e.g.:
=item B<-v>, B<--version>
Display Markdown's version number and copyright information.
=item B<-s>, B<--shortversion>
Display the short-form version number.
=back
=head1 BUGS
To file bug reports or feature requests (other than topics listed in the
Caveats section above) please send email to:
support@daringfireball.net
Please include with your report: (1) the example input; (2) the output
you expected; (3) the output Markdown actually produced.
=head1 VERSION HISTORY
See the readme file for detailed release notes for this version.
1.0.1 - 14 Dec 2004
1.0 - 28 Aug 2004
=head1 AUTHOR
John Gruber
http://daringfireball.net
PHP port and other contributions by Michel Fortin
http://michelf.com
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2003-2004 John Gruber