Commit | Line | Data |
e2c3adef |
1 | ############################################################################# |
2 | # Pod/Find.pm -- finds files containing POD documentation |
3 | # |
4 | # Author: Marek Rouchal <marek@saftsack.fs.uni-bayreuth.de> |
5 | # |
6 | # borrowing code from Nick Ing-Simmon's PodToHtml |
7 | # This file is part of "PodParser". Pod::Find is free software; |
8 | # you can redistribute it and/or modify it under the same terms |
9 | # as Perl itself. |
10 | ############################################################################# |
11 | |
12 | package Pod::Find; |
13 | |
14 | use vars qw($VERSION); |
15 | $VERSION = 0.10; ## Current version of this package |
16 | require 5.005; ## requires this Perl version or later |
17 | |
18 | ############################################################################# |
19 | |
20 | =head1 NAME |
21 | |
22 | Pod::Find - find POD documents in directory trees |
23 | |
24 | =head1 SYNOPSIS |
25 | |
26 | use Pod::Find qw(pod_find simplify_name); |
27 | my %pods = pod_find({ -verbose => 1, -inc => 1 }); |
28 | foreach(keys %pods) { |
29 | print "found library POD `$pods{$_}' in $_\n"; |
30 | } |
31 | |
32 | print "podname=",simplify_name('a/b/c/mymodule.pod'),"\n"; |
33 | |
34 | =head1 DESCRIPTION |
35 | |
36 | B<Pod::Find> provides a function B<pod_find> that searches for POD |
37 | documents in a given set of files and directories. It returns a hash |
38 | with the file names as keys and the POD name as value. The POD name |
39 | is derived from the file name and its position in the directory tree. |
40 | |
41 | E.g. when searching in F<$HOME/perl5lib>, the file |
42 | F<$HOME/perl5lib/MyModule.pm> would get the POD name I<MyModule>, |
43 | whereas F<$HOME/perl5lib/Myclass/Subclass.pm> would be |
44 | I<Myclass::Subclass>. The name information can be used for POD |
45 | translators. |
46 | |
47 | Only text files containing at least one valid POD command are found. |
48 | |
49 | A warning is printed if more than one POD file with the same POD name |
50 | is found, e.g. F<CPAN.pm> in different directories. This usually |
51 | indicates duplicate occurences of modules in the I<@INC> search path. |
52 | |
53 | The function B<simplify_name> is equivalent to B<basename>, but also |
54 | strips Perl-like extensions (.pm, .pl, .pod). |
55 | |
56 | Note that neither B<pod_find> nor B<simplify_name> are exported by |
57 | default so be sure to specify them in the B<use> statement if you need them: |
58 | |
59 | use Pod::Find qw(pod_find simplify_name); |
60 | |
61 | =head1 OPTIONS |
62 | |
63 | The first argument for B<pod_find> may be a hash reference with options. |
64 | The rest are either directories that are searched recursively or files. |
65 | The POD names of files are the plain basenames with any Perl-like extension |
66 | (.pm, .pl, .pod) stripped. |
67 | |
68 | =over 4 |
69 | |
70 | =item B<-verbose> |
71 | |
72 | Print progress information while scanning. |
73 | |
74 | =item B<-perl> |
75 | |
76 | Apply Perl-specific heuristics to find the correct PODs. This includes |
77 | stripping Perl-like extensions, omitting subdirectories that are numeric |
78 | but do I<not> match the current Perl interpreter's version id, suppressing |
79 | F<site_perl> as a module hierarchy name etc. |
80 | |
81 | =item B<-script> |
82 | |
83 | Search for PODs in the current Perl interpreter's installation |
84 | B<scriptdir>. This is taken from the local L<Config|Config> module. |
85 | |
86 | =item B<-inc> |
87 | |
88 | Search for PODs in the current Perl interpreter's I<@INC> paths. |
89 | |
90 | =back |
91 | |
92 | =head1 AUTHOR |
93 | |
94 | Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>, |
95 | heavily borrowing code from Nick Ing-Simmons' PodToHtml. |
96 | |
97 | =head1 SEE ALSO |
98 | |
99 | L<Pod::Parser>, L<Pod::Checker> |
100 | |
101 | =cut |
102 | |
103 | use strict; |
104 | #use diagnostics; |
105 | use Exporter; |
106 | use File::Find; |
107 | use Cwd; |
108 | |
109 | use vars qw(@ISA @EXPORT_OK $VERSION); |
110 | @ISA = qw(Exporter); |
111 | @EXPORT_OK = qw(&pod_find &simplify_name); |
112 | |
113 | # package global variables |
114 | my $SIMPLIFY_RX; |
115 | |
116 | # return a hash of the |
117 | sub pod_find |
118 | { |
119 | my %opts; |
120 | if(ref $_[0]) { |
121 | %opts = %{shift()}; |
122 | } |
123 | |
124 | $opts{-verbose} ||= 0; |
125 | $opts{-perl} ||= 0; |
126 | |
127 | my (@search) = @_; |
128 | |
129 | if($opts{-script}) { |
130 | require Config; |
131 | push(@search, $Config::Config{scriptdir}); |
132 | $opts{-perl} = 1; |
133 | } |
134 | |
135 | if($opts{-inc}) { |
136 | push(@search, grep($_ ne '.',@INC)); |
137 | $opts{-perl} = 1; |
138 | } |
139 | |
140 | if($opts{-perl}) { |
141 | require Config; |
142 | # this code simplifies the POD name for Perl modules: |
143 | # * remove "site_perl" |
144 | # * remove e.g. "i586-linux" |
145 | # * remove e.g. 5.00503 |
146 | # * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod) |
147 | $SIMPLIFY_RX = |
148 | qr!^(?i:site_perl/|$Config::Config{archname}/|\d+\.\d+([_.]?\d+)?/|pod/(?=.*?\.pod$))*!o; |
149 | } |
150 | |
151 | my %dirs_visited; |
152 | my %pods; |
153 | my %names; |
154 | my $pwd = cwd(); |
155 | |
156 | foreach my $try (@search) { |
157 | unless($try =~ m:^/:) { |
158 | # make path absolute |
159 | $try = join('/',$pwd,$try); |
160 | } |
161 | $try =~ s:/\.?(?=/|$)::; # simplify path |
162 | my $name; |
163 | if(-f $try) { |
164 | if($name = _check_and_extract_name($try, $opts{-verbose})) { |
165 | _check_for_duplicates($try, $name, \%names, \%pods); |
166 | } |
167 | next; |
168 | } |
169 | my $root_rx = qr!^\Q$try\E/!; |
170 | File::Find::find( sub { |
171 | my $item = $File::Find::name; |
172 | if(-d) { |
173 | if($dirs_visited{$item}) { |
174 | warn "Directory '$item' already seen, skipping.\n" |
175 | if($opts{-verbose}); |
176 | $File::Find::prune = 1; |
177 | return; |
178 | } |
179 | else { |
180 | $dirs_visited{$item} = 1; |
181 | } |
182 | if($opts{-perl} && /^(\d+\.[\d_]+)$/ && eval "$1" != $]) { |
183 | $File::Find::prune = 1; |
184 | warn "Perl $] version mismatch on $_, skipping.\n" |
185 | if($opts{-verbose}); |
186 | } |
187 | return; |
188 | } |
189 | if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) { |
190 | _check_for_duplicates($item, $name, \%names, \%pods); |
191 | } |
192 | }, $try); # end of File::Find::find |
193 | } |
194 | chdir $pwd; |
195 | %pods; |
196 | } |
197 | |
198 | sub _check_for_duplicates { |
199 | my ($file, $name, $names_ref, $pods_ref) = @_; |
200 | if($$names_ref{$name}) { |
201 | warn "Duplicate POD found (shadowing?): $name ($file)\n"; |
202 | warn " Already seen in ", |
203 | join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n"; |
204 | } |
205 | else { |
206 | $$names_ref{$name} = 1; |
207 | } |
208 | $$pods_ref{$file} = $name; |
209 | } |
210 | |
211 | sub _check_and_extract_name { |
212 | my ($file, $verbose, $root_rx) = @_; |
213 | |
214 | # check extension or executable |
215 | unless($file =~ /\.(pod|pm|pl)$/i || (-f $file && -x _ && -T _)) { |
216 | return undef; |
217 | } |
218 | |
219 | # check for one line of POD |
220 | unless(open(POD,"<$file")) { |
221 | warn "Error: $file is unreadable: $!\n"; |
222 | return undef; |
223 | } |
224 | local $/ = undef; |
225 | my $pod = <POD>; |
226 | close(POD); |
227 | unless($pod =~ /\n=(head\d|pod|over|item)\b/) { |
228 | warn "No POD in $file, skipping.\n" |
229 | if($verbose); |
230 | return; |
231 | } |
232 | undef $pod; |
233 | |
234 | # strip non-significant path components |
235 | # _TODO_ what happens on e.g. Win32? |
236 | my $name = $file; |
237 | if(defined $root_rx) { |
238 | $name =~ s!$root_rx!!; |
239 | $name =~ s!$SIMPLIFY_RX!!o if(defined $SIMPLIFY_RX); |
240 | } |
241 | else { |
242 | $name =~ s:^.*/::; |
243 | } |
244 | $name =~ s/\.(pod|pm|pl)$//i; |
245 | $name =~ s!/+!::!g; |
246 | $name; |
247 | } |
248 | |
249 | # basic simplification of the POD name: |
250 | # basename & strip extension |
251 | sub simplify_name { |
252 | my ($str) = @_; |
253 | $str =~ s:^.*/::; |
254 | $str =~ s:\.p([lm]|od)$::i; |
255 | $str; |
256 | } |
257 | |
258 | 1; |
259 | |