| 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__ |