home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / lib / Pod / Find.pm < prev    next >
Text File  |  2000-03-16  |  8KB  |  279 lines
  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.  
  279.