Re: Copious warnings from Sys::Syslog
[p5sagit/p5-mst-13.2.git] / lib / Pod / Find.pm
CommitLineData
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
13package Pod::Find;
14
15use vars qw($VERSION);
88d01e8d 16$VERSION = 0.22; ## Current version of this package
92e3d63a 17require 5.005; ## requires this Perl version or later
18use Carp;
e2c3adef 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 36 $location = pod_where( { -inc => 1 }, "Pod::Find" );
37
e2c3adef 38=head1 DESCRIPTION
39
92e3d63a 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 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 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 85
86=over 4
87
92e3d63a 88=item C<-verbose =E<gt> 1>
e2c3adef 89
90Print progress information while scanning.
91
92e3d63a 92=item C<-perl =E<gt> 1>
e2c3adef 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 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 107automatically considers paths specified in the C<PERL5LIB> environment
108as this is prepended to I<@INC> by the Perl interpreter itself.
e2c3adef 109
110=back
111
e2c3adef 112=cut
113
66aff6dd 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 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 145 # * remove e.g. 5.00503
146 # * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod)
147 $SIMPLIFY_RX =
dbd1b0a2 148 qq!^(?i:site(_perl)?/|\Q$Config::Config{archname}\E/|\\d+\\.\\d+([_.]?\\d+)?/|pod/(?=.*?\\.pod\\z))*!;
66aff6dd 149
e2c3adef 150 }
151
152 my %dirs_visited;
153 my %pods;
154 my %names;
155 my $pwd = cwd();
156
157 foreach my $try (@search) {
2773b013 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 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');
c4974618 166 $try = VMS::Filespec::unixify($try) if ($^O eq 'VMS');
e2c3adef 167 my $name;
168 if(-f $try) {
169 if($name = _check_and_extract_name($try, $opts{-verbose})) {
170 _check_for_duplicates($try, $name, \%names, \%pods);
171 }
172 next;
173 }
2773b013 174 my $root_rx = qq!^\Q$try\E/!;
e2c3adef 175 File::Find::find( sub {
2773b013 176 my $item = $File::Find::name;
177 if(-d) {
178 if($dirs_visited{$item}) {
179 warn "Directory '$item' already seen, skipping.\n"
180 if($opts{-verbose});
181 $File::Find::prune = 1;
182 return;
183 }
184 else {
185 $dirs_visited{$item} = 1;
186 }
187 if($opts{-perl} && /^(\d+\.[\d_]+)\z/s && eval "$1" != $]) {
e2c3adef 188 $File::Find::prune = 1;
189 warn "Perl $] version mismatch on $_, skipping.\n"
2773b013 190 if($opts{-verbose});
191 }
192 return;
193 }
e2c3adef 194 if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) {
195 _check_for_duplicates($item, $name, \%names, \%pods);
196 }
2773b013 197 }, $try); # end of File::Find::find
e2c3adef 198 }
199 chdir $pwd;
200 %pods;
201}
202
203sub _check_for_duplicates {
204 my ($file, $name, $names_ref, $pods_ref) = @_;
205 if($$names_ref{$name}) {
206 warn "Duplicate POD found (shadowing?): $name ($file)\n";
2773b013 207 warn " Already seen in ",
208 join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n";
e2c3adef 209 }
210 else {
211 $$names_ref{$name} = 1;
212 }
213 $$pods_ref{$file} = $name;
214}
215
216sub _check_and_extract_name {
217 my ($file, $verbose, $root_rx) = @_;
218
2773b013 219 # check extension or executable flag
220 # this involves testing the .bat extension on Win32!
92e3d63a 221 unless(-f $file && -T _ && ($file =~ /\.(pod|pm|plx?)\z/i || -x _ )) {
222 return undef;
e2c3adef 223 }
224
92e3d63a 225 return undef unless contains_pod($file,$verbose);
e2c3adef 226
227 # strip non-significant path components
92e3d63a 228 # TODO what happens on e.g. Win32?
e2c3adef 229 my $name = $file;
230 if(defined $root_rx) {
fe6f1558 231 $name =~ s!$root_rx!!s;
232 $name =~ s!$SIMPLIFY_RX!!os if(defined $SIMPLIFY_RX);
e2c3adef 233 }
234 else {
fe6f1558 235 $name =~ s:^.*/::s;
e2c3adef 236 }
2773b013 237 _simplify($name);
238 $name =~ s!/+!::!g; #/
e2c3adef 239 $name;
240}
241
92e3d63a 242=head2 C<simplify_name( $str )>
243
244The function B<simplify_name> is equivalent to B<basename>, but also
245strips Perl-like extensions (.pm, .pl, .pod) and extensions like
2eec1a1e 246F<.bat>, F<.cmd> on Win32 and OS/2, or F<.com> on VMS, respectively.
92e3d63a 247
248=cut
249
e2c3adef 250# basic simplification of the POD name:
251# basename & strip extension
252sub simplify_name {
253 my ($str) = @_;
2773b013 254 # remove all path components
fe6f1558 255 $str =~ s:^.*/::s;
2773b013 256 _simplify($str);
e2c3adef 257 $str;
258}
259
2773b013 260# internal sub only
261sub _simplify {
262 # strip Perl's own extensions
263 $_[0] =~ s/\.(pod|pm|plx?)\z//i;
264 # strip meaningless extensions on Win32 and OS/2
dbd1b0a2 265 $_[0] =~ s/\.(bat|exe|cmd)\z//i if($^O =~ /mswin|os2/i);
2eec1a1e 266 # strip meaningless extensions on VMS
267 $_[0] =~ s/\.(com)\z//i if($^O eq 'VMS');
2773b013 268}
269
92e3d63a 270# contribution from Tim Jenness <t.jenness@jach.hawaii.edu>
271
272=head2 C<pod_where( { %opts }, $pod )>
273
274Returns the location of a pod document given a search directory
275and a module (e.g. C<File::Find>) or script (e.g. C<perldoc>) name.
276
277Options:
278
279=over 4
280
281=item C<-inc =E<gt> 1>
282
283Search @INC for the pod and also the C<scriptdir> defined in the
284L<Config|Config> module.
285
286=item C<-dirs =E<gt> [ $dir1, $dir2, ... ]>
287
288Reference to an array of search directories. These are searched in order
289before looking in C<@INC> (if B<-inc>). Current directory is used if
290none are specified.
291
292=item C<-verbose =E<gt> 1>
293
294List directories as they are searched
295
296=back
297
298Returns the full path of the first occurence to the file.
299Package names (eg 'A::B') are automatically converted to directory
300names in the selected directory. (eg on unix 'A::B' is converted to
301'A/B'). Additionally, '.pm', '.pl' and '.pod' are appended to the
302search automatically if required.
303
304A subdirectory F<pod/> is also checked if it exists in any of the given
305search directories. This ensures that e.g. L<perlfunc|perlfunc> is
306found.
307
308It is assumed that if a module name is supplied, that that name
309matches the file name. Pods are not opened to check for the 'NAME'
310entry.
311
312A check is made to make sure that the file that is found does
313contain some pod documentation.
314
315=cut
316
317sub pod_where {
318
319 # default options
320 my %options = (
321 '-inc' => 0,
322 '-verbose' => 0,
323 '-dirs' => [ '.' ],
324 );
325
326 # Check for an options hash as first argument
327 if (defined $_[0] && ref($_[0]) eq 'HASH') {
328 my $opt = shift;
329
330 # Merge default options with supplied options
331 %options = (%options, %$opt);
332 }
333
334 # Check usage
335 carp 'Usage: pod_where({options}, $pod)' unless (scalar(@_));
336
337 # Read argument
338 my $pod = shift;
339
340 # Split on :: and then join the name together using File::Spec
341 my @parts = split (/::/, $pod);
342
343 # Get full directory list
344 my @search_dirs = @{ $options{'-dirs'} };
345
346 if ($options{'-inc'}) {
347
348 require Config;
349
350 # Add @INC
351 push (@search_dirs, @INC) if $options{'-inc'};
352
353 # Add location of pod documentation for perl man pages (eg perlfunc)
354 # This is a pod directory in the private install tree
355 #my $perlpoddir = File::Spec->catdir($Config::Config{'installprivlib'},
356 # 'pod');
357 #push (@search_dirs, $perlpoddir)
358 # if -d $perlpoddir;
359
360 # Add location of binaries such as pod2text
361 push (@search_dirs, $Config::Config{'scriptdir'})
362 if -d $Config::Config{'scriptdir'};
363 }
364
365 # Loop over directories
366 Dir: foreach my $dir ( @search_dirs ) {
367
368 # Don't bother if cant find the directory
369 if (-d $dir) {
370 warn "Looking in directory $dir\n"
371 if $options{'-verbose'};
372
373 # Now concatenate this directory with the pod we are searching for
374 my $fullname = File::Spec->catfile($dir, @parts);
375 warn "Filename is now $fullname\n"
376 if $options{'-verbose'};
377
378 # Loop over possible extensions
379 foreach my $ext ('', '.pod', '.pm', '.pl') {
380 my $fullext = $fullname . $ext;
381 if (-f $fullext &&
382 contains_pod($fullext, $options{'-verbose'}) ) {
383 warn "FOUND: $fullext\n" if $options{'-verbose'};
384 return $fullext;
385 }
386 }
387 } else {
388 warn "Directory $dir does not exist\n"
389 if $options{'-verbose'};
390 next Dir;
391 }
392 if(-d File::Spec->catdir($dir,'pod')) {
393 $dir = File::Spec->catdir($dir,'pod');
394 redo Dir;
395 }
396 }
397 # No match;
398 return undef;
399}
400
401=head2 C<contains_pod( $file , $verbose )>
402
403Returns true if the supplied filename (not POD module) contains some pod
404information.
405
406=cut
407
408sub contains_pod {
409 my $file = shift;
410 my $verbose = 0;
411 $verbose = shift if @_;
412
413 # check for one line of POD
414 unless(open(POD,"<$file")) {
415 warn "Error: $file is unreadable: $!\n";
416 return undef;
417 }
418
419 local $/ = undef;
420 my $pod = <POD>;
421 close(POD) || die "Error closing $file: $!\n";
422 unless($pod =~ /\n=(head\d|pod|over|item)\b/s) {
423 warn "No POD in $file, skipping.\n"
424 if($verbose);
425 return 0;
426 }
427
428 return 1;
429}
430
431=head1 AUTHOR
432
433Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>,
434heavily borrowing code from Nick Ing-Simmons' PodToHtml.
435
436Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt> provided
437C<pod_where> and C<contains_pod>.
438
439=head1 SEE ALSO
440
441L<Pod::Parser>, L<Pod::Checker>, L<perldoc>
442
443=cut
444
e2c3adef 4451;
446