How can I print only a specific format name in a Perl POD?

Question

I'm trying to extract a portion of a Perl POD and nothing else. If I run the following:

use strict;
use warnings;
use Pod::Simple;
use Pod::Text;

=head1 podTest

normal pod

=cut

print "normalPod:\n";
my $writeNormalPod = Pod::Text->new();
$writeNormalPod->parse_from_file(__FILE__);

=pod

all pod

=cut

print "\nallPod:\n";
my $writePod = Pod::Text->new();
$writePod->accept_targets( ('special') );
$writePod->parse_from_file(__FILE__);

=begin special

special pod

=end special

=cut

print "\nspecialPod:\n";
my $writeSpecialPod = Pod::Text->new();
# what to have here?
$writeSpecialPod->parse_from_file(__FILE__);
# in order to print "special pod" and nothing else

Then I get the output:

normalPod:
podTest
    normal pod

    all pod


allPod:
podTest
    normal pod

    all pod

special pod

specialPod:

How can I get special pod and nothing else?

Things I've tried:

unaccepting codes, directives, and targets
attaching code (and cut, pod, and whiteline) handlers
Web searching (at best, this turns up how to use a format name)

Is there an easy way to get only a specific format out of a POD, or should I just parse the file on my own?

*"Things I've tried: unaccepting directives"* : Yes it seems difficult, I tried `$writePod->unaccept_directives( 'head1' );` but it dies with *"But you must accept "head1" directives -- it's a builtin!"* — Håkon Hægland, Mar 01 '22 at 06:22

score 3 · Accepted Answer · answered Mar 01 '22 at 06:42

Things I've tried: unaccepting directives

Yes seems Pod::Simple does not have support for unaccepting standard directives. If you try:

$writePod->unaccept_directives( 'head1' );

it dies with the error message:

But you must accept "head1" directives -- it's a builtin!

You might be able to work around the restriction by sub classing Pod::Text to override its output methods. For example:

p.pl:

BEGIN {
package My::Pod::Text;
use strict;
use warnings;
use parent qw(Pod::Text);
sub cmd_head1 {} #override this to not print head1
sub cmd_para {}  #override this to not print paragraphs

$INC{"My/Pod/Text.pm"} = 1;
}
package main;
use feature qw(say);
use strict;
use warnings;
use My::Pod::Text;

=head1 podTest

normal pod

=begin special

special pod

=end special

=cut

my $writePod = My::Pod::Text->new();
$writePod->accept_targets( ('special') );
$writePod->parse_from_file(__FILE__);

outputs only:

special pod

Subclassing Pod::Text did the trick, thanks. In my actual project, I found it useful to look through Pod::Text (located via `perldoc -l Pod::Text`) to identify other functions to override when text was still leaking through. — Teepeemm, Mar 01 '22 at 15:02

score 1 · Answer 2 · answered Mar 04 '22 at 03:51

If you can use CPAN modules, here's how to get the contents of the special =begin section with Pod::POM. The findBegin subroutine looks through all the nodes to find a begin with special format. It pushes the children of the root node onto the stack, removes the last node from the stack with pop, pushes that node onto the results array if it is special begin block, and then pushes the children of that node onto the stack, then back to popping nodes. Finally it returns the results.

print "Pod::POM results\n";
my $parser = Pod::POM->new();
print "\$parser is $parser\n";

my $pom = $parser->parse_file(__FILE__);

#print "\$pom is \"$pom\"\n";
my (@special) = findBegin($pom);

for my $special (@special) {
    print $special->text();
}

sub findBegin {
    my ($pom) = @_;
    my @nodes = $pom->content();
    my @results;
    while (@nodes) {
        my $node = pop @nodes;
        if ($node->type() eq 'begin' && $node->format() eq 'special') {
            #print "Returning $node\n";
            push @results, $node;
        }
        my @children = $node->content();
        push @nodes, @children if scalar @children;
    }
    return @results;
}

You can extend findBegin so that you can use different conditions for each call to it by changing the first line of findBegin to

my ($pom, $callback) = @_;

and the if statement to:

if ($callback->($node)) {

and then calling it as:

my (@special) = findBegin($pom, sub {
    my ($node) = @_;
    return $node->type() eq 'begin' && $node->format() eq 'special';
});

Replace the condition in the return statement with whatever condition you want to test on $node.

How can I print only a specific format name in a Perl POD?

2 Answers2