line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Wiki::Toolkit::Formatter::Pod; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
23566
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
84
|
|
4
|
|
|
|
|
|
|
|
5
|
2
|
|
|
2
|
|
12
|
use vars qw( $VERSION ); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
121
|
|
6
|
|
|
|
|
|
|
$VERSION = '0.04'; |
7
|
|
|
|
|
|
|
|
8
|
2
|
|
|
2
|
|
1992
|
use IO::Scalar; |
|
2
|
|
|
|
|
31693
|
|
|
2
|
|
|
|
|
686
|
|
9
|
2
|
|
|
2
|
|
2023
|
use Pod::Tree::HTML; |
|
2
|
|
|
|
|
86399
|
|
|
2
|
|
|
|
|
1363
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=head1 NAME |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
Wiki::Toolkit::Formatter::Pod - A Pod to HTML formatter for Wiki::Toolkit. |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 DESCRIPTION |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
A Pod to HTML formatter backend for L. |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 SYNOPSIS |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
my $store = Wiki::Toolkit::Store::SQLite->new( ... ); |
22
|
|
|
|
|
|
|
my $formatter = Wiki::Toolkit::Formatter::Pod->new; |
23
|
|
|
|
|
|
|
my $wiki = Wiki::Toolkit->new( store => $store, |
24
|
|
|
|
|
|
|
formatter => $formatter ); |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
Go look at L to find out more. This module is distributed |
27
|
|
|
|
|
|
|
separately solely for convenience of testing and maintenance; it's |
28
|
|
|
|
|
|
|
probably not too useful on its own. |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head1 METHODS |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=over 4 |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=item B |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
my $formatter = Wiki::Toolkit::Formatter::Pod->new( |
37
|
|
|
|
|
|
|
node_prefix => 'wiki.cgi?node=', |
38
|
|
|
|
|
|
|
usemod_extended_links => 0, |
39
|
|
|
|
|
|
|
); |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
C is optional and defaults to the value shown above. |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
If C is supplied and true, then UseModWiki-style |
44
|
|
|
|
|
|
|
extended links C<[[like this]]> will be supported - ie |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
[[foo bar]] |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
will be translated into a link to the node named "Foo Bar". (Node |
49
|
|
|
|
|
|
|
names are forced to ucfirst, ie first letter of each word is capitalised.) |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
B You must have L installed if |
52
|
|
|
|
|
|
|
you wish to use the C parameter. |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=cut |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
sub new { |
57
|
2
|
|
|
2
|
1
|
1740
|
my ($class, %args) = @_; |
58
|
2
|
|
|
|
|
6
|
my $self = { }; |
59
|
2
|
|
|
|
|
6
|
bless $self, $class; |
60
|
2
|
|
100
|
|
|
14
|
my $node_prefix = $args{node_prefix} || "wiki.cgi?node="; |
61
|
2
|
|
|
|
|
8
|
$self->{_node_prefix} = $node_prefix; |
62
|
2
|
|
50
|
|
|
13
|
$self->{_usemod_extended_links} = $args{usemod_extended_links} || 0; |
63
|
2
|
|
|
|
|
16
|
my $link_mapper = Wiki::Toolkit::Formatter::Pod::LinkMapper->new( |
64
|
|
|
|
|
|
|
node_prefix => $node_prefix ); |
65
|
2
|
|
|
|
|
5
|
$self->{_link_mapper} = $link_mapper; |
66
|
2
|
|
|
|
|
7
|
return $self; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=item B |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
my $html = $formatter->format( $content ); |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
Uses L to translate the pod supplied in C<$content> |
74
|
|
|
|
|
|
|
into HTML. Links will be treated as links to other wiki pages. |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=cut |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub format { |
79
|
2
|
|
|
2
|
1
|
1013
|
my ($self, $raw) = @_; |
80
|
2
|
50
|
|
|
|
7
|
return "" unless $raw; |
81
|
2
|
|
|
|
|
5
|
my $source = \$raw; |
82
|
2
|
|
|
|
|
4
|
my $formatted; |
83
|
2
|
|
|
|
|
19
|
my $dest = IO::Scalar->new( \$formatted ); |
84
|
2
|
|
|
|
|
248
|
my %options = ( link_map => $self->{_link_mapper} ); |
85
|
2
|
|
|
|
|
19
|
my $html = Pod::Tree::HTML->new( $source, $dest, %options ); |
86
|
2
|
|
|
|
|
1917
|
$html->translate; |
87
|
2
|
|
|
|
|
1726
|
$formatted =~ s/^.*]*>//s; |
88
|
2
|
|
|
|
|
10
|
$formatted =~ s|.*$||s; |
89
|
2
|
50
|
|
|
|
9
|
if ( $self->{_usemod_extended_links} ) { |
90
|
|
|
|
|
|
|
# Create link from [[foo bar]]. |
91
|
0
|
|
|
|
|
0
|
$formatted =~ s/(\[\[[^\]]+\]\])/$self->_linkify($1)/egs; |
|
0
|
|
|
|
|
0
|
|
92
|
|
|
|
|
|
|
} |
93
|
2
|
|
|
|
|
85
|
return $formatted; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
sub _linkify { |
97
|
0
|
|
|
0
|
|
0
|
my ($self, $node) = @_; |
98
|
0
|
|
|
|
|
0
|
require Wiki::Toolkit::Formatter::UseMod; |
99
|
0
|
|
|
|
|
0
|
my $formatter = Wiki::Toolkit::Formatter::UseMod->new( |
100
|
|
|
|
|
|
|
implicit_links => 0, |
101
|
|
|
|
|
|
|
extended_links => 1, |
102
|
|
|
|
|
|
|
node_prefix => $self->{_node_prefix}, |
103
|
|
|
|
|
|
|
); |
104
|
0
|
|
|
|
|
0
|
my $snippet = $formatter->format($1); |
105
|
|
|
|
|
|
|
# Snippet will be created as a paragraph, which we don't want as we're |
106
|
|
|
|
|
|
|
# inlining this. |
107
|
0
|
|
|
|
|
0
|
$snippet =~ s/^ //s; |
108
|
0
|
|
|
|
|
0
|
$snippet =~ s/<\/p>$//s; |
109
|
0
|
|
|
|
|
0
|
return $snippet; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head1 SEE ALSO |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
L, L. |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=head1 AUTHOR |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
Kake Pugh (kake@earth.li), idea stolen from Matt Sergeant. Many thanks to |
119
|
|
|
|
|
|
|
Steven W McDougall for extending the capabilities of L so |
120
|
|
|
|
|
|
|
I could make this work. |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=head1 COPYRIGHT |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
Copyright (C) 2003 Kake Pugh. All Rights Reserved. |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
This module is free software; you can redistribute it and/or modify it |
127
|
|
|
|
|
|
|
under the same terms as Perl itself. |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=cut |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
package Wiki::Toolkit::Formatter::Pod::LinkMapper; |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub new { |
135
|
2
|
|
|
2
|
|
5
|
my ($class, %args) = @_; |
136
|
2
|
|
|
|
|
4
|
my $self = { }; |
137
|
2
|
|
|
|
|
7
|
bless $self, $class; |
138
|
2
|
|
50
|
|
|
12
|
$self->{_node_prefix} = $args{node_prefix} || ""; |
139
|
2
|
|
|
|
|
5
|
return $self; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub url { |
143
|
2
|
|
|
2
|
|
3432
|
my ($self, $html, $target) = @_; |
144
|
2
|
|
|
|
|
9
|
my $page = $target->get_page; |
145
|
2
|
|
|
|
|
13
|
my $section = $target->get_section; |
146
|
2
|
50
|
|
|
|
12
|
if ( $page ) { |
147
|
2
|
|
|
|
|
11
|
$page = $self->{_node_prefix} . $html->escape_2396($page); |
148
|
|
|
|
|
|
|
} |
149
|
2
|
|
|
|
|
19
|
$section = $html->escape_2396($section); |
150
|
2
|
|
|
|
|
16
|
return $html->assemble_url("", $page, $section); |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
1; |