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