File Coverage

blib/lib/Pod/Find.pm
Criterion Covered Total %
statement 0 158 0.0
branch 0 114 0.0
condition 0 34 0.0
subroutine 0 8 0.0
pod 4 4 100.0
total 4 318 1.2


line stmt bran cond sub pod time code
1             #############################################################################
2             # Pod/Find.pm -- finds files containing POD documentation
3             #
4             # Author: Marek Rouchal
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             use strict;
15              
16             use vars qw($VERSION);
17             $VERSION = '1.64'; ## Current version of this package
18             require 5.005; ## requires this Perl version or later
19             use Carp;
20              
21             BEGIN {
22             if ($] < 5.006) {
23             require Symbol;
24             import Symbol;
25             }
26             }
27              
28             #############################################################################
29              
30             =head1 NAME
31              
32             Pod::Find - find POD documents in directory trees
33              
34             =head1 SYNOPSIS
35              
36             use Pod::Find qw(pod_find simplify_name);
37             my %pods = pod_find({ -verbose => 1, -inc => 1 });
38             foreach(keys %pods) {
39             print "found library POD `$pods{$_}' in $_\n";
40             }
41              
42             print "podname=",simplify_name('a/b/c/mymodule.pod'),"\n";
43              
44             $location = pod_where( { -inc => 1 }, "Pod::Find" );
45              
46             =head1 DESCRIPTION
47              
48             B
49             higher) are going to remove Pod-Parser from core and use L
50             for all things POD.>
51              
52             B provides a set of functions to locate POD files. Note that
53             no function is exported by default to avoid pollution of your namespace,
54             so be sure to specify them in the B statement if you need them:
55              
56             use Pod::Find qw(pod_find);
57              
58             From this version on the typical SCM (software configuration management)
59             directories are ignored. These are: RCS, CVS, SCCS, .svn, .hg, .git, .sync
60              
61             =cut
62              
63             #use diagnostics;
64             use Exporter;
65             use File::Spec;
66             use File::Find;
67             use Cwd qw(abs_path cwd);
68              
69             use vars qw(@ISA @EXPORT_OK $VERSION);
70             @ISA = qw(Exporter);
71             @EXPORT_OK = qw(&pod_find &simplify_name &pod_where &contains_pod);
72              
73             # package global variables
74             my $SIMPLIFY_RX;
75              
76             =head2 C
77              
78             The function B searches for POD documents in a given set of
79             files and/or directories. It returns a hash with the file names as keys
80             and the POD name as value. The POD name is derived from the file name
81             and its position in the directory tree.
82              
83             E.g. when searching in F<$HOME/perl5lib>, the file
84             F<$HOME/perl5lib/MyModule.pm> would get the POD name I,
85             whereas F<$HOME/perl5lib/Myclass/Subclass.pm> would be
86             I. The name information can be used for POD
87             translators.
88              
89             Only text files containing at least one valid POD command are found.
90              
91             A warning is printed if more than one POD file with the same POD name
92             is found, e.g. F in different directories. This usually
93             indicates duplicate occurrences of modules in the I<@INC> search path.
94              
95             B The first argument for B may be a hash reference
96             with options. The rest are either directories that are searched
97             recursively or files. The POD names of files are the plain basenames
98             with any Perl-like extension (.pm, .pl, .pod) stripped.
99              
100             =over 4
101              
102             =item C<-verbose =E 1>
103              
104             Print progress information while scanning.
105              
106             =item C<-perl =E 1>
107              
108             Apply Perl-specific heuristics to find the correct PODs. This includes
109             stripping Perl-like extensions, omitting subdirectories that are numeric
110             but do I match the current Perl interpreter's version id, suppressing
111             F as a module hierarchy name etc.
112              
113             =item C<-script =E 1>
114              
115             Search for PODs in the current Perl interpreter's installation
116             B. This is taken from the local L module.
117              
118             =item C<-inc =E 1>
119              
120             Search for PODs in the current Perl interpreter's I<@INC> paths. This
121             automatically considers paths specified in the C environment
122             as this is included in I<@INC> by the Perl interpreter itself.
123              
124             =back
125              
126             =cut
127              
128             # return a hash of the POD files found
129             # first argument may be a hashref (options),
130             # rest is a list of directories to search recursively
131             sub pod_find
132             {
133 0     0 1   my %opts;
134 0 0         if(ref $_[0]) {
135 0           %opts = %{shift()};
  0            
136             }
137              
138 0   0       $opts{-verbose} ||= 0;
139 0   0       $opts{-perl} ||= 0;
140              
141 0           my (@search) = @_;
142              
143 0 0         if($opts{-script}) {
144 0           require Config;
145             push(@search, $Config::Config{scriptdir})
146 0 0         if -d $Config::Config{scriptdir};
147 0           $opts{-perl} = 1;
148             }
149              
150 0 0         if($opts{-inc}) {
151 0 0         if ($^O eq 'MacOS') {
152             # tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS
153 0           my @new_INC = @INC;
154 0           for (@new_INC) {
155 0 0         if ( $_ eq '.' ) {
    0          
156 0           $_ = ':';
157 0           } elsif ( $_ =~ s{^((?:\.\./)+)}{':' x (length($1)/3)}e ) {
158 0           $_ = ':'. $_;
159             } else {
160 0           $_ =~ s{^\./}{:};
161             }
162             }
163 0           push(@search, grep($_ ne File::Spec->curdir, @new_INC));
164             } else {
165 0           my %seen;
166 0           my $curdir = File::Spec->curdir;
167 0           foreach(@INC) {
168 0 0         next if $_ eq $curdir;
169 0           my $path = abs_path($_);
170 0 0         push(@search, $path) unless $seen{$path}++;
171             }
172             }
173              
174 0           $opts{-perl} = 1;
175             }
176              
177 0 0         if($opts{-perl}) {
178 0           require Config;
179             # this code simplifies the POD name for Perl modules:
180             # * remove "site_perl"
181             # * remove e.g. "i586-linux" (from 'archname')
182             # * remove e.g. 5.00503
183             # * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod)
184              
185             # Mac OS:
186             # * remove ":?site_perl:"
187             # * remove :?pod: if followed by *.pod (e.g. in :pod:perlfunc.pod)
188              
189 0 0         if ($^O eq 'MacOS') {
190 0           $SIMPLIFY_RX =
191             qq!^(?i:\:?site_perl\:|\:?pod\:(?=.*?\\.pod\\z))*!;
192             } else {
193 0           $SIMPLIFY_RX =
194             qq!^(?i:site(_perl)?/|\Q$Config::Config{archname}\E/|\\d+\\.\\d+([_.]?\\d+)?/|pod/(?=.*?\\.pod\\z))*!;
195             }
196             }
197              
198 0           my %dirs_visited;
199             my %pods;
200 0           my %names;
201 0           my $pwd = cwd();
202              
203 0           foreach my $try (@search) {
204 0 0         unless(File::Spec->file_name_is_absolute($try)) {
205             # make path absolute
206 0           $try = File::Spec->catfile($pwd,$try);
207             }
208             # simplify path
209             # on VMS canonpath will vmsify:[the.path], but File::Find::find
210             # wants /unixy/paths
211 0 0         if ($^O eq 'VMS') {
212 0           $try = VMS::Filespec::unixify($try);
213             }
214             else {
215 0           $try = File::Spec->canonpath($try);
216             }
217 0           my $name;
218 0 0         if(-f $try) {
219 0 0         if($name = _check_and_extract_name($try, $opts{-verbose})) {
220 0           _check_for_duplicates($try, $name, \%names, \%pods);
221             }
222 0           next;
223             }
224 0 0         my $root_rx = $^O eq 'MacOS' ? qq!^\Q$try\E! : qq!^\Q$try\E/!;
225 0           $root_rx=~ s|//$|/|; # remove trailing double slash
226             File::Find::find( sub {
227 0     0     my $item = $File::Find::name;
228 0 0         if(-d) {
229 0 0         if($item =~ m{/(?:RCS|CVS|SCCS|\.svn|\.hg|\.git|\.sync)$}) {
    0          
230 0           $File::Find::prune = 1;
231 0           return;
232             }
233             elsif($dirs_visited{$item}) {
234             warn "Directory '$item' already seen, skipping.\n"
235 0 0         if($opts{-verbose});
236 0           $File::Find::prune = 1;
237 0           return;
238             }
239             else {
240 0           $dirs_visited{$item} = 1;
241             }
242 0 0 0       if($opts{-perl} && /^(\d+\.[\d_]+)\z/s && eval "$1" != $]) {
      0        
243 0           $File::Find::prune = 1;
244             warn "Perl $] version mismatch on $_, skipping.\n"
245 0 0         if($opts{-verbose});
246             }
247 0           return;
248             }
249 0 0         if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) {
250 0           _check_for_duplicates($item, $name, \%names, \%pods);
251             }
252 0           }, $try); # end of File::Find::find
253             }
254 0           chdir $pwd;
255 0           return %pods;
256             }
257              
258             sub _check_for_duplicates {
259 0     0     my ($file, $name, $names_ref, $pods_ref) = @_;
260 0 0         if($$names_ref{$name}) {
261 0           warn "Duplicate POD found (shadowing?): $name ($file)\n";
262             warn ' Already seen in ',
263 0           join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n";
264             }
265             else {
266 0           $$names_ref{$name} = 1;
267             }
268 0           return $$pods_ref{$file} = $name;
269             }
270              
271             sub _check_and_extract_name {
272 0     0     my ($file, $verbose, $root_rx) = @_;
273              
274             # check extension or executable flag
275             # this involves testing the .bat extension on Win32!
276 0 0 0       unless(-f $file && -T $file && ($file =~ /\.(pod|pm|plx?)\z/i || -x $file )) {
      0        
      0        
277 0           return;
278             }
279              
280 0 0         return unless contains_pod($file,$verbose);
281              
282             # strip non-significant path components
283             # TODO what happens on e.g. Win32?
284 0           my $name = $file;
285 0 0         if(defined $root_rx) {
286 0           $name =~ s/$root_rx//is;
287 0 0         $name =~ s/$SIMPLIFY_RX//is if(defined $SIMPLIFY_RX);
288             }
289             else {
290 0 0         if ($^O eq 'MacOS') {
291 0           $name =~ s/^.*://s;
292             } else {
293 0           $name =~ s{^.*/}{}s;
294             }
295             }
296 0           _simplify($name);
297 0           $name =~ s{/+}{::}g;
298 0 0         if ($^O eq 'MacOS') {
299 0           $name =~ s{:+}{::}g; # : -> ::
300             } else {
301 0           $name =~ s{/+}{::}g; # / -> ::
302             }
303 0           return $name;
304             }
305              
306             =head2 C
307              
308             The function B is equivalent to B, but also
309             strips Perl-like extensions (.pm, .pl, .pod) and extensions like
310             F<.bat>, F<.cmd> on Win32 and OS/2, or F<.com> on VMS, respectively.
311              
312             =cut
313              
314             # basic simplification of the POD name:
315             # basename & strip extension
316             sub simplify_name {
317 0     0 1   my ($str) = @_;
318             # remove all path components
319 0 0         if ($^O eq 'MacOS') {
320 0           $str =~ s/^.*://s;
321             } else {
322 0           $str =~ s{^.*/}{}s;
323             }
324 0           _simplify($str);
325 0           return $str;
326             }
327              
328             # internal sub only
329             sub _simplify {
330             # strip Perl's own extensions
331 0     0     $_[0] =~ s/\.(pod|pm|plx?)\z//i;
332             # strip meaningless extensions on Win32 and OS/2
333 0 0         $_[0] =~ s/\.(bat|exe|cmd)\z//i if($^O =~ /mswin|os2/i);
334             # strip meaningless extensions on VMS
335 0 0         $_[0] =~ s/\.(com)\z//i if($^O eq 'VMS');
336             }
337              
338             # contribution from Tim Jenness
339              
340             =head2 C
341              
342             Returns the location of a pod document given a search directory
343             and a module (e.g. C) or script (e.g. C) name.
344              
345             Options:
346              
347             =over 4
348              
349             =item C<-inc =E 1>
350              
351             Search @INC for the pod and also the C defined in the
352             L module.
353              
354             =item C<-dirs =E [ $dir1, $dir2, ... ]>
355              
356             Reference to an array of search directories. These are searched in order
357             before looking in C<@INC> (if B<-inc>). Current directory is used if
358             none are specified.
359              
360             =item C<-verbose =E 1>
361              
362             List directories as they are searched
363              
364             =back
365              
366             Returns the full path of the first occurrence to the file.
367             Package names (eg 'A::B') are automatically converted to directory
368             names in the selected directory. (eg on unix 'A::B' is converted to
369             'A/B'). Additionally, '.pm', '.pl' and '.pod' are appended to the
370             search automatically if required.
371              
372             A subdirectory F is also checked if it exists in any of the given
373             search directories. This ensures that e.g. L is
374             found.
375              
376             It is assumed that if a module name is supplied, that that name
377             matches the file name. Pods are not opened to check for the 'NAME'
378             entry.
379              
380             A check is made to make sure that the file that is found does
381             contain some pod documentation.
382              
383             =cut
384              
385             sub pod_where {
386              
387             # default options
388 0     0 1   my %options = (
389             '-inc' => 0,
390             '-verbose' => 0,
391             '-dirs' => [ File::Spec->curdir ],
392             );
393              
394             # Check for an options hash as first argument
395 0 0 0       if (defined $_[0] && ref($_[0]) eq 'HASH') {
396 0           my $opt = shift;
397              
398             # Merge default options with supplied options
399 0           %options = (%options, %$opt);
400             }
401              
402             # Check usage
403 0 0         carp 'Usage: pod_where({options}, $pod)' unless (scalar(@_));
404              
405             # Read argument
406 0           my $pod = shift;
407              
408             # Split on :: and then join the name together using File::Spec
409 0           my @parts = split (/::/, $pod);
410              
411             # Get full directory list
412 0           my @search_dirs = @{ $options{'-dirs'} };
  0            
413              
414 0 0         if ($options{'-inc'}) {
415              
416 0           require Config;
417              
418             # Add @INC
419 0 0 0       if ($^O eq 'MacOS' && $options{'-inc'}) {
    0          
420             # tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS
421 0           my @new_INC = @INC;
422 0           for (@new_INC) {
423 0 0         if ( $_ eq '.' ) {
    0          
424 0           $_ = ':';
425 0           } elsif ( $_ =~ s{^((?:\.\./)+)}{':' x (length($1)/3)}e ) {
426 0           $_ = ':'. $_;
427             } else {
428 0           $_ =~ s{^\./}{:};
429             }
430             }
431 0           push (@search_dirs, @new_INC);
432             } elsif ($options{'-inc'}) {
433 0           push (@search_dirs, @INC);
434             }
435              
436             # Add location of pod documentation for perl man pages (eg perlfunc)
437             # This is a pod directory in the private install tree
438             #my $perlpoddir = File::Spec->catdir($Config::Config{'installprivlib'},
439             # 'pod');
440             #push (@search_dirs, $perlpoddir)
441             # if -d $perlpoddir;
442              
443             # Add location of binaries such as pod2text
444             push (@search_dirs, $Config::Config{'scriptdir'})
445 0 0         if -d $Config::Config{'scriptdir'};
446             }
447              
448             warn 'Search path is: '.join(' ', @search_dirs)."\n"
449 0 0         if $options{'-verbose'};
450              
451             # Loop over directories
452 0           Dir: foreach my $dir ( @search_dirs ) {
453              
454             # Don't bother if can't find the directory
455 0 0         if (-d $dir) {
456             warn "Looking in directory $dir\n"
457 0 0         if $options{'-verbose'};
458              
459             # Now concatenate this directory with the pod we are searching for
460 0           my $fullname = File::Spec->catfile($dir, @parts);
461 0 0         $fullname = VMS::Filespec::unixify($fullname) if $^O eq 'VMS';
462             warn "Filename is now $fullname\n"
463 0 0         if $options{'-verbose'};
464              
465             # Loop over possible extensions
466 0           foreach my $ext ('', '.pod', '.pm', '.pl') {
467 0           my $fullext = $fullname . $ext;
468 0 0 0       if (-f $fullext &&
469             contains_pod($fullext, $options{'-verbose'}) ) {
470 0 0         warn "FOUND: $fullext\n" if $options{'-verbose'};
471 0           return $fullext;
472             }
473             }
474             } else {
475             warn "Directory $dir does not exist\n"
476 0 0         if $options{'-verbose'};
477 0           next Dir;
478             }
479             # for some strange reason the path on MacOS/darwin/cygwin is
480             # 'pods' not 'pod'
481             # this could be the case also for other systems that
482             # have a case-tolerant file system, but File::Spec
483             # does not recognize 'darwin' yet. And cygwin also has "pods",
484             # but is not case tolerant. Oh well...
485 0 0 0       if((File::Spec->case_tolerant || $^O =~ /macos|darwin|cygwin/i)
      0        
486             && -d File::Spec->catdir($dir,'pods')) {
487 0           $dir = File::Spec->catdir($dir,'pods');
488 0           redo Dir;
489             }
490 0 0         if(-d File::Spec->catdir($dir,'pod')) {
491 0           $dir = File::Spec->catdir($dir,'pod');
492 0           redo Dir;
493             }
494             }
495             # No match;
496 0           return;
497             }
498              
499             =head2 C
500              
501             Returns true if the supplied filename (not POD module) contains some pod
502             information.
503              
504             =cut
505              
506             sub contains_pod {
507 0     0 1   my $file = shift;
508 0           my $verbose = 0;
509 0 0         $verbose = shift if @_;
510              
511             # check for one line of POD
512 0           my $podfh;
513 0 0         if ($] < 5.006) {
514 0           $podfh = gensym();
515             }
516              
517 0 0         unless(open($podfh,"<$file")) {
518 0           warn "Error: $file is unreadable: $!\n";
519 0           return;
520             }
521            
522 0           local $/ = undef;
523 0           my $pod = <$podfh>;
524 0 0         close($podfh) || die "Error closing $file: $!\n";
525 0 0         unless($pod =~ /^=(head\d|pod|over|item|cut)\b/m) {
526 0 0         warn "No POD in $file, skipping.\n"
527             if($verbose);
528 0           return 0;
529             }
530              
531 0           return 1;
532             }
533              
534             =head1 AUTHOR
535              
536             Please report bugs using L.
537              
538             Marek Rouchal Emarekr@cpan.orgE,
539             heavily borrowing code from Nick Ing-Simmons' PodToHtml.
540              
541             Tim Jenness Et.jenness@jach.hawaii.eduE provided
542             C and C.
543              
544             B is part of the L distribution.
545              
546             =head1 SEE ALSO
547              
548             L, L, L
549              
550             =cut
551              
552             1;
553