File Coverage

blib/lib/App/PodLinkCheck/ParseSections.pm

Criterion	Covered	Total	%
statement	44	44	100.0
branch	9	10	90.0
condition	2	3	66.6
subroutine	11	11	100.0
pod	2	2	100.0
total	68	70	97.1

# Copyright 2010, 2011, 2012, 2013, 2016 Kevin Ryde

# This file is part of PodLinkCheck.

# PodLinkCheck is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# PodLinkCheck is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with PodLinkCheck.  If not, see .

package App::PodLinkCheck::ParseSections;
use 5.006;
use strict;
use warnings;
use base 'Pod::Simple';

use vars '$VERSION';
$VERSION = 15;

# uncomment this to run the ### lines
# use Smart::Comments;

sub new {
  my ($class, $plc) = @_;
  my $self = $class->SUPER::new;
  $self->{(__PACKAGE__)}->{'sections'} = {};
  $self->no_errata_section(1);
  $self->preserve_whitespace(1);
  if (! $plc->{'verbose'}) {
    $self->no_whining(1);
  }
  return $self;
}

sub sections_hashref {
  my ($self) = @_;
  return $self->{(__PACKAGE__)}->{'sections'};
}

sub _handle_element_start {
  my ($self, $ename, $attr) = @_;
  ### _handle_element_start(): $ename, $attr

  # Any of head1
  #        head2
  #        head3
  #        head4
  #        item-text
  #        item-bullet
  #        item-number
  if ($ename =~ /^(head|item)/) {
    $self->{(__PACKAGE__)}->{'item_text'} = '';
  }

  # in_X is true when within an X<>, possibly a nested X c>
  # although that's likely a mistake and probably meaningless
  $self->{(__PACKAGE__)}->{'in_X'} += ($ename eq 'X');
}
sub _handle_text {
  my ($self, $text) = @_;
  ### _handle_text(): $text
  if (exists $self->{(__PACKAGE__)}->{'item_text'}
     && ! $self->{(__PACKAGE__)}->{'in_X'}) {
    $self->{(__PACKAGE__)}->{'item_text'} .= $text;
  }
}
sub _handle_element_end {
  my ($self, $ename) = @_;
  ### _handle_element_end(): $ename

  $self->{(__PACKAGE__)}->{'in_X'} -= ($ename eq 'X');

  if ($ename =~ /^(head|item)/) {
    my $section = delete $self->{(__PACKAGE__)}->{'item_text'};
    ### section: $section

    $section = _collapse_whitespace ($section);
    $self->{(__PACKAGE__)}->{'sections'}->{$section} = 1;

    # Like Pod::Checker take the first word, meaning up to the first
    # whitespace, as a section name too, which is much used for
    # cross-references to perlfunc.
    #
    # THINK-ABOUT-ME: CHI.pm is better treated by taking the first \w word
    # so as to exclude parens etc.
    #
    if ($section =~ s/\s.*//) {
      ### section one word: $section
      $self->{(__PACKAGE__)}->{'sections'}->{$section} = 1;
    }
  }
}

sub _collapse_whitespace {
  my ($str) = @_;
  $str =~ s/\s+/ /g;
  $str =~ s/^\s+//;
  $str =~ s/\s+$//;
  return $str;
}

1;
__END__