File Coverage

blib/lib/Pod/Simple/Words.pm

Criterion	Covered	Total	%
statement	126	139	90.6
branch	50	52	96.1
condition	3	3	100.0
subroutine	16	18	88.8
pod	4	4	100.0
total	199	216	92.1

package Pod::Simple::Words;

use strict;
use warnings;
use 5.026;
use experimental qw( signatures );
use JSON::MaybeXS qw( encode_json );
use Text::HumanComputerWords 0.02;
use PPI;
use URI;
use base qw( Pod::Simple );

# ABSTRACT: Parse words and locations from a POD document
our $VERSION = '0.07'; # VERSION


__PACKAGE__->_accessorize(
  qw( line_number in_verbatim in_head1 callback target head1 skip_section_hash link_address in_section_title splitter ),
);


sub new ($class)
{
  my $self = $class->SUPER::new;
  $self->preserve_whitespace(1);
  $self->in_verbatim(0);
  $self->in_head1(0);
  $self->in_section_title(0);
  $self->head1('');
  $self->no_errata_section(1);
  $self->accept_targets( qw( stopwords ));
  $self->target(undef);
  $self->skip_section_hash({});
  if(! defined $self->splitter)
  {
    $self->splitter(
      Text::HumanComputerWords->new(
        Text::HumanComputerWords->default_perl,
      ),
    );
  }
  $self->callback(sub {
    my $row = encode_json \@_;
    print "--- $row\n";
  });
  $self;
}


sub skip_sections ($self, @sections)
{
  $self->skip_section_hash->{lc $_} = 1 for @sections;
}

sub _handle_element_start ($self, $tagname, $attrhash, @)
{
  $self->line_number($attrhash->{start_line}) if defined $attrhash->{start_line};

  if($tagname eq 'L')
  {
    my @row = ( $attrhash->{type} . "_link", $self->source_filename, $self->line_number, [undef, undef] );
    if($attrhash->{type} eq 'url')
    {
      my $url = URI->new($attrhash->{to});
      if(defined $url->fragment)
      {
        $row[3]->[1] = $url->fragment;
        $url->fragment(undef);
      }
      $row[3]->[0] = "$url";
    }
    else
    {
      $row[3]->[0] = $attrhash->{to} .      '' if defined $attrhash->{to};
      $row[3]->[1] = $attrhash->{section} . '' if defined $attrhash->{section};
    }
    $self->callback->(@row);
    $self->link_address($attrhash->{to});
  }
  elsif($tagname eq 'for')
  {
    $self->target($attrhash->{target});
  }
  elsif($tagname eq 'Verbatim')
  {
    $self->in_verbatim($self->in_verbatim+1);
  }
  elsif($tagname eq 'head1')
  {
    $self->in_head1($self->in_head1+1);
    $self->head1('');
    $self->in_section_title(1);
  }
  elsif($tagname =~ /^head[0-9]+$/)
  {
    $self->in_section_title(1);
  }
  ();
}

sub _handle_element_end ($self, $tagname, @)
{
  if($tagname eq 'Verbatim')
  {
    $self->in_verbatim($self->in_verbatim-1);
  }
  elsif($tagname eq 'head1')
  {
    $self->in_head1($self->in_head1-1);
    $self->in_section_title(0);
  }
  elsif($tagname =~ /^head[0-9]+$/)
  {
    $self->in_section_title(0);
  }
  elsif($tagname eq 'for')
  {
    $self->target(undef);
  }
  elsif($tagname eq 'L')
  {
    $self->link_address(undef);
  }
}

sub _add_words ($self, $line)
{
  foreach my $event ($self->splitter->split($line))
  {
    my($type, $word) = @$event;
    my @row = ( $type, $self->source_filename, $self->line_number, $word );
    $self->callback->(@row);
  }
}

sub whine ($self, $line, $complaint)
{
  my @row = ( 'error', $self->source_filename, $self->line_number, $complaint );
  $self->callback->(@row);
  $self->SUPER::whine($line, $complaint);
}

sub scream ($self, $line, $complaint)
{
  my @row = ( 'error', $self->source_filename, $self->line_number, $complaint );
  $self->callback->(@row);
  $self->SUPER::scream($line, $complaint);
}

sub _handle_text ($self, $text)
{
  return if defined $self->link_address && $self->link_address eq $text;

  if($self->in_section_title)
  {
    my @row = ( 'section', $self->source_filename, $self->line_number, $text );
    $self->callback->(@row);
  }

  if($self->in_head1)
  {
    $self->head1(lc $text);
  }
  else
  {
    return if $self->skip_section_hash->{$self->head1};
  }
  if($self->target)
  {
    if($self->target eq 'stopwords')
    {
      foreach my $word (split /\b{wb}/, $text)
      {
        next unless $word =~ /\w/;
        my @row = ( 'stopword', $self->source_filename, $self->line_number, $word );
        $self->callback->(@row);
      }
    }
  }
  elsif($self->in_verbatim)
  {
    my $base_line = $self->line_number;
    my $doc = PPI::Document->new(\$text);
    foreach my $comment (($doc->find('PPI::Token::Comment') || [])->@*)
    {
      $self->line_number($base_line + $comment->location->[0] - 1);
      $self->_add_words("$comment");
    }
  }
  else
  {
    $text = lc $text if $self->in_head1;
    while($text =~ /^(.*?)\r?\n(.*)$/)
    {
      $text = $2;
      $self->_add_words($1);
      $self->line_number($self->line_number+1);
    }
    $self->_add_words($text);
  }
  ();
}

1;

__END__