File Coverage

blib/lib/Pod/Index/Builder.pm

Criterion	Covered	Total	%
statement	71	74	95.9
branch	11	20	55.0
condition	1	6	16.6
subroutine	15	15	100.0
pod	2	9	22.2
total	100	124	80.6

package Pod::Index::Builder;

use 5.008;
$VERSION = '0.14';

use strict;
use warnings;

use base qw(Pod::Parser);
use Pod::Index::Entry;
use File::Spec;

####### Pod::Parser overriden methods

sub begin_input {
    my ($self) = @_;
    $self->{pi_breadcrumbs} = [];
}

sub verbatim {
    #my ($self, $text, $line_num, $pod_para) = @_;
    # do nothing
}

sub textblock {
    my ($self, $text, $line_num, $pod_para) = @_;
    $self->{pi_pos} = [$pod_para->file_line, [ @{$self->{pi_breadcrumbs}} ] ];
    $self->interpolate($text, $line_num);
    return;
}

sub command {
    my ($self, $cmd, $text, $line_num, $pod_para)  = @_;
    my $breadcrumbs = $self->{pi_breadcrumbs};
    if ($cmd =~ /head(\d)/) {
        my $level = $1;
        splice @$breadcrumbs, $level-1 if @$breadcrumbs >= $level;
        $self->{pi_pos} = [$pod_para->file_line, [ @$breadcrumbs ] ];
        my $s = $self->interpolate($text, $line_num);
        $self->{pi_breadcrumbs}[$level - 1] = $s;
    } else {
        $self->{pi_pos} = [$pod_para->file_line, [ @$breadcrumbs ] ];
        $self->interpolate($text, $line_num);
    }
    return;
}

sub interior_sequence {
    my ($self, $seq_command, $seq_argument, $seq_obj) = @_ ;
    if ($seq_command eq 'X') {
        $self->add_entry($seq_argument);
        return '';
    }
    return $seq_argument;
}


###### new methods

sub pod_index { shift->{pi_pod_index} }

sub add_entry {
    my ($self, $keyword) = @_;

    my ($filename, $line, $breadcrumbs) = @{$self->{pi_pos}};

    my $podname = $self->path2package($filename);

    my $context = $breadcrumbs->[-1];
    $context = '' unless defined $context;
    $context =~ s/\n.*//s;

    my $entry = Pod::Index::Entry->new(
        keyword  => $keyword,
        filename => $filename,
        podname  => $podname,
        line     => $line,
        context  => $context,
    );

    push @{$self->{pi_pod_index}{lc $keyword}}, $entry;
}

sub path2package {
    my ($self, $pathname) = @_;

    my $relname = File::Spec->abs2rel($pathname, $self->{pi_base});

    my ($volume, $dirstring, $file) = File::Spec->splitpath($relname);
    my @dirs = File::Spec->splitdir($dirstring);

    pop @dirs if ($dirs[-1] eq ''); # in case there was a trailing slash
    $file =~ s/\.\w+$//;

    my $package = join('::',@dirs,$file);
    return $package;
}

sub print_index {
    my ($self, $f) = @_;

    # figure out filehandle
    my $fh;
    if ($f and !ref $f) {
        open $fh, ">", $f or die "couldn't open $f: $!\n";
    } elsif ($f) {
        $fh = $f;
    } else {
        $fh ||= *STDOUT;
    }

    # print out the index
    my $idx = $self->pod_index;
    for my $key (
        sort {
            $a cmp $b
            or $idx->{$a}{keyword} cmp $idx->{$b}{keyword}
        } keys %$idx
    ) {
        for my $entry (
            sort {
                $a->{podname} cmp $b->{podname}
                or $a->{line} <=> $b->{line}
            } @{$idx->{$key}}
        ) {
            print $fh join("\t", @$entry{qw(keyword podname line context)}), "\n";
        }
    }
}

1;

__END__