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.24;   ## 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             if -d $Config::Config{scriptdir};
 133         $opts{-perl} = 1;
 134     }
 135
 136     if($opts{-inc}) {
 137         if ($^O eq 'MacOS') {
 138             # tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS
 139             my @new_INC = @INC;
 140             for (@new_INC) {
 141                 if ( $_ eq '.' ) {
 142                     $_ = ':';
 143                 } elsif ( $_ =~ s|^((?:\.\./)+)|':' x (length($1)/3)|e ) {
 144                     $_ = ':'. $_;
 145                 } else {
 146                     $_ =~ s|^\./|:|;
 147                 }
 148             }
 149             push(@search, grep($_ ne File::Spec->curdir, @new_INC));
 150         } else {
 151             push(@search, grep($_ ne File::Spec->curdir, @INC));
 152         }
 153
 154         $opts{-perl} = 1;
 155     }
 156
 157     if($opts{-perl}) {
 158         require Config;
 159         # this code simplifies the POD name for Perl modules:
 160         # * remove "site_perl"
 161         # * remove e.g. "i586-linux" (from 'archname')
 162         # * remove e.g. 5.00503
 163         # * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod)
 164
 165         # Mac OS:
 166         # * remove ":?site_perl:"
 167         # * remove :?pod: if followed by *.pod (e.g. in :pod:perlfunc.pod)
 168
 169         if ($^O eq 'MacOS') {
 170             $SIMPLIFY_RX =
 171               qq!^(?i:\:?site_perl\:|\:?pod\:(?=.*?\\.pod\\z))*!;
 172         } else {
 173             $SIMPLIFY_RX =
 174               qq!^(?i:site(_perl)?/|\Q$Config::Config{archname}\E/|\\d+\\.\\d+([_.]?\\d+)?/|pod/(?=.*?\\.pod\\z))*!;
 175         }
 176     }
 177
 178     my %dirs_visited;
 179     my %pods;
 180     my %names;
 181     my $pwd = cwd();
 182
 183     foreach my $try (@search) {
 184         unless(File::Spec->file_name_is_absolute($try)) {
 185             # make path absolute
 186             $try = File::Spec->catfile($pwd,$try);
 187         }
 188         # simplify path
 189         # on VMS canonpath will vmsify:[the.path], but File::Find::find
 190         # wants /unixy/paths
 191         $try = File::Spec->canonpath($try) if ($^O ne 'VMS');
 192         $try = VMS::Filespec::unixify($try) if ($^O eq 'VMS');
 193         my $name;
 194         if(-f $try) {
 195             if($name = _check_and_extract_name($try, $opts{-verbose})) {
 196                 _check_for_duplicates($try, $name, \%names, \%pods);
 197             }
 198             next;
 199         }
 200         my $root_rx = $^O eq 'MacOS' ? qq!^\Q$try\E! : qq!^\Q$try\E/!;
 201         File::Find::find( sub {
 202             my $item = $File::Find::name;
 203             if(-d) {
 204                 if($dirs_visited{$item}) {
 205                     warn "Directory '$item' already seen, skipping.\n"
 206                         if($opts{-verbose});
 207                     $File::Find::prune = 1;
 208                     return;
 209                 }
 210                 else {
 211                     $dirs_visited{$item} = 1;
 212                 }
 213                 if($opts{-perl} && /^(\d+\.[\d_]+)\z/s && eval "$1" != $]) {
 214                     $File::Find::prune = 1;
 215                     warn "Perl $] version mismatch on $_, skipping.\n"
 216                         if($opts{-verbose});
 217                 }
 218                 return;
 219             }
 220             if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) {
 221                 _check_for_duplicates($item, $name, \%names, \%pods);
 222             }
 223         }, $try); # end of File::Find::find
 224     }
 225     chdir $pwd;
 226     %pods;
 227 }
 228
 229 sub _check_for_duplicates {
 230     my ($file, $name, $names_ref, $pods_ref) = @_;
 231     if($$names_ref{$name}) {
 232         warn "Duplicate POD found (shadowing?): $name ($file)\n";
 233         warn "    Already seen in ",
 234             join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n";
 235     }
 236     else {
 237         $$names_ref{$name} = 1;
 238     }
 239     $$pods_ref{$file} = $name;
 240 }
 241
 242 sub _check_and_extract_name {
 243     my ($file, $verbose, $root_rx) = @_;
 244
 245     # check extension or executable flag
 246     # this involves testing the .bat extension on Win32!
 247     unless(-f $file && -T _ && ($file =~ /\.(pod|pm|plx?)\z/i || -x _ )) {
 248       return undef;
 249     }
 250
 251     return undef unless contains_pod($file,$verbose);
 252
 253     # strip non-significant path components
 254     # TODO what happens on e.g. Win32?
 255     my $name = $file;
 256     if(defined $root_rx) {
 257         $name =~ s!$root_rx!!s;
 258         $name =~ s!$SIMPLIFY_RX!!os if(defined $SIMPLIFY_RX);
 259     }
 260     else {
 261         if ($^O eq 'MacOS') {
 262             $name =~ s/^.*://s;
 263         } else {
 264             $name =~ s:^.*/::s;
 265         }
 266     }
 267     _simplify($name);
 268     $name =~ s!/+!::!g; #/
 269     if ($^O eq 'MacOS') {
 270         $name =~ s!:+!::!g; # : -> ::
 271     } else {
 272         $name =~ s!/+!::!g; # / -> ::
 273     }
 274     $name;
 275 }
 276
 277 =head2 C<simplify_name( $str )>
 278
 279 The function B<simplify_name> is equivalent to B<basename>, but also
 280 strips Perl-like extensions (.pm, .pl, .pod) and extensions like
 281 F<.bat>, F<.cmd> on Win32 and OS/2, or F<.com> on VMS, respectively.
 282
 283 =cut
 284
 285 # basic simplification of the POD name:
 286 # basename & strip extension
 287 sub simplify_name {
 288     my ($str) = @_;
 289     # remove all path components
 290     if ($^O eq 'MacOS') {
 291         $str =~ s/^.*://s;
 292     } else {
 293         $str =~ s:^.*/::s;
 294     }
 295     _simplify($str);
 296     $str;
 297 }
 298
 299 # internal sub only
 300 sub _simplify {
 301     # strip Perl's own extensions
 302     $_[0] =~ s/\.(pod|pm|plx?)\z//i;
 303     # strip meaningless extensions on Win32 and OS/2
 304     $_[0] =~ s/\.(bat|exe|cmd)\z//i if($^O =~ /mswin|os2/i);
 305     # strip meaningless extensions on VMS
 306     $_[0] =~ s/\.(com)\z//i if($^O eq 'VMS');
 307 }
 308
 309 # contribution from Tim Jenness <t.jenness@jach.hawaii.edu>
 310
 311 =head2 C<pod_where( { %opts }, $pod )>
 312
 313 Returns the location of a pod document given a search directory
 314 and a module (e.g. C<File::Find>) or script (e.g. C<perldoc>) name.
 315
 316 Options:
 317
 318 =over 4
 319
 320 =item C<-inc =E<gt> 1>
 321
 322 Search @INC for the pod and also the C<scriptdir> defined in the
 323 L<Config|Config> module.
 324
 325 =item C<-dirs =E<gt> [ $dir1, $dir2, ... ]>
 326
 327 Reference to an array of search directories. These are searched in order
 328 before looking in C<@INC> (if B<-inc>). Current directory is used if
 329 none are specified.
 330
 331 =item C<-verbose =E<gt> 1>
 332
 333 List directories as they are searched
 334
 335 =back
 336
 337 Returns the full path of the first occurrence to the file.
 338 Package names (eg 'A::B') are automatically converted to directory
 339 names in the selected directory. (eg on unix 'A::B' is converted to
 340 'A/B'). Additionally, '.pm', '.pl' and '.pod' are appended to the
 341 search automatically if required.
 342
 343 A subdirectory F<pod/> is also checked if it exists in any of the given
 344 search directories. This ensures that e.g. L<perlfunc|perlfunc> is
 345 found.
 346
 347 It is assumed that if a module name is supplied, that that name
 348 matches the file name. Pods are not opened to check for the 'NAME'
 349 entry.
 350
 351 A check is made to make sure that the file that is found does
 352 contain some pod documentation.
 353
 354 =cut
 355
 356 sub pod_where {
 357
 358   # default options
 359   my %options = (
 360          '-inc' => 0,
 361          '-verbose' => 0,
 362          '-dirs' => [ File::Spec->curdir ],
 363         );
 364
 365   # Check for an options hash as first argument
 366   if (defined $_[0] && ref($_[0]) eq 'HASH') {
 367     my $opt = shift;
 368
 369     # Merge default options with supplied options
 370     %options = (%options, %$opt);
 371   }
 372
 373   # Check usage
 374   carp 'Usage: pod_where({options}, $pod)' unless (scalar(@_));
 375
 376   # Read argument
 377   my $pod = shift;
 378
 379   # Split on :: and then join the name together using File::Spec
 380   my @parts = split (/::/, $pod);
 381
 382   # Get full directory list
 383   my @search_dirs = @{ $options{'-dirs'} };
 384
 385   if ($options{'-inc'}) {
 386
 387     require Config;
 388
 389     # Add @INC
 390     if ($^O eq 'MacOS' && $options{'-inc'}) {
 391         # tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS
 392         my @new_INC = @INC;
 393         for (@new_INC) {
 394             if ( $_ eq '.' ) {
 395                 $_ = ':';
 396             } elsif ( $_ =~ s|^((?:\.\./)+)|':' x (length($1)/3)|e ) {
 397                 $_ = ':'. $_;
 398             } else {
 399                 $_ =~ s|^\./|:|;
 400             }
 401         }
 402         push (@search_dirs, @new_INC);
 403     } elsif ($options{'-inc'}) {
 404         push (@search_dirs, @INC);
 405     }
 406
 407     # Add location of pod documentation for perl man pages (eg perlfunc)
 408     # This is a pod directory in the private install tree
 409     #my $perlpoddir = File::Spec->catdir($Config::Config{'installprivlib'},
 410     #                                   'pod');
 411     #push (@search_dirs, $perlpoddir)
 412     #  if -d $perlpoddir;
 413
 414     # Add location of binaries such as pod2text
 415     push (@search_dirs, $Config::Config{'scriptdir'})
 416       if -d $Config::Config{'scriptdir'};
 417   }
 418
 419   warn "Search path is: ".join(' ', @search_dirs)."\n"
 420         if $options{'-verbose'};
 421
 422   # Loop over directories
 423   Dir: foreach my $dir ( @search_dirs ) {
 424
 425     # Don't bother if can't find the directory
 426     if (-d $dir) {
 427       warn "Looking in directory $dir\n"
 428         if $options{'-verbose'};
 429
 430       # Now concatenate this directory with the pod we are searching for
 431       my $fullname = File::Spec->catfile($dir, @parts);
 432       warn "Filename is now $fullname\n"
 433         if $options{'-verbose'};
 434
 435       # Loop over possible extensions
 436       foreach my $ext ('', '.pod', '.pm', '.pl') {
 437         my $fullext = $fullname . $ext;
 438         if (-f $fullext &&
 439          contains_pod($fullext, $options{'-verbose'}) ) {
 440           warn "FOUND: $fullext\n" if $options{'-verbose'};
 441           return $fullext;
 442         }
 443       }
 444     } else {
 445       warn "Directory $dir does not exist\n"
 446         if $options{'-verbose'};
 447       next Dir;
 448     }
 449     # for some strange reason the path on MacOS/darwin/cygwin is
 450     # 'pods' not 'pod'
 451     # this could be the case also for other systems that
 452     # have a case-tolerant file system, but File::Spec
 453     # does not recognize 'darwin' yet. And cygwin also has "pods",
 454     # but is not case tolerant. Oh well...
 455     if((File::Spec->case_tolerant || $^O =~ /macos|darwin|cygwin/i)
 456      && -d File::Spec->catdir($dir,'pods')) {
 457       $dir = File::Spec->catdir($dir,'pods');
 458       redo Dir;
 459     }
 460     if(-d File::Spec->catdir($dir,'pod')) {
 461       $dir = File::Spec->catdir($dir,'pod');
 462       redo Dir;
 463     }
 464   }
 465   # No match;
 466   return undef;
 467 }
 468
 469 =head2 C<contains_pod( $file , $verbose )>
 470
 471 Returns true if the supplied filename (not POD module) contains some pod
 472 information.
 473
 474 =cut
 475
 476 sub contains_pod {
 477   my $file = shift;
 478   my $verbose = 0;
 479   $verbose = shift if @_;
 480
 481   # check for one line of POD
 482   unless(open(POD,"<$file")) {
 483     warn "Error: $file is unreadable: $!\n";
 484     return undef;
 485   }
 486
 487   local $/ = undef;
 488   my $pod = <POD>;
 489   close(POD) || die "Error closing $file: $!\n";
 490   unless($pod =~ /\n=(head\d|pod|over|item)\b/s) {
 491     warn "No POD in $file, skipping.\n"
 492       if($verbose);
 493     return 0;
 494   }
 495
 496   return 1;
 497 }
 498
 499 =head1 AUTHOR
 500
 501 Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>,
 502 heavily borrowing code from Nick Ing-Simmons' PodToHtml.
 503
 504 Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt> provided
 505 C<pod_where> and C<contains_pod>.
 506
 507 =head1 SEE ALSO
 508
 509 L<Pod::Parser>, L<Pod::Checker>, L<perldoc>
 510
 511 =cut
 512
 513 1;
 514