1 #############################################################################
2 # Pod/Find.pm -- finds files containing POD documentation
4 # Author: Marek Rouchal <marek@saftsack.fs.uni-bayreuth.de>
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.22; ## 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($dirs_visited{$item}) {
205 warn "Directory '$item' already seen, skipping.\n"
207 $File::Find::prune = 1;
211 $dirs_visited{$item} = 1;
213 if($opts{-perl} && /^(\d+\.[\d_]+)\z/s && eval "$1" != $]) {
214 $File::Find::prune = 1;
215 warn "Perl $] version mismatch on $_, skipping.\n"
220 if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) {
221 _check_for_duplicates($item, $name, \%names, \%pods);
223 }, $try); # end of File::Find::find
229 sub _check_for_duplicates {
230 my ($file, $name, $names_ref, $pods_ref) = @_;
231 if($$names_ref{$name}) {
232 warn "Duplicate POD found (shadowing?): $name ($file)\n";
233 warn " Already seen in ",
234 join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n";
237 $$names_ref{$name} = 1;
239 $$pods_ref{$file} = $name;
242 sub _check_and_extract_name {
243 my ($file, $verbose, $root_rx) = @_;
245 # check extension or executable flag
246 # this involves testing the .bat extension on Win32!
247 unless(-f $file && -T _ && ($file =~ /\.(pod|pm|plx?)\z/i || -x _ )) {
251 return undef unless contains_pod($file,$verbose);
253 # strip non-significant path components
254 # TODO what happens on e.g. Win32?
256 if(defined $root_rx) {
257 $name =~ s!$root_rx!!s;
258 $name =~ s!$SIMPLIFY_RX!!os if(defined $SIMPLIFY_RX);
261 if ($^O eq 'MacOS') {
268 $name =~ s!/+!::!g; #/
269 if ($^O eq 'MacOS') {
270 $name =~ s!:+!::!g; # : -> ::
272 $name =~ s!/+!::!g; # / -> ::
277 =head2 C<simplify_name( $str )>
279 The function B<simplify_name> is equivalent to B<basename>, but also
280 strips Perl-like extensions (.pm, .pl, .pod) and extensions like
281 F<.bat>, F<.cmd> on Win32 and OS/2, or F<.com> on VMS, respectively.
285 # basic simplification of the POD name:
286 # basename & strip extension
289 # remove all path components
290 if ($^O eq 'MacOS') {
301 # strip Perl's own extensions
302 $_[0] =~ s/\.(pod|pm|plx?)\z//i;
303 # strip meaningless extensions on Win32 and OS/2
304 $_[0] =~ s/\.(bat|exe|cmd)\z//i if($^O =~ /mswin|os2/i);
305 # strip meaningless extensions on VMS
306 $_[0] =~ s/\.(com)\z//i if($^O eq 'VMS');
309 # contribution from Tim Jenness <t.jenness@jach.hawaii.edu>
311 =head2 C<pod_where( { %opts }, $pod )>
313 Returns the location of a pod document given a search directory
314 and a module (e.g. C<File::Find>) or script (e.g. C<perldoc>) name.
320 =item C<-inc =E<gt> 1>
322 Search @INC for the pod and also the C<scriptdir> defined in the
323 L<Config|Config> module.
325 =item C<-dirs =E<gt> [ $dir1, $dir2, ... ]>
327 Reference to an array of search directories. These are searched in order
328 before looking in C<@INC> (if B<-inc>). Current directory is used if
331 =item C<-verbose =E<gt> 1>
333 List directories as they are searched
337 Returns the full path of the first occurence to the file.
338 Package names (eg 'A::B') are automatically converted to directory
339 names in the selected directory. (eg on unix 'A::B' is converted to
340 'A/B'). Additionally, '.pm', '.pl' and '.pod' are appended to the
341 search automatically if required.
343 A subdirectory F<pod/> is also checked if it exists in any of the given
344 search directories. This ensures that e.g. L<perlfunc|perlfunc> is
347 It is assumed that if a module name is supplied, that that name
348 matches the file name. Pods are not opened to check for the 'NAME'
351 A check is made to make sure that the file that is found does
352 contain some pod documentation.
362 '-dirs' => [ File::Spec->curdir ],
365 # Check for an options hash as first argument
366 if (defined $_[0] && ref($_[0]) eq 'HASH') {
369 # Merge default options with supplied options
370 %options = (%options, %$opt);
374 carp 'Usage: pod_where({options}, $pod)' unless (scalar(@_));
379 # Split on :: and then join the name together using File::Spec
380 my @parts = split (/::/, $pod);
382 # Get full directory list
383 my @search_dirs = @{ $options{'-dirs'} };
385 if ($options{'-inc'}) {
390 if ($^O eq 'MacOS' && $options{'-inc'}) {
391 # tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS
396 } elsif ( $_ =~ s|^((?:\.\./)+)|':' x (length($1)/3)|e ) {
402 push (@search_dirs, @new_INC);
403 } elsif ($options{'-inc'}) {
404 push (@search_dirs, @INC);
407 # Add location of pod documentation for perl man pages (eg perlfunc)
408 # This is a pod directory in the private install tree
409 #my $perlpoddir = File::Spec->catdir($Config::Config{'installprivlib'},
411 #push (@search_dirs, $perlpoddir)
414 # Add location of binaries such as pod2text
415 push (@search_dirs, $Config::Config{'scriptdir'})
416 if -d $Config::Config{'scriptdir'};
419 # Loop over directories
420 Dir: foreach my $dir ( @search_dirs ) {
422 # Don't bother if can't find the directory
424 warn "Looking in directory $dir\n"
425 if $options{'-verbose'};
427 # Now concatenate this directory with the pod we are searching for
428 my $fullname = File::Spec->catfile($dir, @parts);
429 warn "Filename is now $fullname\n"
430 if $options{'-verbose'};
432 # Loop over possible extensions
433 foreach my $ext ('', '.pod', '.pm', '.pl') {
434 my $fullext = $fullname . $ext;
436 contains_pod($fullext, $options{'-verbose'}) ) {
437 warn "FOUND: $fullext\n" if $options{'-verbose'};
442 warn "Directory $dir does not exist\n"
443 if $options{'-verbose'};
446 if(-d File::Spec->catdir($dir,'pod')) {
447 $dir = File::Spec->catdir($dir,'pod');
455 =head2 C<contains_pod( $file , $verbose )>
457 Returns true if the supplied filename (not POD module) contains some pod
465 $verbose = shift if @_;
467 # check for one line of POD
468 unless(open(POD,"<$file")) {
469 warn "Error: $file is unreadable: $!\n";
475 close(POD) || die "Error closing $file: $!\n";
476 unless($pod =~ /\n=(head\d|pod|over|item)\b/s) {
477 warn "No POD in $file, skipping.\n"
487 Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>,
488 heavily borrowing code from Nick Ing-Simmons' PodToHtml.
490 Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt> provided
491 C<pod_where> and C<contains_pod>.
495 L<Pod::Parser>, L<Pod::Checker>, L<perldoc>