use
5.008;
{
$Pod::Markdown::VERSION
=
'1.320'
;
}
BEGIN {
$Pod::Markdown::AUTHORITY
=
'cpan:RWSTAUNER'
;
}
sub
initialize {
my
$self
=
shift
;
$self
->SUPER::initialize(
@_
);
$self
->_private;
$self
;
}
sub
_private {
my
$self
=
shift
;
$self
->{_MyParser} ||= {
Text
=> [],
Indent
=> 0,
ListType
=>
'-'
,
searching
=>
''
,
Title
=>
undef
,
Author
=>
undef
,
};
}
sub
as_markdown {
my
(
$parser
,
%args
) =
@_
;
my
$data
=
$parser
->_private;
my
$lines
=
$data
->{Text};
my
@header
;
if
(
$args
{with_meta}) {
@header
=
$parser
->_build_markdown_head;
}
join
(
"\n"
x 2,
@header
, @{
$lines
}) .
"\n"
;
}
sub
_build_markdown_head {
my
$parser
=
shift
;
my
$data
=
$parser
->_private;
return
join
"\n"
,
map
{
qq![[meta \l$_="$data->{$_}"]]!
}
grep
{
defined
$data
->{
$_
} }
qw( Title Author )
;
}
sub
_save {
my
(
$parser
,
$text
) =
@_
;
my
$data
=
$parser
->_private;
$text
=
$parser
->_indent_text(
$text
);
push
@{
$data
->{Text} },
$text
;
return
;
}
sub
_unsave {
my
$parser
=
shift
;
my
$data
=
$parser
->_private;
return
pop
@{
$data
->{Text} };
}
sub
_indent_text {
my
(
$parser
,
$text
) =
@_
;
my
$data
=
$parser
->_private;
my
$level
=
$data
->{Indent};
my
$indent
=
undef
;
if
(
$level
> 0) {
$level
--;
}
$indent
=
' '
x (
$level
* 4);
my
@lines
=
map
{
$indent
.
$_
; }
split
(/\n/,
$text
);
return
wantarray
?
@lines
:
join
(
"\n"
,
@lines
);
}
sub
_clean_text {
my
$text
=
$_
[1];
my
@trimmed
=
grep
{
$_
; }
split
(/\n/,
$text
);
return
wantarray
?
@trimmed
:
join
(
"\n"
,
@trimmed
);
}
sub
_escape {
local
$_
=
$_
[1];
s/([][\\`
*_
s/^([-+*>])/\\$1/mg;
s/^( (?:>\s+)? \d+ ) (\.\x20)/$1\\$2/xgm;
return
$_
;
}
sub
command {
my
(
$parser
,
$command
,
$paragraph
,
$line_num
) =
@_
;
my
$data
=
$parser
->_private;
$paragraph
=
$parser
->_clean_text(
$paragraph
);
if
(
$command
=~ m{head(\d)}xms) {
my
$level
= $1;
$paragraph
=
$parser
->_escape(
$paragraph
);
$paragraph
=
$parser
->interpolate(
$paragraph
,
$line_num
);
$parser
->_save(
$parser
->format_header(
$level
,
$paragraph
));
if
(
$level
== 1) {
if
(
$paragraph
=~ m{NAME}xmsi) {
$data
->{searching} =
'title'
;
}
elsif
(
$paragraph
=~ m{AUTHOR}xmsi) {
$data
->{searching} =
'author'
;
}
else
{
$data
->{searching} =
''
;
}
}
}
elsif
(
$command
=~ m{over}xms) {
$data
->{Indent}++;
}
elsif
(
$command
=~ m{back}xms) {
$data
->{Indent}--;
$data
->{searching} =
''
;
}
elsif
(
$command
=~ m{item}xms) {
$paragraph
=~ s{^[ \t]* \* [ \t]*}{}xms;
if
(
$data
->{searching} eq
'listpara'
) {
$data
->{searching} =
'listheadhuddled'
;
}
else
{
$data
->{searching} =
'listhead'
;
}
if
(
length
$paragraph
) {
$parser
->textblock(
$paragraph
,
$line_num
);
}
}
return
;
}
sub
verbatim {
my
(
$parser
,
$paragraph
) =
@_
;
my
@lines
=
split
/\n/,
$paragraph
;
my
$indent
=
' '
x 4;
foreach
my
$line
(
@lines
){
next
unless
$line
=~ m/^( +)/;
$indent
= $1
if
length
($1) <
length
(
$indent
);
}
if
( (
my
$smallest
=
length
(
$indent
)) < 4 ){
$indent
=
' '
x (4 -
$smallest
);
$paragraph
=
join
"\n"
,
map
{ /^\t/ ?
$_
:
$indent
.
$_
}
@lines
;
}
$parser
->_save(
$paragraph
);
}
sub
_escape_non_code {
my
(
$parser
,
$text
,
$ptree
) =
@_
;
$text
=
$parser
->_escape(
$text
)
unless
$ptree
->isa(
'Pod::InteriorSequence'
) &&
$ptree
->cmd_name eq
'C'
;
return
$text
;
}
sub
textblock {
my
(
$parser
,
$paragraph
,
$line_num
) =
@_
;
my
$data
=
$parser
->_private;
$paragraph
=
join
''
,
$parser
->parse_text(
{
-expand_text
=>
'_escape_non_code'
},
$paragraph
,
$line_num
)->raw_text;
$paragraph
=
$parser
->interpolate(
$paragraph
,
$line_num
);
$paragraph
=
$parser
->_clean_text(
$paragraph
);
if
(
$data
->{searching} =~ m{title|author}xms) {
$data
->{
ucfirst
$data
->{searching} } =
$paragraph
;
$data
->{searching} =
''
;
}
elsif
(
$data
->{searching} =~ m{listhead(huddled)?$}xms) {
my
$is_huddled
= $1;
$paragraph
=
sprintf
'%s %s'
,
$data
->{ListType},
$paragraph
;
if
(
$is_huddled
) {
$paragraph
=
$parser
->_unsave() .
"\n"
.
$paragraph
;
}
$data
->{searching} =
'listpara'
;
}
elsif
(
$data
->{searching} eq
'listpara'
) {
$data
->{searching} =
''
;
}
$parser
->_save(
$paragraph
);
}
sub
interior_sequence {
my
(
$self
,
$seq_command
,
$seq_argument
,
$pod_seq
) =
@_
;
return
sprintf
'%s<%s>'
,
$seq_command
,
$seq_argument
if
$seq_command
eq
'L'
&&
$self
->_private->{InsideLink};
my
$i
= 2;
my
%interiors
= (
'I'
=>
sub
{
return
'_'
.
$_
[
$i
] .
'_'
},
'B'
=>
sub
{
return
'__'
.
$_
[
$i
] .
'__'
},
'C'
=>
sub
{
return
'`'
.
$_
[
$i
] .
'`'
},
'F'
=>
sub
{
return
'`'
.
$_
[
$i
] .
'`'
},
'S'
=>
sub
{
(
my
$s
=
$_
[
$i
]) =~ s/ /
 
;/g;
return
$s
;
},
'E'
=>
sub
{
my
$charname
=
$_
[
$i
];
return
'<'
if
$charname
eq
'lt'
;
return
'>'
if
$charname
eq
'gt'
;
return
'|'
if
$charname
eq
'verbar'
;
return
'/'
if
$charname
eq
'sol'
;
$charname
=~ s/\A([lr])chevron\z/${1}aquo/;
return
"&#$1;"
if
$charname
=~ /^0(x[0-9a-fA-Z]+)$/;
$charname
=
oct
(
$charname
)
if
$charname
=~ /^0\d+$/;
return
"&#$charname;"
if
$charname
=~ /^\d+$/;
return
"&$charname;"
;
},
'L'
=> \
&_resolv_link
,
'X'
=>
sub
{
''
},
'Z'
=>
sub
{
''
},
);
if
(
exists
$interiors
{
$seq_command
}) {
my
$code
=
$interiors
{
$seq_command
};
return
$code
->(
$self
,
$seq_command
,
$seq_argument
,
$pod_seq
);
}
else
{
return
sprintf
'%s<%s>'
,
$seq_command
,
$seq_argument
;
}
}
sub
_resolv_link {
my
(
$self
,
$cmd
,
$arg
) =
@_
;
local
$self
->_private->{InsideLink} = 1;
my
(
$text
,
$inferred
,
$name
,
$section
,
$type
) =
map
{
$_
&&
$self
->interpolate(
$_
, 1) }
Pod::ParseLink::parselink(
$arg
);
my
$url
=
''
;
if
(
$type
eq
'url'
) {
$url
=
$name
;
}
elsif
(
$type
eq
'man'
) {
my
(
$page
,
$part
) =
$name
=~ /\A([^(]+)(?:[(](\S*)[)])?/;
}
else
{
if
(
$name
) {
}
if
(
$section
){
$url
.=
'#'
.
$section
;
}
}
if
(!
$url
) {
return
sprintf
'%s<%s>'
,
$cmd
,
$arg
;
}
return
sprintf
'[%s](%s)'
, (
$text
||
$inferred
),
$url
;
}
sub
format_header {
my
(
$level
,
$paragraph
) =
@_
[1,2];
sprintf
'%s %s'
,
'#'
x
$level
,
$paragraph
;
}
1;