File Coverage

blib/lib/Pod/Spell.pm

Criterion	Covered	Total	%
statement	68	69	98.5
branch	34	40	85.0
condition	15	21	71.4
subroutine	13	14	92.8
pod	4	4	100.0
total	134	148	90.5

package Pod::Spell;
use 5.008;
use strict;
use warnings;

our $VERSION = '1.26';

sub new {
    my ( $class, %args ) = @_;

    my $no_wide_chars = delete $args{no_wide_chars};
    my $debug = exists $args{debug} ? delete $args{debug} : $ENV{PERL_POD_SPELL_DEBUG};

    my $stopwords = $args{stopwords} || do {
        require Pod::Wordlist;
        Pod::Wordlist->new(
            _is_debug => $debug,
            no_wide_chars => $no_wide_chars
        )
    };

    my $parser = Pod::Spell::_Processor->new;
    $parser->stopwords($stopwords);
    $parser->_is_debug($debug);
    open my $output_fh, '>&:encoding(UTF-8)', \*STDOUT
      or die "can't dup STDOUT: $!";
    $parser->output_fh($output_fh);

    my %self = (
        processor => $parser,
        stopwords => $stopwords,
        debug => $debug,
    );

    bless \%self, $class
}

sub _is_debug { (shift)->{debug} ? 1 : 0; }

sub stopwords { (shift)->{stopwords} }

sub parse_from_file {
    shift->{processor}->parse_from_file(@_)
}

sub parse_from_filehandle {
    shift->{processor}->parse_from_file(@_)
}

package # Hide from indexing
    Pod::Spell::_Processor;
use parent 'Pod::Simple';

use Text::Wrap ();

__PACKAGE__->_accessorize(qw(
    stopwords
    _is_debug
));

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    $self->accept_targets('stopwords');
    return $self;
}

my %track_elements = (
    for       => 1,
    Verbatim  => 1,
    L         => 1,
    C         => 1,
    F         => 1,
);

sub _handle_element_start {
    my ($self, $element_name, $attr) = @_;
    $self->{buffer} = ''
        if !defined $self->{buffer};

    if ($track_elements{$element_name}) {
        push @{ $self->{in_element} }, [ $element_name, $attr ];
    }
}

sub _handle_text {
    my ($self, $text) = @_;

    my $in = $self->{in_element};
    if ($in && @$in) {
        my ($element_name, $attr) = @{$in->[-1]};
        if ($element_name eq 'for' && $attr->{target_matching} eq 'stopwords') {
            # this will match both for/begin and stopwords/:stopwords

            print "Stopword para: <$text>\n"
                if $self->_is_debug;
            $self->stopwords->learn_stopwords($text);
            return;
        }
        # totally ignore verbatim sections
        elsif ($element_name eq 'Verbatim') {
            return;
        }
        elsif ($element_name eq 'L') {
            return
                if $attr->{'content-implicit'};
        }
        elsif ($element_name eq 'C' || $element_name eq 'F') {
            # maintain word boundaries
            my $pre = $text =~ s{\A\s+}{} ? ' ' : '';
            my $post = $text =~ s{\s+\z}{} ? ' ' : '';
            # if _ is joined with text before or after, it will be treated as
            # a Perl token and the entire word ignored
            $text = $pre . (length $text ? '_' : '') . $post;
        }
    }

    $self->{buffer} .= $text;
}

sub _handle_element_end {
    my ($self, $element_name) = @_;

    my $in = $self->{in_element};
    if ($in && @$in && $in->[-1][0] eq $element_name) {
        pop @$in;
    }

    return
        if $element_name !~ m{\A(?:Para|head\d|item-.*|over-block)\z};

    my $buffer = delete $self->{buffer};
    if (!defined $buffer || !length $buffer) {
        return;
    }

    my $fh = $self->output_fh;

    my $out = $self->stopwords->strip_stopwords($buffer);

    # maintain exact output of older Pod::Parser based implementation
    print { $fh } "\n"
        if $element_name ne 'Para';

    return
        if !length $out;

    local $Text::Wrap::huge = 'overflow';
    print { $fh } Text::Wrap::wrap( '', '', $out ) . "\n\n";
}

1;

__END__