use
5.006;
our
$VERSION
=
'0.02'
;
sub
initialize {
my
$self
=
shift
;
$self
->SUPER::initialize(
@_
);
$self
->_private;
$self
;
}
sub
_private {
my
$self
=
shift
;
$self
->{_MyParser} ||= {
Text
=> [],
Indent
=> 0,
ListType
=>
'-'
,
searching
=>
undef
,
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
_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
$parser
=
shift
;
my
$text
=
shift
;
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;
$parser
->_save(
sprintf
'%s %s'
,
'#'
x
$level
,
$paragraph
);
if
(
$level
== 1) {
if
(
$paragraph
=~ m{NAME}xmsi) {
$data
->{searching} =
'title'
;
}
elsif
(
$paragraph
=~ m{AUTHOR}xmsi) {
$data
->{searching} =
'author'
;
}
else
{
$data
->{searching} =
undef
;
}
}
}
elsif
(
$command
=~ m{over}xms) {
$data
->{Indent}++;
}
elsif
(
$command
=~ m{back}xms) {
$data
->{Indent}--;
}
elsif
(
$command
=~ m{item}xms) {
$parser
->_save(
sprintf
'%s %s'
,
$data
->{ListType},
$parser
->interpolate(
$paragraph
,
$line_num
));
}
return
;
}
sub
verbatim {
my
(
$parser
,
$paragraph
,
$line_num
) =
@_
;
$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}) {
if
(
$data
->{searching} =~ m{title|author}xms) {
$data
->{
ucfirst
$data
->{searching} } =
$paragraph
;
$data
->{searching} =
undef
;
}
}
$parser
->_save(
$paragraph
);
}
sub
interior_sequence {
my
(
$parser
,
$seq_command
,
$seq_argument
,
$pod_seq
) =
@_
;
my
$data
=
$parser
->_private;
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
(
$seq
,
$charname
) =
@_
;
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
,
$pod_seq
) =
@_
;
if
(
$arg
=~ m{^http|ftp}xms) {
return
sprintf
'<%s>'
,
$arg
;
}
elsif
(
$arg
=~ m{^(\w+(::\w+)*)$}) {
}
else
{
return
sprintf
'%s<%s>'
,
$cmd
,
$arg
;
}
}
1;