File Coverage

blib/lib/Spellunker/Pod/Parser.pm
Criterion Covered Total %
statement 50 51 98.0
branch 17 20 85.0
condition 9 11 81.8
subroutine 13 13 100.0
pod 1 4 25.0
total 90 99 90.9


line stmt bran cond sub pod time code
1             package Spellunker::Pod::Parser;
2 3     3   17 use strict;
  3         6  
  3         145  
3 3     3   18 use warnings;
  3         8  
  3         73  
4 3     3   15 use utf8;
  3         5  
  3         21  
5 3     3   3027 use parent qw(Pod::Simple::Methody);
  3         1059  
  3         17  
6              
7 3     3   389275 use Carp ();
  3         7  
  3         83  
8              
9             use constant {
10 3         2176 MODE_STOPWORDS => 1,
11             MODE_IGNORE => 2,
12             MODE_NORMAL => 3,
13 3     3   17 };
  3         6  
14              
15             sub _handle_element_start {
16 105     105   48661 my ($self, $element_name, $attr_hash_r) = @_;
17 105         134 $element_name =~ tr/-:./__/;
18              
19 105 100       253 if (my $start_line = $attr_hash_r->{start_line}) {
20 94         131 $self->{start_line} = $start_line;
21             }
22              
23 105 50 66     964 if ($element_name eq 'encoding') {
    100 100        
    100 100        
24 0         0 $self->{mode} = MODE_IGNORE;
25             } elsif ($element_name eq 'for') {
26 2 50       11 if ($attr_hash_r->{target} eq 'stopwords') {
27 2         9 $self->{mode} = MODE_STOPWORDS;
28             }
29             } elsif (
30             $element_name eq 'code'
31             || $element_name eq 'Verbatim'
32             || $element_name eq 'C' # C<>
33             || $element_name eq 'L' # L<>
34             ) {
35 16         73 $_[0]->{mode} = MODE_IGNORE;
36             }
37             }
38              
39             sub _handle_element_end {
40 105     105   879 my ($self, $element_name, $attr_hash_r) = @_;
41 105         121 $element_name =~ tr/-:./__/;
42 105         219 $self->{mode} = MODE_NORMAL;
43             }
44              
45             sub new {
46 10     10 1 16 my $self = shift;
47 10         77 my $new = $self->SUPER::new(@_);
48 10   50     415 $new->{'output_fh'} ||= *STDOUT{IO};
49 10         27 $new->{mode} = 'normal';
50 10         51 $new->accept_target_as_text(qw( text plaintext plain stopwords ));
51              
52             # whether to ignore X<...> codes
53 10         319 $new->nix_X_codes(1);
54              
55             # Whether to map S<...>'s to \xA0 characters
56 10         116 $new->nbsp_for_S(1);
57              
58             # whether to try to keep whitespace as-is
59 10         88 $new->preserve_whitespace(1);
60              
61 10         78 return $new;
62             }
63              
64 10 100   10 0 63 sub stopwords { $_[0]->{stopwords} || [] }
65 10 100   10 0 45 sub lines { $_[0]->{lines} || [] }
66 108 50   108 0 387 sub start_line { $_[0]->{start_line} || 0 }
67              
68             sub _handle_text {
69 101     101   696 my ($self, $text) = @_;
70 101 100       294 if ($self->{mode} eq MODE_IGNORE) {
    100          
71             # nop.
72             } elsif ($self->{mode} eq MODE_STOPWORDS) {
73 2         5 push @{$self->{stopwords}}, $text;
  2         9  
74             } else {
75 83         87 my $offset = 0;
76 83         210 for my $line (split /\n/, $text) {
77 108         105 push @{$self->{lines}}, [
  108         253  
78             $self->start_line + $offset, $line
79             ];
80 108         335 $offset++;
81             }
82             }
83             }
84              
85             1;
86