如何在 Perl POD 中仅打印特定格式名称?

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

我正在尝试提取 Perl POD 的一部分,除此之外别无其他。如果我 运行 以下内容:

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

然后我得到输出:

normalPod:
podTest
    normal pod

    all pod


allPod:
podTest
    normal pod

    all pod

special pod

specialPod:

我怎样才能得到 special pod 而没有别的?

我尝试过的事情:

是否有一种简单的方法可以从 POD 中仅获取特定格式,或者我应该自己解析文件?

Things I've tried: unaccepting directives

是的,似乎 Pod::Simple 不支持不接受标准指令。如果你尝试:

$writePod->unaccept_directives( 'head1' );

它死于错误消息:

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

您可以通过子类化 Pod::Text 覆盖其输出方法来解决该限制。例如:

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__);

仅输出:

special pod

如果您可以使用 CPAN 模块,下面介绍如何使用 Pod::POM 获取特殊 =begin 部分的内容。 findBegin 子例程遍历所有节点以查找以特殊格式开头的节点。它将根节点的子节点压入栈中,用 pop 从栈中移除最后一个节点,如果它是特殊的开始块,将该节点压入结果数组,然后将该节点的子节点压入栈,然后回到弹出节点。终于 return 出结果了。

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;
}

您可以扩展 findBegin,以便通过将 findBegin 的第一行更改为

来为每次调用使用不同的条件
my ($pom, $callback) = @_;

和 if 语句:

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

然后称它为:

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

将 return 语句中的条件替换为您要在 $node 上测试的任何条件。