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