← Back to branch summary

~ubuntu-branches/ubuntu/vivid/liblocale-maketext-fuzzy-perl/vivid

« back to all changes in this revision

Viewing changes to inc/Pod/Markdown.pm

  • Committer: Package Import Robot
  • Author(s): gregor herrmann, Nathan Handler, Ansgar Burchardt, gregor herrmann
  • Date: 2011-12-11 16:39:01 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20111211163901-iku0antjs0o4i57j
Tags: 0.11-1
[ Nathan Handler ]
* debian/watch: Update to ignore development releases.

[ Ansgar Burchardt ]
* Email change: Ansgar Burchardt -> ansgar@debian.org
* debian/control: Convert Vcs-* fields to Git.

[ gregor herrmann ]
* New upstream release.
* Switch to "3.0 (quilt)" source format.
* Use tiny debian/rules file.
* debian/copyright: update formatting and upstream licensing terms.
* Bump Standards-Version to 3.9.2; remove version from perl build
  depency.
* Switch to debhelper compatibility level 8.
* Mention module name in long description.

Show diffs side-by-side

added added

removed removed

Lines of Context:
inc/Pod/Markdown.pm
 
1
#line 1
 
2
use 5.008;
 
3
use strict;
 
4
use warnings;
 
5
 
 
6
package Pod::Markdown;
 
7
BEGIN {
 
8
  $Pod::Markdown::VERSION = '1.110730';
 
9
}
 
10
# ABSTRACT: Convert POD to Markdown
 
11
use parent qw(Pod::Parser);
 
12
 
 
13
sub initialize {
 
14
    my $self = shift;
 
15
    $self->SUPER::initialize(@_);
 
16
    $self->_private;
 
17
    $self;
 
18
}
 
19
 
 
20
sub _private {
 
21
    my $self = shift;
 
22
    $self->{_MyParser} ||= {
 
23
        Text      => [],       # final text
 
24
        Indent    => 0,        # list indent levels counter
 
25
        ListType  => '-',      # character on every item
 
26
        searching => ''   ,    # what are we searching for? (title, author etc.)
 
27
        Title     => undef,    # page title
 
28
        Author    => undef,    # page author
 
29
    };
 
30
}
 
31
 
 
32
sub as_markdown {
 
33
    my ($parser, %args) = @_;
 
34
    my $data  = $parser->_private;
 
35
    my $lines = $data->{Text};
 
36
    my @header;
 
37
    if ($args{with_meta}) {
 
38
        @header = $parser->_build_markdown_head;
 
39
    }
 
40
    join("\n" x 2, @header, @{$lines});
 
41
}
 
42
 
 
43
sub _build_markdown_head {
 
44
    my $parser    = shift;
 
45
    my $data      = $parser->_private;
 
46
    my $paragraph = '';
 
47
    if (defined $data->{Title}) {
 
48
        $paragraph .= sprintf '[[meta title="%s"]]', $data->{Title};
 
49
    }
 
50
    if (defined $data->{Author}) {
 
51
        $paragraph .= "\n" . sprintf '[[meta author="%s"]]', $data->{Author};
 
52
    }
 
53
    return $paragraph;
 
54
}
 
55
 
 
56
sub _save {
 
57
    my ($parser, $text) = @_;
 
58
    my $data = $parser->_private;
 
59
    $text = $parser->_indent_text($text);
 
60
    push @{ $data->{Text} }, $text;
 
61
    return;
 
62
}
 
63
 
 
64
sub _unsave {
 
65
    my $parser = shift;
 
66
    my $data = $parser->_private;
 
67
    return pop @{ $data->{Text} };
 
68
}
 
69
 
 
70
sub _indent_text {
 
71
    my ($parser, $text) = @_;
 
72
    my $data   = $parser->_private;
 
73
    my $level  = $data->{Indent};
 
74
    my $indent = undef;
 
75
    if ($level > 0) {
 
76
        $level--;
 
77
    }
 
78
    $indent = ' ' x ($level * 4);
 
79
    my @lines = map { $indent . $_; } split(/\n/, $text);
 
80
    return wantarray ? @lines : join("\n", @lines);
 
81
}
 
82
 
 
83
sub _clean_text {
 
84
    my $text    = $_[1];
 
85
    my @trimmed = grep { $_; } split(/\n/, $text);
 
86
    return wantarray ? @trimmed : join("\n", @trimmed);
 
87
}
 
88
 
 
89
sub command {
 
90
    my ($parser, $command, $paragraph, $line_num) = @_;
 
91
    my $data = $parser->_private;
 
92
 
 
93
    # cleaning the text
 
94
    $paragraph = $parser->_clean_text($paragraph);
 
95
 
 
96
    # is it a header ?
 
97
    if ($command =~ m{head(\d)}xms) {
 
98
        my $level = $1;
 
99
 
 
100
        $paragraph = $parser->interpolate($paragraph, $line_num);
 
101
 
 
102
        # the headers never are indented
 
103
        $parser->_save($parser->format_header($level, $paragraph));
 
104
        if ($level == 1) {
 
105
            if ($paragraph =~ m{NAME}xmsi) {
 
106
                $data->{searching} = 'title';
 
107
            } elsif ($paragraph =~ m{AUTHOR}xmsi) {
 
108
                $data->{searching} = 'author';
 
109
            } else {
 
110
                $data->{searching} = '';
 
111
            }
 
112
        }
 
113
    }
 
114
 
 
115
    # opening a list ?
 
116
    elsif ($command =~ m{over}xms) {
 
117
 
 
118
        # update indent level
 
119
        $data->{Indent}++;
 
120
 
 
121
        # closing a list ?
 
122
    } elsif ($command =~ m{back}xms) {
 
123
 
 
124
        # decrement indent level
 
125
        $data->{Indent}--;
 
126
        $data->{searching} = '';
 
127
    } elsif ($command =~ m{item}xms) {
 
128
        $paragraph = $parser->interpolate($paragraph, $line_num);
 
129
        $paragraph =~ s{^\h* \* \h*}{}xms;
 
130
 
 
131
        if ($data->{searching} eq 'listpara') {
 
132
            $data->{searching} = 'listheadhuddled';
 
133
        }
 
134
        else {
 
135
            $data->{searching} = 'listhead';
 
136
        }
 
137
 
 
138
        if (length $paragraph) {
 
139
            $parser->textblock($paragraph, $line_num);
 
140
        }
 
141
    }
 
142
 
 
143
    # ignore other commands
 
144
    return;
 
145
}
 
146
 
 
147
sub verbatim {
 
148
    my ($parser, $paragraph) = @_;
 
149
    $parser->_save($paragraph);
 
150
}
 
151
 
 
152
sub textblock {
 
153
    my ($parser, $paragraph, $line_num) = @_;
 
154
    my $data = $parser->_private;
 
155
 
 
156
    # interpolate the paragraph for embebed sequences
 
157
    $paragraph = $parser->interpolate($paragraph, $line_num);
 
158
 
 
159
    # clean the empty lines
 
160
    $paragraph = $parser->_clean_text($paragraph);
 
161
 
 
162
    # searching ?
 
163
    if ($data->{searching} =~ m{title|author}xms) {
 
164
        $data->{ ucfirst $data->{searching} } = $paragraph;
 
165
        $data->{searching} = '';
 
166
    } elsif ($data->{searching} =~ m{listhead(huddled)?$}xms) {
 
167
        my $is_huddled = $1;
 
168
        $paragraph = sprintf '%s %s', $data->{ListType}, $paragraph;
 
169
        if ($is_huddled) {
 
170
            $paragraph = $parser->_unsave() . "\n" . $paragraph;
 
171
        }
 
172
        $data->{searching} = 'listpara';
 
173
    } elsif ($data->{searching} eq 'listpara') {
 
174
        $data->{searching} = '';
 
175
    }
 
176
 
 
177
    # save the text
 
178
    $parser->_save($paragraph);
 
179
}
 
180
 
 
181
sub interior_sequence {
 
182
    my ($seq_command, $seq_argument, $pod_seq) = @_[1..3];
 
183
    my %interiors = (
 
184
        'I' => sub { return '_' . $_[1] . '_' },      # italic
 
185
        'B' => sub { return '__' . $_[1] . '__' },    # bold
 
186
        'C' => sub { return '`' . $_[1] . '`' },      # monospace
 
187
        'F' => sub { return '`' . $_[1] . '`' },      # system path
 
188
        'S' => sub { return '`' . $_[1] . '`' },      # code
 
189
        'E' => sub {
 
190
            my $charname = $_[1];
 
191
            return '<' if $charname eq 'lt';
 
192
            return '>' if $charname eq 'gt';
 
193
            return '|' if $charname eq 'verbar';
 
194
            return '/' if $charname eq 'sol';
 
195
            return "&$charname;";
 
196
        },
 
197
        'L' => \&_resolv_link,
 
198
    );
 
199
    if (exists $interiors{$seq_command}) {
 
200
        my $code = $interiors{$seq_command};
 
201
        return $code->($seq_command, $seq_argument, $pod_seq);
 
202
    } else {
 
203
        return sprintf '%s<%s>', $seq_command, $seq_argument;
 
204
    }
 
205
}
 
206
 
 
207
sub _resolv_link {
 
208
    my ($cmd, $arg) = @_;
 
209
    my $text = $arg =~ s"^(.+?)\|"" ? $1 : '';
 
210
 
 
211
    if ($arg =~ m{^http|ftp}xms) { # direct link to a URL
 
212
        $text ||= $arg;
 
213
        return sprintf '[%s](%s)', $text, $arg;
 
214
    } elsif ($arg =~ m{^/(.*)$}) {
 
215
        $text ||= $1;
 
216
        $text = $1;
 
217
        return "[$text](\#pod_$1)";
 
218
    } elsif ($arg =~ m{^(\w+(?:::\w+)*)$}) {
 
219
        $text ||= $1;
 
220
        return "[$text](http://search.cpan.org/perldoc?$1)";
 
221
    } else {
 
222
        return sprintf '%s<%s>', $cmd, $arg;
 
223
    }
 
224
}
 
225
 
 
226
sub format_header {
 
227
    my ($level, $paragraph) = @_[1,2];
 
228
    sprintf '%s %s', '#' x $level, $paragraph;
 
229
}
 
230
 
 
231
1;
 
232
 
 
233
 
 
234
__END__
 
235
#line 341
 
236