1package Pod::Abstract::Filter::find;
2use strict;
3use warnings;
4
5use base qw(Pod::Abstract::Filter);
6use Pod::Abstract::BuildNode qw(node);
7
8our $VERSION = '0.20';
9
10=head1 NAME
11
12Pod::Abstract::Filter::find - paf command to find specific nodes that
13contain a string.
14
15=head1 DESCRIPTION
16
17The intention of this filter is to allow a reduction of large Pod
18documents to find a specific function or method. You call C<paf find
19-f=function YourModule>, and you get a small subset of nodes matching
20"function".
21
22For this to work, there has to be some assumptions about Pod structure. I
23am presuming that find is not useful if it returns anything higher than a
24head2, so as long as your module wraps function doco in a head2, head3,
25head4 or list item, we're fine. If you use head1 then it won't be useful.
26
27In order to be useful as an end user tool, head1 nodes (...) are added
28between the found nodes. This stops perldoc from dying with no
29documentation. These can be easily stripped using:
30C<< $pa->select('/head1') >>, then hoist and detach, or reparent to other
31Node types.
32
33A good example of this working as intended is:
34
35 paf find select Pod::Abstract::Node
36
37=cut
38
39sub require_params {
40    return ( 'f' );
41}
42
43sub filter {
44    my $self = shift;
45    my $pa = shift;
46
47    my $find_string = $self->param('f');
48    unless($find_string && $find_string =~ m/^[a-zA-Z0-9_]+$/) {
49        die "find: string must be specified with -f=str.\nMust be a simple string.\n";
50    }
51
52    my $out_doc = node->root;
53    $out_doc->nest(node->pod);
54
55    # Don't select parent nodes, leaf nodes only
56    my @targets = $pa->select("//[. =~ {$find_string}][!/]");
57
58    # Don't accept anything less specific than a head2
59    my @dest_ok = qw(head2 head3 head4 item);
60
61    my %finals = ( );
62
63    foreach my $t (@targets) {
64        while($t->parent && !( grep { $t->type eq $_ } @dest_ok )) {
65            $t = $t->parent;
66        }
67        if(grep { $t->type eq $_ } @dest_ok) {
68            unless($finals{$t->serial}) {
69                my $head = node->head1('...');
70                if($t->type eq 'item') {
71                    my $over = node->over;
72                    $over->nest($t->duplicate);
73                    $head->nest($over);
74                } else {
75                    $head->nest($t->duplicate);
76                }
77                $out_doc->push($head);
78                $finals{$t->serial} = 1;
79            }
80        }
81    }
82
83    return $out_doc;
84}
85
86=head1 AUTHOR
87
88Ben Lilburne <bnej@mac.com>
89
90=head1 COPYRIGHT AND LICENSE
91
92Copyright (C) 2009 Ben Lilburne
93
94This program is free software; you can redistribute it and/or modify
95it under the same terms as Perl itself.
96
97=cut
98
991;
100