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