1 #############################################################################
2 # Pod/Find.pm -- finds files containing POD documentation
4 # Author: Marek Rouchal <marekr@cpan.org>
6 # Copyright (C) 1999-2000 by Marek Rouchal (and borrowing code
7 # from Nick Ing-Simmon's PodToHtml). All rights reserved.
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
11 #############################################################################
15 use vars qw($VERSION);
16 $VERSION = 0.24_01; ## Current version of this package
17 require 5.005; ## requires this Perl version or later
20 #############################################################################
24 Pod::Find - find POD documents in directory trees
28 use Pod::Find qw(pod_find simplify_name);
29 my %pods = pod_find({ -verbose => 1, -inc => 1 });
31 print "found library POD `$pods{$_}' in $_\n";
34 print "podname=",simplify_name('a/b/c/mymodule.pod'),"\n";
36 $location = pod_where( { -inc => 1 }, "Pod::Find" );
40 B<Pod::Find> provides a set of functions to locate POD files. Note that
41 no function is exported by default to avoid pollution of your namespace,
42 so be sure to specify them in the B<use> statement if you need them:
44 use Pod::Find qw(pod_find);
55 use vars qw(@ISA @EXPORT_OK $VERSION);
57 @EXPORT_OK = qw(&pod_find &simplify_name &pod_where &contains_pod);
59 # package global variables
62 =head2 C<pod_find( { %opts } , @directories )>
64 The function B<pod_find> searches for POD documents in a given set of
65 files and/or directories. It returns a hash with the file names as keys
66 and the POD name as value. The POD name is derived from the file name
67 and its position in the directory tree.
69 E.g. when searching in F<$HOME/perl5lib>, the file
70 F<$HOME/perl5lib/MyModule.pm> would get the POD name I<MyModule>,
71 whereas F<$HOME/perl5lib/Myclass/Subclass.pm> would be
72 I<Myclass::Subclass>. The name information can be used for POD
75 Only text files containing at least one valid POD command are found.
77 A warning is printed if more than one POD file with the same POD name
78 is found, e.g. F<CPAN.pm> in different directories. This usually
79 indicates duplicate occurrences of modules in the I<@INC> search path.
81 B<OPTIONS> The first argument for B<pod_find> may be a hash reference
82 with options. The rest are either directories that are searched
83 recursively or files. The POD names of files are the plain basenames
84 with any Perl-like extension (.pm, .pl, .pod) stripped.
88 =item C<-verbose =E<gt> 1>
90 Print progress information while scanning.
92 =item C<-perl =E<gt> 1>
94 Apply Perl-specific heuristics to find the correct PODs. This includes
95 stripping Perl-like extensions, omitting subdirectories that are numeric
96 but do I<not> match the current Perl interpreter's version id, suppressing
97 F<site_perl> as a module hierarchy name etc.
99 =item C<-script =E<gt> 1>
101 Search for PODs in the current Perl interpreter's installation
102 B<scriptdir>. This is taken from the local L<Config|Config> module.
104 =item C<-inc =E<gt> 1>
106 Search for PODs in the current Perl interpreter's I<@INC> paths. This
107 automatically considers paths specified in the C<PERL5LIB> environment
108 as this is prepended to I<@INC> by the Perl interpreter itself.
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
124 $opts{-verbose} ||= 0;
131 push(@search, $Config::Config{scriptdir})
132 if -d $Config::Config{scriptdir};
137 if ($^O eq 'MacOS') {
138 # tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS
143 } elsif ( $_ =~ s|^((?:\.\./)+)|':' x (length($1)/3)|e ) {
149 push(@search, grep($_ ne File::Spec->curdir, @new_INC));
151 push(@search, grep($_ ne File::Spec->curdir, @INC));
159 # this code simplifies the POD name for Perl modules:
160 # * remove "site_perl"
161 # * remove e.g. "i586-linux" (from 'archname')
162 # * remove e.g. 5.00503
163 # * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod)
166 # * remove ":?site_perl:"
167 # * remove :?pod: if followed by *.pod (e.g. in :pod:perlfunc.pod)
169 if ($^O eq 'MacOS') {
171 qq!^(?i:\:?site_perl\:|\:?pod\:(?=.*?\\.pod\\z))*!;
174 qq!^(?i:site(_perl)?/|\Q$Config::Config{archname}\E/|\\d+\\.\\d+([_.]?\\d+)?/|pod/(?=.*?\\.pod\\z))*!;
183 foreach my $try (@search) {
184 unless(File::Spec->file_name_is_absolute($try)) {
186 $try = File::Spec->catfile($pwd,$try);
189 # on VMS canonpath will vmsify:[the.path], but File::Find::find
191 $try = File::Spec->canonpath($try) if ($^O ne 'VMS');
192 $try = VMS::Filespec::unixify($try) if ($^O eq 'VMS');
195 if($name = _check_and_extract_name($try, $opts{-verbose})) {
196 _check_for_duplicates($try, $name, \%names, \%pods);
200 my $root_rx = $^O eq 'MacOS' ? qq!^\Q$try\E! : qq!^\Q$try\E/!;
201 File::Find::find( sub {
202 my $item = $File::Find::name;
204 if($item =~ m{/(?:RCS|CVS|SCCS|\.svn)$}) {
205 $File::Find::prune = 1;
208 elsif($dirs_visited{$item}) {
209 warn "Directory '$item' already seen, skipping.\n"
211 $File::Find::prune = 1;
215 $dirs_visited{$item} = 1;
217 if($opts{-perl} && /^(\d+\.[\d_]+)\z/s && eval "$1" != $]) {
218 $File::Find::prune = 1;
219 warn "Perl $] version mismatch on $_, skipping.\n"
224 if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) {
225 _check_for_duplicates($item, $name, \%names, \%pods);
227 }, $try); # end of File::Find::find
233 sub _check_for_duplicates {
234 my ($file, $name, $names_ref, $pods_ref) = @_;
235 if($$names_ref{$name}) {
236 warn "Duplicate POD found (shadowing?): $name ($file)\n";
237 warn " Already seen in ",
238 join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n";
241 $$names_ref{$name} = 1;
243 $$pods_ref{$file} = $name;
246 sub _check_and_extract_name {
247 my ($file, $verbose, $root_rx) = @_;
249 # check extension or executable flag
250 # this involves testing the .bat extension on Win32!
251 unless(-f $file && -T _ && ($file =~ /\.(pod|pm|plx?)\z/i || -x _ )) {
255 return undef unless contains_pod($file,$verbose);
257 # strip non-significant path components
258 # TODO what happens on e.g. Win32?
260 if(defined $root_rx) {
261 $name =~ s!$root_rx!!s;
262 $name =~ s!$SIMPLIFY_RX!!os if(defined $SIMPLIFY_RX);
265 if ($^O eq 'MacOS') {
272 $name =~ s!/+!::!g; #/
273 if ($^O eq 'MacOS') {
274 $name =~ s!:+!::!g; # : -> ::
276 $name =~ s!/+!::!g; # / -> ::
281 =head2 C<simplify_name( $str )>
283 The function B<simplify_name> is equivalent to B<basename>, but also
284 strips Perl-like extensions (.pm, .pl, .pod) and extensions like
285 F<.bat>, F<.cmd> on Win32 and OS/2, or F<.com> on VMS, respectively.
289 # basic simplification of the POD name:
290 # basename & strip extension
293 # remove all path components
294 if ($^O eq 'MacOS') {
305 # strip Perl's own extensions
306 $_[0] =~ s/\.(pod|pm|plx?)\z//i;
307 # strip meaningless extensions on Win32 and OS/2
308 $_[0] =~ s/\.(bat|exe|cmd)\z//i if($^O =~ /mswin|os2/i);
309 # strip meaningless extensions on VMS
310 $_[0] =~ s/\.(com)\z//i if($^O eq 'VMS');
313 # contribution from Tim Jenness <t.jenness@jach.hawaii.edu>
315 =head2 C<pod_where( { %opts }, $pod )>
317 Returns the location of a pod document given a search directory
318 and a module (e.g. C<File::Find>) or script (e.g. C<perldoc>) name.
324 =item C<-inc =E<gt> 1>
326 Search @INC for the pod and also the C<scriptdir> defined in the
327 L<Config|Config> module.
329 =item C<-dirs =E<gt> [ $dir1, $dir2, ... ]>
331 Reference to an array of search directories. These are searched in order
332 before looking in C<@INC> (if B<-inc>). Current directory is used if
335 =item C<-verbose =E<gt> 1>
337 List directories as they are searched
341 Returns the full path of the first occurrence to the file.
342 Package names (eg 'A::B') are automatically converted to directory
343 names in the selected directory. (eg on unix 'A::B' is converted to
344 'A/B'). Additionally, '.pm', '.pl' and '.pod' are appended to the
345 search automatically if required.
347 A subdirectory F<pod/> is also checked if it exists in any of the given
348 search directories. This ensures that e.g. L<perlfunc|perlfunc> is
351 It is assumed that if a module name is supplied, that that name
352 matches the file name. Pods are not opened to check for the 'NAME'
355 A check is made to make sure that the file that is found does
356 contain some pod documentation.
366 '-dirs' => [ File::Spec->curdir ],
369 # Check for an options hash as first argument
370 if (defined $_[0] && ref($_[0]) eq 'HASH') {
373 # Merge default options with supplied options
374 %options = (%options, %$opt);
378 carp 'Usage: pod_where({options}, $pod)' unless (scalar(@_));
383 # Split on :: and then join the name together using File::Spec
384 my @parts = split (/::/, $pod);
386 # Get full directory list
387 my @search_dirs = @{ $options{'-dirs'} };
389 if ($options{'-inc'}) {
394 if ($^O eq 'MacOS' && $options{'-inc'}) {
395 # tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS
400 } elsif ( $_ =~ s|^((?:\.\./)+)|':' x (length($1)/3)|e ) {
406 push (@search_dirs, @new_INC);
407 } elsif ($options{'-inc'}) {
408 push (@search_dirs, @INC);
411 # Add location of pod documentation for perl man pages (eg perlfunc)
412 # This is a pod directory in the private install tree
413 #my $perlpoddir = File::Spec->catdir($Config::Config{'installprivlib'},
415 #push (@search_dirs, $perlpoddir)
418 # Add location of binaries such as pod2text
419 push (@search_dirs, $Config::Config{'scriptdir'})
420 if -d $Config::Config{'scriptdir'};
423 warn "Search path is: ".join(' ', @search_dirs)."\n"
424 if $options{'-verbose'};
426 # Loop over directories
427 Dir: foreach my $dir ( @search_dirs ) {
429 # Don't bother if can't find the directory
431 warn "Looking in directory $dir\n"
432 if $options{'-verbose'};
434 # Now concatenate this directory with the pod we are searching for
435 my $fullname = File::Spec->catfile($dir, @parts);
436 warn "Filename is now $fullname\n"
437 if $options{'-verbose'};
439 # Loop over possible extensions
440 foreach my $ext ('', '.pod', '.pm', '.pl') {
441 my $fullext = $fullname . $ext;
443 contains_pod($fullext, $options{'-verbose'}) ) {
444 warn "FOUND: $fullext\n" if $options{'-verbose'};
449 warn "Directory $dir does not exist\n"
450 if $options{'-verbose'};
453 # for some strange reason the path on MacOS/darwin/cygwin is
455 # this could be the case also for other systems that
456 # have a case-tolerant file system, but File::Spec
457 # does not recognize 'darwin' yet. And cygwin also has "pods",
458 # but is not case tolerant. Oh well...
459 if((File::Spec->case_tolerant || $^O =~ /macos|darwin|cygwin/i)
460 && -d File::Spec->catdir($dir,'pods')) {
461 $dir = File::Spec->catdir($dir,'pods');
464 if(-d File::Spec->catdir($dir,'pod')) {
465 $dir = File::Spec->catdir($dir,'pod');
473 =head2 C<contains_pod( $file , $verbose )>
475 Returns true if the supplied filename (not POD module) contains some pod
483 $verbose = shift if @_;
485 # check for one line of POD
486 unless(open(POD,"<$file")) {
487 warn "Error: $file is unreadable: $!\n";
493 close(POD) || die "Error closing $file: $!\n";
494 unless($pod =~ /\n=(head\d|pod|over|item)\b/s) {
495 warn "No POD in $file, skipping.\n"
505 Please report bugs using L<http://rt.cpan.org>.
507 Marek Rouchal E<lt>marekr@cpan.orgE<gt>,
508 heavily borrowing code from Nick Ing-Simmons' PodToHtml.
510 Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt> provided
511 C<pod_where> and C<contains_pod>.
515 L<Pod::Parser>, L<Pod::Checker>, L<perldoc>