blib/lib/Pod/Confluence.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 134 | 148 | 90.5 |
branch | 28 | 32 | 87.5 |
condition | 6 | 7 | 85.7 |
subroutine | 38 | 42 | 90.4 |
pod | 1 | 31 | 3.2 |
total | 207 | 260 | 79.6 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | 1 | 1 | 30353 | use strict; | |||
1 | 2 | ||||||
1 | 21 | ||||||
2 | 1 | 1 | 3 | use warnings; | |||
1 | 1 | ||||||
1 | 44 | ||||||
3 | |||||||
4 | package Pod::Confluence; | ||||||
5 | $Pod::Confluence::VERSION = '1.01'; | ||||||
6 | # ABSTRACT: Converts pod to confluence flavored markdown | ||||||
7 | # PODNAME: Pod::Confluence | ||||||
8 | |||||||
9 | 1 | 1 | 3 | use parent qw(Pod::Simple::Methody); | |||
1 | 1 | ||||||
1 | 5 | ||||||
10 | |||||||
11 | 1 | 1 | 20972 | use HTML::Entities; | |||
1 | 3539 | ||||||
1 | 70 | ||||||
12 | 1 | 1 | 383 | use Log::Any; | |||
1 | 6430 | ||||||
1 | 4 | ||||||
13 | |||||||
14 | my $logger = Log::Any->get_logger(); | ||||||
15 | |||||||
16 | sub new { | ||||||
17 | 17 | 17 | 1 | 16399 | return shift->Pod::Simple::Methody::new()->_init(@_); | ||
18 | } | ||||||
19 | |||||||
20 | sub _confluence_macro_end { | ||||||
21 | 1 | 1 | 2 | my ( $self, %options ) = @_; | |||
22 | |||||||
23 | 1 | 50 | 4 | my @optional_elements = ( ( $options{has_text} ? ']]>' : () ), ); | |||
24 | |||||||
25 | 1 | 4 | return join( '', @optional_elements, '' ); | ||||
26 | } | ||||||
27 | |||||||
28 | sub _confluence_macro_start { | ||||||
29 | 18 | 18 | 48 | my ( $self, $name, %options ) = @_; | |||
30 | 18 | 100 | 61 | my $parameters = $options{parameters} || {}; | |||
31 | |||||||
32 | my @optional_elements = ( | ||||||
33 | 1 | 6 | ( map {" |
||||
34 | keys(%$parameters) | ||||||
35 | ), | ||||||
36 | 18 | 100 | 46 | ( $options{has_text} ? ' | |||
37 | ); | ||||||
38 | |||||||
39 | return join( '', | ||||||
40 | " | ||||||
41 | 18 | 100 | 102 | ( $options{self_close} ? ' /' : '' ), ">", @optional_elements ); | |||
42 | } | ||||||
43 | |||||||
44 | sub end_B { | ||||||
45 | 1 | 1 | 0 | 6 | my ( $self, $attribute_hash ) = @_; | ||
46 | 1 | 2 | $self->_print(''); | ||||
47 | } | ||||||
48 | |||||||
49 | sub end_C { | ||||||
50 | 1 | 1 | 0 | 5 | my ( $self, $attribute_hash ) = @_; | ||
51 | 1 | 3 | $self->_print(''); | ||||
52 | } | ||||||
53 | |||||||
54 | sub end_F { | ||||||
55 | 1 | 1 | 0 | 5 | my ( $self, $attribute_hash ) = @_; | ||
56 | 1 | 3 | $self->_print(''); | ||||
57 | } | ||||||
58 | |||||||
59 | sub end_head1 { | ||||||
60 | 6 | 6 | 0 | 28 | my ( $self, $attribute_hash ) = @_; | ||
61 | 6 | 8 | $self->_print(''); | ||||
62 | 6 | 21 | pop( @{ $self->{element_stack} } ); | ||||
6 | 13 | ||||||
63 | } | ||||||
64 | |||||||
65 | sub end_head2 { | ||||||
66 | 2 | 2 | 0 | 10 | my ( $self, $attribute_hash ) = @_; | ||
67 | 2 | 3 | $self->_print(''); | ||||
68 | 2 | 8 | pop( @{ $self->{element_stack} } ); | ||||
2 | 7 | ||||||
69 | } | ||||||
70 | |||||||
71 | sub end_head3 { | ||||||
72 | 0 | 0 | 0 | 0 | my ( $self, $attribute_hash ) = @_; | ||
73 | 0 | 0 | $self->_print(''); | ||||
74 | 0 | 0 | pop( @{ $self->{element_stack} } ); | ||||
0 | 0 | ||||||
75 | } | ||||||
76 | |||||||
77 | sub end_head4 { | ||||||
78 | 0 | 0 | 0 | 0 | my ( $self, $attribute_hash ) = @_; | ||
79 | 0 | 0 | $self->_print(''); | ||||
80 | 0 | 0 | pop( @{ $self->{element_stack} } ); | ||||
0 | 0 | ||||||
81 | } | ||||||
82 | |||||||
83 | sub end_I { | ||||||
84 | 1 | 1 | 0 | 7 | my ( $self, $attribute_hash ) = @_; | ||
85 | 1 | 2 | $self->_print(''); | ||||
86 | } | ||||||
87 | |||||||
88 | sub end_item_text { | ||||||
89 | 2 | 2 | 0 | 9 | my ( $self, $attribute_hash ) = @_; | ||
90 | 2 | 4 | $self->_print(''); | ||||
91 | 2 | 9 | $self->end_Para(); | ||||
92 | } | ||||||
93 | |||||||
94 | sub end_L { | ||||||
95 | 7 | 7 | 0 | 31 | my ( $self, $attribute_hash ) = @_; | ||
96 | 7 | 100 | 14 | if ( $self->{link_type} eq 'pod' ) { | |||
50 | |||||||
97 | 4 | 10 | $self->{in_cdata} = 0; | ||||
98 | 4 | 7 | $self->_print( ']]>' . '' ); | ||||
99 | } | ||||||
100 | elsif ( $self->{link_type} eq 'url' ) { | ||||||
101 | 3 | 4 | $self->_print(''); | ||||
102 | } | ||||||
103 | 7 | 35 | delete( $self->{link_type} ); | ||||
104 | } | ||||||
105 | |||||||
106 | sub end_over_text { | ||||||
107 | 1 | 1 | 0 | 6 | my ( $self, $attribute_hash ) = @_; | ||
108 | 1 | 3 | $self->{indent} -= 2; | ||||
109 | } | ||||||
110 | |||||||
111 | sub end_Para { | ||||||
112 | 22 | 22 | 0 | 82 | my ( $self, $attribute_hash ) = @_; | ||
113 | 22 | 25 | $self->_print(''); | ||||
114 | 22 | 94 | pop( @{ $self->{element_stack} } ); | ||||
22 | 43 | ||||||
115 | } | ||||||
116 | |||||||
117 | sub end_S { | ||||||
118 | 1 | 1 | 0 | 6 | my ( $self, $attribute_hash ) = @_; | ||
119 | 1 | 2 | $self->{in_non_breaking} = 0; | ||||
120 | } | ||||||
121 | |||||||
122 | sub end_Verbatim { | ||||||
123 | 1 | 1 | 0 | 6 | my ( $self, $attribute_hash ) = @_; | ||
124 | 1 | 2 | $self->{in_cdata} = 0; | ||||
125 | 1 | 4 | $self->_print( $self->_confluence_macro_end( has_text => 1 ) ); | ||||
126 | 1 | 4 | pop( @{ $self->{element_stack} } ); | ||||
1 | 4 | ||||||
127 | } | ||||||
128 | |||||||
129 | sub _handle_element_end { | ||||||
130 | 61 | 61 | 990 | $logger->tracef( '_handle_element_end(%s,%s)', $_[1], $_[2] ); | |||
131 | 61 | 356 | Pod::Simple::Methody::_handle_element_end(@_); | ||||
132 | } | ||||||
133 | |||||||
134 | sub _handle_element_start { | ||||||
135 | 61 | 61 | 9583 | $logger->tracef( '_handle_element_start(%s,%s)', $_[1], $_[2] ); | |||
136 | 61 | 401 | Pod::Simple::Methody::_handle_element_start(@_); | ||||
137 | } | ||||||
138 | |||||||
139 | sub handle_text { | ||||||
140 | 44 | 44 | 0 | 390 | my ( $self, $text ) = @_; | ||
141 | |||||||
142 | 44 | 100 | 112 | $text = encode_entities($text) unless ( $self->{in_cdata} ); | |||
143 | 44 | 100 | 334 | $text =~ s/[ \t]/ /g if ( $self->{in_non_breaking} ); | |||
144 | |||||||
145 | 44 | 66 | $logger->tracef( 'handle_text(%s)', $text ); | ||||
146 | 44 | 211 | $self->_print($text); | ||||
147 | } | ||||||
148 | |||||||
149 | sub _init { | ||||||
150 | 17 | 17 | 228 | my ( $self, %options ) = @_; | |||
151 | |||||||
152 | 17 | 29 | $self->{space_key} = $options{space_key}; | ||||
153 | $self->{packages_in_space} = | ||||||
154 | 17 | 12 | { map { $_ => 1 } @{ $options{packages_in_space} } }; | ||||
2 | 4 | ||||||
17 | 31 | ||||||
155 | 17 | 50 | 61 | $self->{confluence_schema_version} = $options{confluence_schema_version} || 1; | |||
156 | |||||||
157 | 17 | 17 | $self->{element_stack} = []; | ||||
158 | 17 | 28 | $self->{indent} = 0; | ||||
159 | |||||||
160 | 17 | 28 | return $self; | ||||
161 | } | ||||||
162 | |||||||
163 | sub _print { | ||||||
164 | 149 | 149 | 229 | my ( $self, $text ) = @_; | |||
165 | 149 | 99 | print( { $self->{output_fh} } $text ); | ||||
149 | 245 | ||||||
166 | } | ||||||
167 | |||||||
168 | sub start_B { | ||||||
169 | 1 | 1 | 0 | 5 | my ( $self, $attribute_hash ) = @_; | ||
170 | 1 | 3 | $self->_print(''); | ||||
171 | } | ||||||
172 | |||||||
173 | sub start_C { | ||||||
174 | 1 | 1 | 0 | 4 | my ( $self, $attribute_hash ) = @_; | ||
175 | 1 | 2 | $self->_print(''); |
||||
176 | } | ||||||
177 | |||||||
178 | sub start_F { | ||||||
179 | 1 | 1 | 0 | 4 | my ( $self, $attribute_hash ) = @_; | ||
180 | 1 | 2 | $self->_print(''); | ||||
181 | } | ||||||
182 | |||||||
183 | sub start_Document { | ||||||
184 | 17 | 17 | 0 | 81 | my ( $self, $attribute_hash ) = @_; | ||
185 | 17 | 28 | $self->_print( ' ' . $self->_confluence_macro_start( 'toc', self_close => 1 ) . ' ' ); |
||||
186 | } | ||||||
187 | |||||||
188 | sub start_head1 { | ||||||
189 | 6 | 6 | 0 | 27 | my ( $self, $attribute_hash ) = @_; | ||
190 | 6 | 11 | $self->_print(''); |
||||
191 | 6 | 30 | $self->{indent} = 0; | ||||
192 | } | ||||||
193 | |||||||
194 | sub start_head2 { | ||||||
195 | 2 | 2 | 0 | 9 | my ( $self, $attribute_hash ) = @_; | ||
196 | 2 | 3 | $self->_print(''); |
||||
197 | 2 | 9 | $self->{indent} = 0; | ||||
198 | } | ||||||
199 | |||||||
200 | sub start_head3 { | ||||||
201 | 0 | 0 | 0 | 0 | my ( $self, $attribute_hash ) = @_; | ||
202 | 0 | 0 | $self->_print(''); |
||||
203 | 0 | 0 | $self->{indent} = 0; | ||||
204 | } | ||||||
205 | |||||||
206 | sub start_head4 { | ||||||
207 | 0 | 0 | 0 | 0 | my ( $self, $attribute_hash ) = @_; | ||
208 | 0 | 0 | $self->_print(''); |
||||
209 | 0 | 0 | $self->{indent} = 0; | ||||
210 | } | ||||||
211 | |||||||
212 | sub start_I { | ||||||
213 | 1 | 1 | 0 | 5 | my ( $self, $attribute_hash ) = @_; | ||
214 | 1 | 4 | $self->_print(''); | ||||
215 | } | ||||||
216 | |||||||
217 | sub start_item_text { | ||||||
218 | 2 | 2 | 0 | 10 | my ( $self, $attribute_hash ) = @_; | ||
219 | 2 | 3 | $self->{indent} -= 1; | ||||
220 | 2 | 4 | $self->start_Para(); | ||||
221 | 2 | 10 | $self->{indent} += 1; | ||||
222 | 2 | 3 | $self->_print(''); | ||||
223 | } | ||||||
224 | |||||||
225 | sub start_L { | ||||||
226 | 7 | 7 | 0 | 23 | my ( $self, $attribute_hash ) = @_; | ||
227 | 7 | 9 | $self->{link_type} = $attribute_hash->{type}; | ||||
228 | 7 | 100 | 16 | if ( $attribute_hash->{type} eq 'pod' ) { | |||
50 | |||||||
229 | 6 | 3 | my $to = $attribute_hash->{to}; | ||||
230 | 6 | 100 | 100 | 14 | if ( !$to || $self->{packages_in_space}{"$to"} ) { | ||
231 | 4 | 40 | $self->{link_type} = 'pod'; | ||||
232 | $self->_print( | ||||||
233 | ( $attribute_hash->{section} | ||||||
234 | 4 | 100 | 9 | ? " |
|||
100 | |||||||
235 | : ' |
||||||
236 | ) | ||||||
237 | . ( $to ? " |
||||||
238 | : '' | ||||||
239 | ) | ||||||
240 | . ' | ||||||
241 | ); | ||||||
242 | 4 | 23 | $self->{in_cdata} = 1; | ||||
243 | } | ||||||
244 | else { | ||||||
245 | 2 | 50 | 37 | my $url = $to ? "https://metacpan.org/pod/$to" : ''; | |||
246 | 2 | 36 | my $section = $attribute_hash->{section}; | ||||
247 | 2 | 100 | 4 | if ($section) { | |||
248 | 1 | 14 | $section =~ s/[^a-zA-Z0-9]+/-/g; | ||||
249 | 1 | 17 | $section =~ s/-$//g; | ||||
250 | 1 | 3 | $url .= "#$section"; | ||||
251 | } | ||||||
252 | 2 | 2 | $self->{link_type} = 'url'; | ||||
253 | 2 | 6 | $self->_print(""); | ||||
254 | } | ||||||
255 | } | ||||||
256 | elsif ( $attribute_hash->{type} eq 'url' ) { | ||||||
257 | 1 | 2 | $self->{link_type} = 'url'; | ||||
258 | 1 | 3 | $self->_print(""); | ||||
259 | } | ||||||
260 | } | ||||||
261 | |||||||
262 | sub start_over_text { | ||||||
263 | 1 | 1 | 0 | 6 | my ( $self, $attribute_hash ) = @_; | ||
264 | 1 | 3 | $self->{indent} += 2; | ||||
265 | } | ||||||
266 | |||||||
267 | sub start_Para { | ||||||
268 | 22 | 22 | 0 | 84 | my ( $self, $attribute_hash ) = @_; | ||
269 | 22 | 20 | my $style; | ||||
270 | 22 | 100 | 43 | if ( $self->{indent} ) { | |||
271 | 4 | 9 | $style = 'style="margin-left: ' . ( $self->{indent} * 30 ) . 'px;"'; | ||||
272 | } | ||||||
273 | 22 | 100 | 44 | $self->_print( $style ? " " : ' ' ); |
|||
274 | } | ||||||
275 | |||||||
276 | sub start_S { | ||||||
277 | 1 | 1 | 0 | 4 | my ( $self, $attribute_hash ) = @_; | ||
278 | 1 | 3 | $self->{in_non_breaking} = 1; | ||||
279 | } | ||||||
280 | |||||||
281 | sub start_Verbatim { | ||||||
282 | 1 | 1 | 0 | 6 | my ( $self, $attribute_hash ) = @_; | ||
283 | 1 | 5 | $self->_print( | ||||
284 | $self->_confluence_macro_start( | ||||||
285 | 'code', | ||||||
286 | has_text => 1, | ||||||
287 | parameters => { language => 'perl' } | ||||||
288 | ) | ||||||
289 | ); | ||||||
290 | 1 | 7 | $self->{in_cdata} = 1; | ||||
291 | } | ||||||
292 | |||||||
293 | 1; | ||||||
294 | |||||||
295 | __END__ |