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); |
66aff6dd |
16 | $VERSION = 0.11; ## Current version of this package |
17 | require 5.004; ## 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 |
52 | indicates duplicate occurences of modules in the I<@INC> search path. |
53 | |
54 | The function B<simplify_name> is equivalent to B<basename>, but also |
55 | strips Perl-like extensions (.pm, .pl, .pod). |
56 | |
57 | Note that neither B<pod_find> nor B<simplify_name> are exported by |
58 | default so be sure to specify them in the B<use> statement if you need them: |
59 | |
60 | use Pod::Find qw(pod_find simplify_name); |
61 | |
62 | =head1 OPTIONS |
63 | |
64 | The first argument for B<pod_find> may be a hash reference with options. |
65 | The rest are either directories that are searched recursively or files. |
66 | The POD names of files are the plain basenames with any Perl-like extension |
67 | (.pm, .pl, .pod) stripped. |
68 | |
69 | =over 4 |
70 | |
71 | =item B<-verbose> |
72 | |
73 | Print progress information while scanning. |
74 | |
75 | =item B<-perl> |
76 | |
77 | Apply Perl-specific heuristics to find the correct PODs. This includes |
78 | stripping Perl-like extensions, omitting subdirectories that are numeric |
79 | but do I<not> match the current Perl interpreter's version id, suppressing |
80 | F<site_perl> as a module hierarchy name etc. |
81 | |
82 | =item B<-script> |
83 | |
84 | Search for PODs in the current Perl interpreter's installation |
85 | B<scriptdir>. This is taken from the local L<Config|Config> module. |
86 | |
87 | =item B<-inc> |
88 | |
89 | Search for PODs in the current Perl interpreter's I<@INC> paths. |
90 | |
91 | =back |
92 | |
93 | =head1 AUTHOR |
94 | |
95 | Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>, |
96 | heavily borrowing code from Nick Ing-Simmons' PodToHtml. |
97 | |
98 | =head1 SEE ALSO |
99 | |
100 | L<Pod::Parser>, L<Pod::Checker> |
101 | |
102 | =cut |
103 | |
104 | use strict; |
105 | #use diagnostics; |
106 | use Exporter; |
107 | use File::Find; |
108 | use Cwd; |
109 | |
110 | use vars qw(@ISA @EXPORT_OK $VERSION); |
111 | @ISA = qw(Exporter); |
112 | @EXPORT_OK = qw(&pod_find &simplify_name); |
113 | |
114 | # package global variables |
115 | my $SIMPLIFY_RX; |
116 | |
66aff6dd |
117 | # return a hash of the POD files found |
118 | # first argument may be a hashref (options), |
119 | # rest is a list of directories to search recursively |
e2c3adef |
120 | sub pod_find |
121 | { |
122 | my %opts; |
123 | if(ref $_[0]) { |
124 | %opts = %{shift()}; |
125 | } |
126 | |
127 | $opts{-verbose} ||= 0; |
128 | $opts{-perl} ||= 0; |
129 | |
130 | my (@search) = @_; |
131 | |
132 | if($opts{-script}) { |
133 | require Config; |
134 | push(@search, $Config::Config{scriptdir}); |
135 | $opts{-perl} = 1; |
136 | } |
137 | |
138 | if($opts{-inc}) { |
139 | push(@search, grep($_ ne '.',@INC)); |
140 | $opts{-perl} = 1; |
141 | } |
142 | |
143 | if($opts{-perl}) { |
144 | require Config; |
145 | # this code simplifies the POD name for Perl modules: |
146 | # * remove "site_perl" |
147 | # * remove e.g. "i586-linux" |
148 | # * remove e.g. 5.00503 |
149 | # * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod) |
150 | $SIMPLIFY_RX = |
fe6f1558 |
151 | qq!^(?i:site_perl/|\Q$Config::Config{archname}\E/|\\d+\\.\\d+([_.]?\\d+)?/|pod/(?=.*?\\.pod\\z))*!; |
66aff6dd |
152 | |
e2c3adef |
153 | } |
154 | |
155 | my %dirs_visited; |
156 | my %pods; |
157 | my %names; |
158 | my $pwd = cwd(); |
159 | |
160 | foreach my $try (@search) { |
fe6f1558 |
161 | unless($try =~ m:^/:s) { |
e2c3adef |
162 | # make path absolute |
163 | $try = join('/',$pwd,$try); |
164 | } |
fe6f1558 |
165 | $try =~ s:/\.?(?=/|\z)::; # simplify path |
e2c3adef |
166 | my $name; |
167 | if(-f $try) { |
168 | if($name = _check_and_extract_name($try, $opts{-verbose})) { |
169 | _check_for_duplicates($try, $name, \%names, \%pods); |
170 | } |
171 | next; |
172 | } |
66aff6dd |
173 | my $root_rx = qq!^\Q$try\E/!; |
e2c3adef |
174 | File::Find::find( sub { |
175 | my $item = $File::Find::name; |
176 | if(-d) { |
177 | if($dirs_visited{$item}) { |
178 | warn "Directory '$item' already seen, skipping.\n" |
179 | if($opts{-verbose}); |
180 | $File::Find::prune = 1; |
181 | return; |
182 | } |
183 | else { |
184 | $dirs_visited{$item} = 1; |
185 | } |
fe6f1558 |
186 | if($opts{-perl} && /^(\d+\.[\d_]+)\z/s && eval "$1" != $]) { |
e2c3adef |
187 | $File::Find::prune = 1; |
188 | warn "Perl $] version mismatch on $_, skipping.\n" |
189 | if($opts{-verbose}); |
190 | } |
191 | return; |
192 | } |
193 | if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) { |
194 | _check_for_duplicates($item, $name, \%names, \%pods); |
195 | } |
196 | }, $try); # end of File::Find::find |
197 | } |
198 | chdir $pwd; |
199 | %pods; |
200 | } |
201 | |
202 | sub _check_for_duplicates { |
203 | my ($file, $name, $names_ref, $pods_ref) = @_; |
204 | if($$names_ref{$name}) { |
205 | warn "Duplicate POD found (shadowing?): $name ($file)\n"; |
206 | warn " Already seen in ", |
207 | join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n"; |
208 | } |
209 | else { |
210 | $$names_ref{$name} = 1; |
211 | } |
212 | $$pods_ref{$file} = $name; |
213 | } |
214 | |
215 | sub _check_and_extract_name { |
216 | my ($file, $verbose, $root_rx) = @_; |
217 | |
218 | # check extension or executable |
fe6f1558 |
219 | unless($file =~ /\.(pod|pm|pl)\z/i || (-f $file && -x _ && -T _)) { |
e2c3adef |
220 | return undef; |
221 | } |
222 | |
223 | # check for one line of POD |
224 | unless(open(POD,"<$file")) { |
225 | warn "Error: $file is unreadable: $!\n"; |
226 | return undef; |
227 | } |
228 | local $/ = undef; |
229 | my $pod = <POD>; |
230 | close(POD); |
231 | unless($pod =~ /\n=(head\d|pod|over|item)\b/) { |
232 | warn "No POD in $file, skipping.\n" |
233 | if($verbose); |
234 | return; |
235 | } |
236 | undef $pod; |
237 | |
238 | # strip non-significant path components |
239 | # _TODO_ what happens on e.g. Win32? |
240 | my $name = $file; |
241 | if(defined $root_rx) { |
fe6f1558 |
242 | $name =~ s!$root_rx!!s; |
243 | $name =~ s!$SIMPLIFY_RX!!os if(defined $SIMPLIFY_RX); |
e2c3adef |
244 | } |
245 | else { |
fe6f1558 |
246 | $name =~ s:^.*/::s; |
e2c3adef |
247 | } |
fe6f1558 |
248 | $name =~ s/\.(pod|pm|pl)\z//i; |
e2c3adef |
249 | $name =~ s!/+!::!g; |
250 | $name; |
251 | } |
252 | |
253 | # basic simplification of the POD name: |
254 | # basename & strip extension |
255 | sub simplify_name { |
256 | my ($str) = @_; |
fe6f1558 |
257 | $str =~ s:^.*/::s; |
258 | $str =~ s:\.p([lm]|od)\z::i; |
e2c3adef |
259 | $str; |
260 | } |
261 | |
262 | 1; |
263 | |