use
5.008;
BEGIN {
$Pod::Markdown::VERSION
=
'1.110730'
;
}
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
});
}
sub
_build_markdown_head {
my
$parser
=
shift
;
my
$data
=
$parser
->_private;
my
$paragraph
=
''
;
if
(
defined
$data
->{Title}) {
$paragraph
.=
sprintf
'[[meta title="%s"]]'
,
$data
->{Title};
}
if
(
defined
$data
->{Author}) {
$paragraph
.=
"\n"
.
sprintf
'[[meta author="%s"]]'
,
$data
->{Author};
}
return
$paragraph
;
}
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
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
->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
=
$parser
->interpolate(
$paragraph
,
$line_num
);
$paragraph
=~ s{^\h* \* \h*}{}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
) =
@_
;
$parser
->_save(
$paragraph
);
}
sub
textblock {
my
(
$parser
,
$paragraph
,
$line_num
) =
@_
;
my
$data
=
$parser
->_private;
$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
(
$seq_command
,
$seq_argument
,
$pod_seq
) =
@_
[1..3];
my
%interiors
= (
'I'
=>
sub
{
return
'_'
.
$_
[1] .
'_'
},
'B'
=>
sub
{
return
'__'
.
$_
[1] .
'__'
},
'C'
=>
sub
{
return
'`'
.
$_
[1] .
'`'
},
'F'
=>
sub
{
return
'`'
.
$_
[1] .
'`'
},
'S'
=>
sub
{
return
'`'
.
$_
[1] .
'`'
},
'E'
=>
sub
{
my
$charname
=
$_
[1];
return
'<'
if
$charname
eq
'lt'
;
return
'>'
if
$charname
eq
'gt'
;
return
'|'
if
$charname
eq
'verbar'
;
return
'/'
if
$charname
eq
'sol'
;
return
"&$charname;"
;
},
'L'
=> \
&_resolv_link
,
);
if
(
exists
$interiors
{
$seq_command
}) {
my
$code
=
$interiors
{
$seq_command
};
return
$code
->(
$seq_command
,
$seq_argument
,
$pod_seq
);
}
else
{
return
sprintf
'%s<%s>'
,
$seq_command
,
$seq_argument
;
}
}
sub
_resolv_link {
my
(
$cmd
,
$arg
) =
@_
;
my
$text
=
$arg
=~ s
"^(.+?)\|"
" ? $1 :
''
;
if
(
$arg
=~ m{^http|ftp}xms) {
$text
||=
$arg
;
return
sprintf
'[%s](%s)'
,
$text
,
$arg
;
}
elsif
(
$arg
=~ m{^/(.*)$}) {
$text
||= $1;
$text
= $1;
return
"[$text](\#pod_$1)"
;
}
elsif
(
$arg
=~ m{^(\w+(?:::\w+)*)$}) {
$text
||= $1;
}
else
{
return
sprintf
'%s<%s>'
,
$cmd
,
$arg
;
}
}
sub
format_header {
my
(
$level
,
$paragraph
) =
@_
[1,2];
sprintf
'%s %s'
,
'#'
x
$level
,
$paragraph
;
}
1;