File Coverage

lib/Pod/Definitions.pm

Criterion	Covered	Total	%
statement	151	159	94.9
branch	15	18	83.3
condition			n/a
subroutine	25	26	96.1
pod	6	7	85.7
total	197	210	93.8

package Pod::Definitions;

our $VERSION = '0.02';

use strict;
use warnings;

use v5.20;

use feature 'signatures';
no warnings 'experimental::signatures';

use Pod::Headings;
use Pod::Definitions::Heuristic;

#
#
#
sub new ($class, @args) {
    my $self = {@args};
    bless $self, $class;

    return $self;
}

#
# Accessors
#

sub file ($self) { return $self->{file}; }       # Local path to file
sub manpage ($self) { return $self->{manpage}; } # Full name of manpage ('Mojo::Path')
sub module ($self) { return $self->{module}; }   # Module leaf name ('Path')
sub sections ($self) { return $self->{sections}; } # Hash (key=toplevel section) of arrays
                                # of section names
#
#
#

sub convert_to_href_text ($human_text) {
    $human_text =~ s/(\s|\(|=|\[)/-/g;
    $human_text =~ s/([^a-zA-Z0-9_\-*:])//g;
    return $human_text;
}

sub _save_definition ($self, $parser, $attrs, $head1, $text) {
    my $cooked_heading = Pod::Definitions::Heuristic->new(text => $text);
    push @{$self->{sections}{$head1}}, {raw => $text,
                                        cooked => $cooked_heading->clean,
                                        link => $self->manpage(),
                                        link_fragment => convert_to_href_text($text),
                                    };
}

sub _save_file_manpage ($self, $text) {
    $self->{manpage} = $text unless defined $self->{manpage};
}

sub _save_file_module_leaf ($self, $text) {
    $self->{module} = $text;
}

sub _save_module_name ($self, $parser, $elem, $attrs, $text) {
    $text =~ m/^\s*(?\S+)/;
    my $module_name = $+{module_name};
    $self->_save_file_manpage($module_name);
    # "Mojo::Log" → index under last component: "Log"
    $self->_save_file_module_leaf( (split /::/, $module_name)[-1] );
}

sub _save_version ($self, $parser, $elem, $attrs, $text) {
    $self->{version} = $text;
}

sub _save_see_also ($self, $parser, $elem, $attrs, $text) {
    push @{$self->{see_also}}, $text;
}

sub parse_file ($self, $file, $podname = undef) {

    my $save_next;

    $self->{file} = $file;
    $self->_save_file_manpage($podname) if defined $podname;

    return Pod::Headings->new(
        head1 => sub ($parser, $elem, $attrs, $plaintext) {
            # "Archive::Zip Methods" -> "Methods":
            $plaintext =~ s/^($self->{manpage}\s+)//i if defined $self->{manpage};
            # Change headings starting in all-uppercase to inital caps
            # only. Note, "READING CPAN.pm" -> "Reading cpan.pm"
            # (there is only so much we can do without A.I.)
            if ($plaintext =~ /^[ \p{Uppercase}]{2,}/) {
                $plaintext =~ s/^(.)(.*)/\u$1\L$2/;
            }
            $parser->{_save_head1} = $plaintext;
            undef $parser->{_save_head2};
            $parser->{_save_first_para} = 1;

            if (lc($plaintext) eq 'name') {
                $save_next = \&_save_module_name;
            } elsif (lc($plaintext) eq 'version') {
                $save_next = \&_save_version;
            } elsif (lc($plaintext) eq 'see also') {
                $save_next = \&_save_see_also;
            } else {
                undef $save_next;
            }

            1;
        },
        head2 => sub ($parser, $elem, $attrs, $plaintext) {
            # print " $elem: $parser->{_save_head1}: $plaintext\n";
            $parser->{_save_head2} = $plaintext;
            $parser->{_save_first_para} = 1;

            $self->_save_definition ( $parser, $attrs, $parser->{_save_head1}, $plaintext );

            1;
        },
        head3 => sub ($parser, $elem, $attrs, $plaintext) {
            # print " $elem: $parser->{_save_head1} / $parser->{_save_head2}: $plaintext\n";
            $self->_save_definition ( $parser, $attrs, $parser->{_save_head2}, $plaintext );
            1;
        },
        Para => sub ($parser, $elem, $attrs, $plaintext) {
            if ($parser->{_save_first_para}) {
                # print " .... text: $plaintext\n";
                $self->$save_next($parser, $elem, $attrs, $plaintext) if defined $save_next;
                undef $save_next;
            }
            $parser->{_save_first_para} = 0;
            1;
        },
        L => 1,  # Return 0 to drop the plaintext passed to the containing element
        # Possible extension: In 'See Also' sections, accumulate the
        # actual links from Pod::Simple in the same form with (raw, cooked, link)
    )->parse_file($file);
}

1;

__END__