1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
package Pod::Abstract::Filter::overlay;
use strict;
use warnings;
use base qw(Pod::Abstract::Filter);
use Pod::Abstract;
use Pod::Abstract::BuildNode qw(node);
our $VERSION = '0.20';
=head1 NAME
Pod::Abstract::Filter::overlay - paf command to perform a method
documentation overlay on a Pod document.
=begin :overlay
=overlay METHODS Pod::Abstract::Filter
=end :overlay
=head1 METHODS
=head2 filter
Inspects the source document for a begin/end block named
":overlay". The overlay block will be inspected for "=overlay"
commands, which should be structured like:
=begin :overlay
=overlay METHODS Some::Class::Or::File
=end :overlay
Each overlay is processed in order. It will add any headings for the
matched sections in the current document from the named source, for
any heading that is not already present in the given section.
If that doesn't make sense just try it and it will!
The main utility of this is to specify a superclass, so that all the
methods that are not documented in your subclass become documented by
the overlay. The C<sort> filter makes a good follow up.
The start of overlaid sections will include:
=for overlay from <class-or-file>
You can use these markers to set sections to be replaced by some other
document, or to repeat an overlay on an already processed Pod
file. Changes to existing marked sections are made in-place without
changing document order.
=cut
sub filter {
my $self = shift;
my $pa = shift;
my ($overlay_list) = $pa->select("//begin[. =~ {^:overlay}](0)");
unless($overlay_list) {
die "No overlay defined in document\n";
}
my @overlays = $overlay_list->select("/overlay");
foreach my $overlay (@overlays) {
my $o_def = $overlay->body;
my ($section, $module) = split " ", $o_def;
# This should be factored into a method.
my $ovr_module = $module; # Keep original value
unless(-r $module) {
# Maybe a module name?
$module =~ s/::/\//g;
$module .= '.pm' unless $module =~ m/.pm$/;
foreach my $path (@INC) {
if(-r "$path/$module") {
$module = "$path/$module";
last;
}
}
}
my $ovr_doc = Pod::Abstract->load_file($module);
my ($t) = $pa->select("//[\@heading =~ {$section}](0)");
my ($o) = $ovr_doc->select("//[\@heading =~ {$section}](0)");
my @t_headings = $t->select("/[\@heading]");
my @o_headings = $o->select("/[\@heading]");
my %t_heading = map {
$_->param('heading')->pod => $_
} @t_headings;
foreach my $hdg (@o_headings) {
my $hdg_text = $hdg->param('heading')->pod;
if($t_heading{$hdg_text}) {
my @overlay_from =
$t_heading{$hdg_text}->select(
"/for[. =~ {^overlay from }]");
my @from_current = grep {
substr($_->body, -(length $ovr_module)) eq $ovr_module
} @overlay_from;
if(@from_current) {
my $dup = $hdg->duplicate;
my @overlay_from =
$hdg->select("/for[. =~ {^overlay from }]");
$_->detach foreach @overlay_from;
$dup->unshift(node->for("overlay from $ovr_module"));
$dup->insert_after($t_heading{$hdg_text});
$t_heading{$hdg_text}->detach;
$t_heading{$hdg_text} = $dup;
}
} else {
my $dup = $hdg->duplicate;
# Remove existing overlay markers;
my @overlay_from =
$hdg->select("/for[. =~ {^overlay from }]");
$_->detach foreach @overlay_from;
$dup->unshift(node->for("overlay from $ovr_module"));
$t->push($dup);
$t_heading{$hdg_text} = $dup;
}
}
}
return $pa;
}
=head1 AUTHOR
Ben Lilburne <bnej@mac.com>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2009 Ben Lilburne
This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
1;
|
