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