X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FPod%2FFind.pm;h=759cd3d1b994b30e1f3562071a3181dcc78bc9f4;hb=d7d9ad0c0eccd5b9ff687cafaaaa26c85d95fc9a;hp=399bbba2528a1198b2afcb5e3fdf694274d96845;hpb=e2c3adefd8c31a020997b83179ab5ab417e7e4ac;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Pod/Find.pm b/lib/Pod/Find.pm index 399bbba..759cd3d 100644 --- a/lib/Pod/Find.pm +++ b/lib/Pod/Find.pm @@ -3,7 +3,8 @@ # # Author: Marek Rouchal # -# borrowing code from Nick Ing-Simmon's PodToHtml +# Copyright (C) 1999-2000 by Marek Rouchal (and borrowing code +# from Nick Ing-Simmon's PodToHtml). All rights reserved. # This file is part of "PodParser". Pod::Find is free software; # you can redistribute it and/or modify it under the same terms # as Perl itself. @@ -12,8 +13,9 @@ package Pod::Find; use vars qw($VERSION); -$VERSION = 0.10; ## Current version of this package -require 5.005; ## requires this Perl version or later +$VERSION = 0.21; ## Current version of this package +require 5.005; ## requires this Perl version or later +use Carp; ############################################################################# @@ -31,12 +33,38 @@ Pod::Find - find POD documents in directory trees print "podname=",simplify_name('a/b/c/mymodule.pod'),"\n"; + $location = pod_where( { -inc => 1 }, "Pod::Find" ); + =head1 DESCRIPTION -B provides a function B that searches for POD -documents in a given set of files and directories. It returns a hash -with the file names as keys and the POD name as value. The POD name -is derived from the file name and its position in the directory tree. +B provides a set of functions to locate POD files. Note that +no function is exported by default to avoid pollution of your namespace, +so be sure to specify them in the B statement if you need them: + + use Pod::Find qw(pod_find); + +=cut + +use strict; +#use diagnostics; +use Exporter; +use File::Spec; +use File::Find; +use Cwd; + +use vars qw(@ISA @EXPORT_OK $VERSION); +@ISA = qw(Exporter); +@EXPORT_OK = qw(&pod_find &simplify_name &pod_where &contains_pod); + +# package global variables +my $SIMPLIFY_RX; + +=head2 C + +The function B searches for POD documents in a given set of +files and/or directories. It returns a hash with the file names as keys +and the POD name as value. The POD name is derived from the file name +and its position in the directory tree. E.g. when searching in F<$HOME/perl5lib>, the file F<$HOME/perl5lib/MyModule.pm> would get the POD name I, @@ -48,72 +76,44 @@ Only text files containing at least one valid POD command are found. A warning is printed if more than one POD file with the same POD name is found, e.g. F in different directories. This usually -indicates duplicate occurences of modules in the I<@INC> search path. - -The function B is equivalent to B, but also -strips Perl-like extensions (.pm, .pl, .pod). - -Note that neither B nor B are exported by -default so be sure to specify them in the B statement if you need them: - - use Pod::Find qw(pod_find simplify_name); +indicates duplicate occurrences of modules in the I<@INC> search path. -=head1 OPTIONS - -The first argument for B may be a hash reference with options. -The rest are either directories that are searched recursively or files. -The POD names of files are the plain basenames with any Perl-like extension -(.pm, .pl, .pod) stripped. +B The first argument for B may be a hash reference +with options. The rest are either directories that are searched +recursively or files. The POD names of files are the plain basenames +with any Perl-like extension (.pm, .pl, .pod) stripped. =over 4 -=item B<-verbose> +=item C<-verbose =E 1> Print progress information while scanning. -=item B<-perl> +=item C<-perl =E 1> Apply Perl-specific heuristics to find the correct PODs. This includes stripping Perl-like extensions, omitting subdirectories that are numeric but do I match the current Perl interpreter's version id, suppressing F as a module hierarchy name etc. -=item B<-script> +=item C<-script =E 1> Search for PODs in the current Perl interpreter's installation B. This is taken from the local L module. -=item B<-inc> +=item C<-inc =E 1> -Search for PODs in the current Perl interpreter's I<@INC> paths. +Search for PODs in the current Perl interpreter's I<@INC> paths. This +automatically considers paths specified in the C environment +as this is prepended to I<@INC> by the Perl interpreter itself. =back -=head1 AUTHOR - -Marek Rouchal Emarek@saftsack.fs.uni-bayreuth.deE, -heavily borrowing code from Nick Ing-Simmons' PodToHtml. - -=head1 SEE ALSO - -L, L - =cut -use strict; -#use diagnostics; -use Exporter; -use File::Find; -use Cwd; - -use vars qw(@ISA @EXPORT_OK $VERSION); -@ISA = qw(Exporter); -@EXPORT_OK = qw(&pod_find &simplify_name); - -# package global variables -my $SIMPLIFY_RX; - -# return a hash of the +# return a hash of the POD files found +# first argument may be a hashref (options), +# rest is a list of directories to search recursively sub pod_find { my %opts; @@ -141,11 +141,12 @@ sub pod_find require Config; # this code simplifies the POD name for Perl modules: # * remove "site_perl" - # * remove e.g. "i586-linux" + # * remove e.g. "i586-linux" (from 'archname') # * remove e.g. 5.00503 # * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod) $SIMPLIFY_RX = - qr!^(?i:site_perl/|$Config::Config{archname}/|\d+\.\d+([_.]?\d+)?/|pod/(?=.*?\.pod$))*!o; + qq!^(?i:site_perl/|\Q$Config::Config{archname}\E/|\\d+\\.\\d+([_.]?\\d+)?/|pod/(?=.*?\\.pod\\z))*!; + } my %dirs_visited; @@ -154,11 +155,15 @@ sub pod_find my $pwd = cwd(); foreach my $try (@search) { - unless($try =~ m:^/:) { - # make path absolute - $try = join('/',$pwd,$try); - } - $try =~ s:/\.?(?=/|$)::; # simplify path + unless(File::Spec->file_name_is_absolute($try)) { + # make path absolute + $try = File::Spec->catfile($pwd,$try); + } + # simplify path + # on VMS canonpath will vmsify:[the.path], but File::Find::find + # wants /unixy/paths + $try = File::Spec->canonpath($try) if ($^O ne 'VMS'); + $try = VMS::Filespec::unixify($try) if ($^O eq 'VMS'); my $name; if(-f $try) { if($name = _check_and_extract_name($try, $opts{-verbose})) { @@ -166,30 +171,30 @@ sub pod_find } next; } - my $root_rx = qr!^\Q$try\E/!; + my $root_rx = qq!^\Q$try\E/!; File::Find::find( sub { - my $item = $File::Find::name; - if(-d) { - if($dirs_visited{$item}) { - warn "Directory '$item' already seen, skipping.\n" - if($opts{-verbose}); - $File::Find::prune = 1; - return; - } - else { - $dirs_visited{$item} = 1; - } - if($opts{-perl} && /^(\d+\.[\d_]+)$/ && eval "$1" != $]) { + my $item = $File::Find::name; + if(-d) { + if($dirs_visited{$item}) { + warn "Directory '$item' already seen, skipping.\n" + if($opts{-verbose}); + $File::Find::prune = 1; + return; + } + else { + $dirs_visited{$item} = 1; + } + if($opts{-perl} && /^(\d+\.[\d_]+)\z/s && eval "$1" != $]) { $File::Find::prune = 1; warn "Perl $] version mismatch on $_, skipping.\n" - if($opts{-verbose}); - } - return; - } + if($opts{-verbose}); + } + return; + } if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) { _check_for_duplicates($item, $name, \%names, \%pods); } - }, $try); # end of File::Find::find + }, $try); # end of File::Find::find } chdir $pwd; %pods; @@ -199,8 +204,8 @@ sub _check_for_duplicates { my ($file, $name, $names_ref, $pods_ref) = @_; if($$names_ref{$name}) { warn "Duplicate POD found (shadowing?): $name ($file)\n"; - warn " Already seen in ", - join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n"; + warn " Already seen in ", + join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n"; } else { $$names_ref{$name} = 1; @@ -211,49 +216,231 @@ sub _check_for_duplicates { sub _check_and_extract_name { my ($file, $verbose, $root_rx) = @_; - # check extension or executable - unless($file =~ /\.(pod|pm|pl)$/i || (-f $file && -x _ && -T _)) { - return undef; + # check extension or executable flag + # this involves testing the .bat extension on Win32! + unless(-f $file && -T _ && ($file =~ /\.(pod|pm|plx?)\z/i || -x _ )) { + return undef; } - # check for one line of POD - unless(open(POD,"<$file")) { - warn "Error: $file is unreadable: $!\n"; - return undef; - } - local $/ = undef; - my $pod = ; - close(POD); - unless($pod =~ /\n=(head\d|pod|over|item)\b/) { - warn "No POD in $file, skipping.\n" - if($verbose); - return; - } - undef $pod; + return undef unless contains_pod($file,$verbose); # strip non-significant path components - # _TODO_ what happens on e.g. Win32? + # TODO what happens on e.g. Win32? my $name = $file; if(defined $root_rx) { - $name =~ s!$root_rx!!; - $name =~ s!$SIMPLIFY_RX!!o if(defined $SIMPLIFY_RX); + $name =~ s!$root_rx!!s; + $name =~ s!$SIMPLIFY_RX!!os if(defined $SIMPLIFY_RX); } else { - $name =~ s:^.*/::; + $name =~ s:^.*/::s; } - $name =~ s/\.(pod|pm|pl)$//i; - $name =~ s!/+!::!g; + _simplify($name); + $name =~ s!/+!::!g; #/ $name; } +=head2 C + +The function B is equivalent to B, but also +strips Perl-like extensions (.pm, .pl, .pod) and extensions like +F<.bat>, F<.cmd> on Win32 and OS/2, or F<.com> on VMS, respectively. + +=cut + # basic simplification of the POD name: # basename & strip extension sub simplify_name { my ($str) = @_; - $str =~ s:^.*/::; - $str =~ s:\.p([lm]|od)$::i; + # remove all path components + $str =~ s:^.*/::s; + _simplify($str); $str; } +# internal sub only +sub _simplify { + # strip Perl's own extensions + $_[0] =~ s/\.(pod|pm|plx?)\z//i; + # strip meaningless extensions on Win32 and OS/2 + $_[0] =~ s/\.(bat|exe|cmd)\z//i if($^O =~ /win|os2/i); + # strip meaningless extensions on VMS + $_[0] =~ s/\.(com)\z//i if($^O eq 'VMS'); +} + +# contribution from Tim Jenness + +=head2 C + +Returns the location of a pod document given a search directory +and a module (e.g. C) or script (e.g. C) name. + +Options: + +=over 4 + +=item C<-inc =E 1> + +Search @INC for the pod and also the C defined in the +L module. + +=item C<-dirs =E [ $dir1, $dir2, ... ]> + +Reference to an array of search directories. These are searched in order +before looking in C<@INC> (if B<-inc>). Current directory is used if +none are specified. + +=item C<-verbose =E 1> + +List directories as they are searched + +=back + +Returns the full path of the first occurence to the file. +Package names (eg 'A::B') are automatically converted to directory +names in the selected directory. (eg on unix 'A::B' is converted to +'A/B'). Additionally, '.pm', '.pl' and '.pod' are appended to the +search automatically if required. + +A subdirectory F is also checked if it exists in any of the given +search directories. This ensures that e.g. L is +found. + +It is assumed that if a module name is supplied, that that name +matches the file name. Pods are not opened to check for the 'NAME' +entry. + +A check is made to make sure that the file that is found does +contain some pod documentation. + +=cut + +sub pod_where { + + # default options + my %options = ( + '-inc' => 0, + '-verbose' => 0, + '-dirs' => [ '.' ], + ); + + # Check for an options hash as first argument + if (defined $_[0] && ref($_[0]) eq 'HASH') { + my $opt = shift; + + # Merge default options with supplied options + %options = (%options, %$opt); + } + + # Check usage + carp 'Usage: pod_where({options}, $pod)' unless (scalar(@_)); + + # Read argument + my $pod = shift; + + # Split on :: and then join the name together using File::Spec + my @parts = split (/::/, $pod); + + # Get full directory list + my @search_dirs = @{ $options{'-dirs'} }; + + if ($options{'-inc'}) { + + require Config; + + # Add @INC + push (@search_dirs, @INC) if $options{'-inc'}; + + # Add location of pod documentation for perl man pages (eg perlfunc) + # This is a pod directory in the private install tree + #my $perlpoddir = File::Spec->catdir($Config::Config{'installprivlib'}, + # 'pod'); + #push (@search_dirs, $perlpoddir) + # if -d $perlpoddir; + + # Add location of binaries such as pod2text + push (@search_dirs, $Config::Config{'scriptdir'}) + if -d $Config::Config{'scriptdir'}; + } + + # Loop over directories + Dir: foreach my $dir ( @search_dirs ) { + + # Don't bother if cant find the directory + if (-d $dir) { + warn "Looking in directory $dir\n" + if $options{'-verbose'}; + + # Now concatenate this directory with the pod we are searching for + my $fullname = File::Spec->catfile($dir, @parts); + warn "Filename is now $fullname\n" + if $options{'-verbose'}; + + # Loop over possible extensions + foreach my $ext ('', '.pod', '.pm', '.pl') { + my $fullext = $fullname . $ext; + if (-f $fullext && + contains_pod($fullext, $options{'-verbose'}) ) { + warn "FOUND: $fullext\n" if $options{'-verbose'}; + return $fullext; + } + } + } else { + warn "Directory $dir does not exist\n" + if $options{'-verbose'}; + next Dir; + } + if(-d File::Spec->catdir($dir,'pod')) { + $dir = File::Spec->catdir($dir,'pod'); + redo Dir; + } + } + # No match; + return undef; +} + +=head2 C + +Returns true if the supplied filename (not POD module) contains some pod +information. + +=cut + +sub contains_pod { + my $file = shift; + my $verbose = 0; + $verbose = shift if @_; + + # check for one line of POD + unless(open(POD,"<$file")) { + warn "Error: $file is unreadable: $!\n"; + return undef; + } + + local $/ = undef; + my $pod = ; + close(POD) || die "Error closing $file: $!\n"; + unless($pod =~ /\n=(head\d|pod|over|item)\b/s) { + warn "No POD in $file, skipping.\n" + if($verbose); + return 0; + } + + return 1; +} + +=head1 AUTHOR + +Marek Rouchal Emarek@saftsack.fs.uni-bayreuth.deE, +heavily borrowing code from Nick Ing-Simmons' PodToHtml. + +Tim Jenness Et.jenness@jach.hawaii.eduE provided +C and C. + +=head1 SEE ALSO + +L, L, L + +=cut + 1;