File Coverage

blib/lib/Pod/Abstract/Filter/overlay.pm
Criterion Covered Total %
statement 15 60 25.0
branch 0 12 0.0
condition n/a
subroutine 5 6 83.3
pod 1 1 100.0
total 21 79 26.5


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