This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
was Re: [PATCH: 6640] VMS Makefile.SH update (fwd)
[perl5.git] / lib / Pod / Find.pm
CommitLineData
e2c3adef
GS
1#############################################################################
2# Pod/Find.pm -- finds files containing POD documentation
3#
4# Author: Marek Rouchal <marek@saftsack.fs.uni-bayreuth.de>
5#
66aff6dd
GS
6# Copyright (C) 1999-2000 by Marek Rouchal (and borrowing code
7# from Nick Ing-Simmon's PodToHtml). All rights reserved.
e2c3adef
GS
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
13package Pod::Find;
14
15use vars qw($VERSION);
92e3d63a
JH
16$VERSION = 0.21; ## Current version of this package
17require 5.005; ## requires this Perl version or later
18use Carp;
e2c3adef
GS
19
20#############################################################################
21
22=head1 NAME
23
24Pod::Find - find POD documents in directory trees
25
26=head1 SYNOPSIS
27
28 use Pod::Find qw(pod_find simplify_name);
29 my %pods = pod_find({ -verbose => 1, -inc => 1 });
30 foreach(keys %pods) {
31 print "found library POD `$pods{$_}' in $_\n";
32 }
33
34 print "podname=",simplify_name('a/b/c/mymodule.pod'),"\n";
35
92e3d63a
JH
36 $location = pod_where( { -inc => 1 }, "Pod::Find" );
37
e2c3adef
GS
38=head1 DESCRIPTION
39
92e3d63a
JH
40B<Pod::Find> provides a set of functions to locate POD files. Note that
41no function is exported by default to avoid pollution of your namespace,
42so be sure to specify them in the B<use> statement if you need them:
43
44 use Pod::Find qw(pod_find);
45
46=cut
47
48use strict;
49#use diagnostics;
50use Exporter;
51use File::Spec;
52use File::Find;
53use Cwd;
54
55use vars qw(@ISA @EXPORT_OK $VERSION);
56@ISA = qw(Exporter);
57@EXPORT_OK = qw(&pod_find &simplify_name &pod_where &contains_pod);
58
59# package global variables
60my $SIMPLIFY_RX;
61
62=head2 C<pod_find( { %opts } , @directories )>
63
64The function B<pod_find> searches for POD documents in a given set of
65files and/or directories. It returns a hash with the file names as keys
66and the POD name as value. The POD name is derived from the file name
67and its position in the directory tree.
e2c3adef
GS
68
69E.g. when searching in F<$HOME/perl5lib>, the file
70F<$HOME/perl5lib/MyModule.pm> would get the POD name I<MyModule>,
71whereas F<$HOME/perl5lib/Myclass/Subclass.pm> would be
72I<Myclass::Subclass>. The name information can be used for POD
73translators.
74
75Only text files containing at least one valid POD command are found.
76
77A warning is printed if more than one POD file with the same POD name
78is found, e.g. F<CPAN.pm> in different directories. This usually
2773b013 79indicates duplicate occurrences of modules in the I<@INC> search path.
e2c3adef 80
92e3d63a
JH
81B<OPTIONS> The first argument for B<pod_find> may be a hash reference
82with options. The rest are either directories that are searched
83recursively or files. The POD names of files are the plain basenames
84with any Perl-like extension (.pm, .pl, .pod) stripped.
e2c3adef
GS
85
86=over 4
87
92e3d63a 88=item C<-verbose =E<gt> 1>
e2c3adef
GS
89
90Print progress information while scanning.
91
92e3d63a 92=item C<-perl =E<gt> 1>
e2c3adef
GS
93
94Apply Perl-specific heuristics to find the correct PODs. This includes
95stripping Perl-like extensions, omitting subdirectories that are numeric
96but do I<not> match the current Perl interpreter's version id, suppressing
97F<site_perl> as a module hierarchy name etc.
98
92e3d63a 99=item C<-script =E<gt> 1>
e2c3adef
GS
100
101Search for PODs in the current Perl interpreter's installation
102B<scriptdir>. This is taken from the local L<Config|Config> module.
103
92e3d63a 104=item C<-inc =E<gt> 1>
e2c3adef 105
2773b013 106Search for PODs in the current Perl interpreter's I<@INC> paths. This
92e3d63a
JH
107automatically considers paths specified in the C<PERL5LIB> environment
108as this is prepended to I<@INC> by the Perl interpreter itself.
e2c3adef
GS
109
110=back
111
e2c3adef
GS
112=cut
113
66aff6dd
GS
114# return a hash of the POD files found
115# first argument may be a hashref (options),
116# rest is a list of directories to search recursively
e2c3adef
GS
117sub 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"
2773b013 144 # * remove e.g. "i586-linux" (from 'archname')
e2c3adef
GS
145 # * remove e.g. 5.00503
146 # * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod)
147 $SIMPLIFY_RX =
fe6f1558 148 qq!^(?i:site_perl/|\Q$Config::Config{archname}\E/|\\d+\\.\\d+([_.]?\\d+)?/|pod/(?=.*?\\.pod\\z))*!;
66aff6dd 149
e2c3adef
GS
150 }
151
152 my %dirs_visited;
153 my %pods;
154 my %names;
155 my $pwd = cwd();
156
157 foreach my $try (@search) {
2773b013
GS
158 unless(File::Spec->file_name_is_absolute($try)) {
159 # make path absolute
160 $try = File::Spec->catfile($pwd,$try);
161 }
162 # simplify path
16be52b8
PP
163 # on VMS canonpath will vmsify:[the.path], but File::Find::find
164 # wants /unixy/paths
165 $try = File::Spec->canonpath($try) if ($^O ne 'VMS');
e2c3adef
GS
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 }
2773b013 173 my $root_rx = qq!^\Q$try\E/!;
e2c3adef 174 File::Find::find( sub {
2773b013
GS
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 }
186 if($opts{-perl} && /^(\d+\.[\d_]+)\z/s && eval "$1" != $]) {
e2c3adef
GS
187 $File::Find::prune = 1;
188 warn "Perl $] version mismatch on $_, skipping.\n"
2773b013
GS
189 if($opts{-verbose});
190 }
191 return;
192 }
e2c3adef
GS
193 if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) {
194 _check_for_duplicates($item, $name, \%names, \%pods);
195 }
2773b013 196 }, $try); # end of File::Find::find
e2c3adef
GS
197 }
198 chdir $pwd;
199 %pods;
200}
201
202sub _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";
2773b013
GS
206 warn " Already seen in ",
207 join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n";
e2c3adef
GS
208 }
209 else {
210 $$names_ref{$name} = 1;
211 }
212 $$pods_ref{$file} = $name;
213}
214
215sub _check_and_extract_name {
216 my ($file, $verbose, $root_rx) = @_;
217
2773b013
GS
218 # check extension or executable flag
219 # this involves testing the .bat extension on Win32!
92e3d63a
JH
220 unless(-f $file && -T _ && ($file =~ /\.(pod|pm|plx?)\z/i || -x _ )) {
221 return undef;
e2c3adef
GS
222 }
223
92e3d63a 224 return undef unless contains_pod($file,$verbose);
e2c3adef
GS
225
226 # strip non-significant path components
92e3d63a 227 # TODO what happens on e.g. Win32?
e2c3adef
GS
228 my $name = $file;
229 if(defined $root_rx) {
fe6f1558
GS
230 $name =~ s!$root_rx!!s;
231 $name =~ s!$SIMPLIFY_RX!!os if(defined $SIMPLIFY_RX);
e2c3adef
GS
232 }
233 else {
fe6f1558 234 $name =~ s:^.*/::s;
e2c3adef 235 }
2773b013
GS
236 _simplify($name);
237 $name =~ s!/+!::!g; #/
e2c3adef
GS
238 $name;
239}
240
92e3d63a
JH
241=head2 C<simplify_name( $str )>
242
243The function B<simplify_name> is equivalent to B<basename>, but also
244strips Perl-like extensions (.pm, .pl, .pod) and extensions like
245F<.bat>, F<.cmd> on Win32 and OS/2, respectively.
246
247=cut
248
e2c3adef
GS
249# basic simplification of the POD name:
250# basename & strip extension
251sub simplify_name {
252 my ($str) = @_;
2773b013 253 # remove all path components
fe6f1558 254 $str =~ s:^.*/::s;
2773b013 255 _simplify($str);
e2c3adef
GS
256 $str;
257}
258
2773b013
GS
259# internal sub only
260sub _simplify {
261 # strip Perl's own extensions
262 $_[0] =~ s/\.(pod|pm|plx?)\z//i;
263 # strip meaningless extensions on Win32 and OS/2
264 $_[0] =~ s/\.(bat|exe|cmd)\z//i if($^O =~ /win|os2/i);
265}
266
92e3d63a
JH
267# contribution from Tim Jenness <t.jenness@jach.hawaii.edu>
268
269=head2 C<pod_where( { %opts }, $pod )>
270
271Returns the location of a pod document given a search directory
272and a module (e.g. C<File::Find>) or script (e.g. C<perldoc>) name.
273
274Options:
275
276=over 4
277
278=item C<-inc =E<gt> 1>
279
280Search @INC for the pod and also the C<scriptdir> defined in the
281L<Config|Config> module.
282
283=item C<-dirs =E<gt> [ $dir1, $dir2, ... ]>
284
285Reference to an array of search directories. These are searched in order
286before looking in C<@INC> (if B<-inc>). Current directory is used if
287none are specified.
288
289=item C<-verbose =E<gt> 1>
290
291List directories as they are searched
292
293=back
294
295Returns the full path of the first occurence to the file.
296Package names (eg 'A::B') are automatically converted to directory
297names in the selected directory. (eg on unix 'A::B' is converted to
298'A/B'). Additionally, '.pm', '.pl' and '.pod' are appended to the
299search automatically if required.
300
301A subdirectory F<pod/> is also checked if it exists in any of the given
302search directories. This ensures that e.g. L<perlfunc|perlfunc> is
303found.
304
305It is assumed that if a module name is supplied, that that name
306matches the file name. Pods are not opened to check for the 'NAME'
307entry.
308
309A check is made to make sure that the file that is found does
310contain some pod documentation.
311
312=cut
313
314sub pod_where {
315
316 # default options
317 my %options = (
318 '-inc' => 0,
319 '-verbose' => 0,
320 '-dirs' => [ '.' ],
321 );
322
323 # Check for an options hash as first argument
324 if (defined $_[0] && ref($_[0]) eq 'HASH') {
325 my $opt = shift;
326
327 # Merge default options with supplied options
328 %options = (%options, %$opt);
329 }
330
331 # Check usage
332 carp 'Usage: pod_where({options}, $pod)' unless (scalar(@_));
333
334 # Read argument
335 my $pod = shift;
336
337 # Split on :: and then join the name together using File::Spec
338 my @parts = split (/::/, $pod);
339
340 # Get full directory list
341 my @search_dirs = @{ $options{'-dirs'} };
342
343 if ($options{'-inc'}) {
344
345 require Config;
346
347 # Add @INC
348 push (@search_dirs, @INC) if $options{'-inc'};
349
350 # Add location of pod documentation for perl man pages (eg perlfunc)
351 # This is a pod directory in the private install tree
352 #my $perlpoddir = File::Spec->catdir($Config::Config{'installprivlib'},
353 # 'pod');
354 #push (@search_dirs, $perlpoddir)
355 # if -d $perlpoddir;
356
357 # Add location of binaries such as pod2text
358 push (@search_dirs, $Config::Config{'scriptdir'})
359 if -d $Config::Config{'scriptdir'};
360 }
361
362 # Loop over directories
363 Dir: foreach my $dir ( @search_dirs ) {
364
365 # Don't bother if cant find the directory
366 if (-d $dir) {
367 warn "Looking in directory $dir\n"
368 if $options{'-verbose'};
369
370 # Now concatenate this directory with the pod we are searching for
371 my $fullname = File::Spec->catfile($dir, @parts);
372 warn "Filename is now $fullname\n"
373 if $options{'-verbose'};
374
375 # Loop over possible extensions
376 foreach my $ext ('', '.pod', '.pm', '.pl') {
377 my $fullext = $fullname . $ext;
378 if (-f $fullext &&
379 contains_pod($fullext, $options{'-verbose'}) ) {
380 warn "FOUND: $fullext\n" if $options{'-verbose'};
381 return $fullext;
382 }
383 }
384 } else {
385 warn "Directory $dir does not exist\n"
386 if $options{'-verbose'};
387 next Dir;
388 }
389 if(-d File::Spec->catdir($dir,'pod')) {
390 $dir = File::Spec->catdir($dir,'pod');
391 redo Dir;
392 }
393 }
394 # No match;
395 return undef;
396}
397
398=head2 C<contains_pod( $file , $verbose )>
399
400Returns true if the supplied filename (not POD module) contains some pod
401information.
402
403=cut
404
405sub contains_pod {
406 my $file = shift;
407 my $verbose = 0;
408 $verbose = shift if @_;
409
410 # check for one line of POD
411 unless(open(POD,"<$file")) {
412 warn "Error: $file is unreadable: $!\n";
413 return undef;
414 }
415
416 local $/ = undef;
417 my $pod = <POD>;
418 close(POD) || die "Error closing $file: $!\n";
419 unless($pod =~ /\n=(head\d|pod|over|item)\b/s) {
420 warn "No POD in $file, skipping.\n"
421 if($verbose);
422 return 0;
423 }
424
425 return 1;
426}
427
428=head1 AUTHOR
429
430Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>,
431heavily borrowing code from Nick Ing-Simmons' PodToHtml.
432
433Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt> provided
434C<pod_where> and C<contains_pod>.
435
436=head1 SEE ALSO
437
438L<Pod::Parser>, L<Pod::Checker>, L<perldoc>
439
440=cut
441
e2c3adef
GS
4421;
443