[p5sagit/p5-mst-13.2.git] / lib / Pod / Find.pm

#############################################################################  
# Pod/Find.pm -- finds files containing POD documentation
#
# Author: Marek Rouchal <marek@saftsack.fs.uni-bayreuth.de>
# 
# borrowing code from Nick Ing-Simmon's PodToHtml
# 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.
#############################################################################

package Pod::Find;

use vars qw($VERSION);
$VERSION = 0.10;   ## Current version of this package
require  5.005;    ## requires this Perl version or later

#############################################################################

=head1 NAME

Pod::Find - find POD documents in directory trees

=head1 SYNOPSIS

  use Pod::Find qw(pod_find simplify_name);
  my %pods = pod_find({ -verbose => 1, -inc => 1 });
  foreach(keys %pods) {
     print "found library POD `$pods{$_}' in $_\n";
  }

  print "podname=",simplify_name('a/b/c/mymodule.pod'),"\n";

=head1 DESCRIPTION

B<Pod::Find> provides a function B<pod_find> 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.

E.g. when searching in F<$HOME/perl5lib>, the file
F<$HOME/perl5lib/MyModule.pm> would get the POD name I<MyModule>,
whereas F<$HOME/perl5lib/Myclass/Subclass.pm> would be
I<Myclass::Subclass>. The name information can be used for POD
translators.

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<CPAN.pm> in different directories. This usually
indicates duplicate occurences of modules in the I<@INC> search path.

The function B<simplify_name> is equivalent to B<basename>, but also
strips Perl-like extensions (.pm, .pl, .pod).

Note that neither B<pod_find> nor B<simplify_name> are exported by
default so be sure to specify them in the B<use> statement if you need them:

  use Pod::Find qw(pod_find simplify_name);

=head1 OPTIONS

The first argument for B<pod_find> 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>

Print progress information while scanning.

=item B<-perl>

Apply Perl-specific heuristics to find the correct PODs. This includes
stripping Perl-like extensions, omitting subdirectories that are numeric
but do I<not> match the current Perl interpreter's version id, suppressing
F<site_perl> as a module hierarchy name etc.

=item B<-script>

Search for PODs in the current Perl interpreter's installation 
B<scriptdir>. This is taken from the local L<Config|Config> module.

=item B<-inc>

Search for PODs in the current Perl interpreter's I<@INC> paths.

=back

=head1 AUTHOR

Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>,
heavily borrowing code from Nick Ing-Simmons' PodToHtml.

=head1 SEE ALSO

L<Pod::Parser>, L<Pod::Checker>

=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 
sub pod_find
{
    my %opts;
    if(ref $_[0]) {
        %opts = %{shift()};
    }

    $opts{-verbose} ||= 0;
    $opts{-perl}    ||= 0;

    my (@search) = @_;

    if($opts{-script}) {
        require Config;
        push(@search, $Config::Config{scriptdir});
        $opts{-perl} = 1;
    }

    if($opts{-inc}) {
        push(@search, grep($_ ne '.',@INC));
        $opts{-perl} = 1;
    }

    if($opts{-perl}) {
        require Config;
        # this code simplifies the POD name for Perl modules:
        # * remove "site_perl"
        # * remove e.g. "i586-linux"
        # * 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;
    }

    my %dirs_visited;
    my %pods;
    my %names;
    my $pwd = cwd();

    foreach my $try (@search) {
        unless($try =~ m:^/:) {
	    # make path absolute
	    $try = join('/',$pwd,$try);
	}
	$try =~ s:/\.?(?=/|$)::; # simplify path
        my $name;
        if(-f $try) {
            if($name = _check_and_extract_name($try, $opts{-verbose})) {
                _check_for_duplicates($try, $name, \%names, \%pods);
            }
            next;
        }
	my $root_rx = qr!^\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" != $]) {
                    $File::Find::prune = 1;
                    warn "Perl $] version mismatch on $_, skipping.\n"
		        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
    }
    chdir $pwd;
    %pods;
}

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";
    }
    else {
        $$names_ref{$name} = 1;
    }
    $$pods_ref{$file} = $name;
}

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 for one line of POD
    unless(open(POD,"<$file")) {
        warn "Error: $file is unreadable: $!\n";
	return undef;
    }
    local $/ = undef;
    my $pod = <POD>;
    close(POD);
    unless($pod =~ /\n=(head\d|pod|over|item)\b/) {
        warn "No POD in $file, skipping.\n"
            if($verbose);
        return;
    }
    undef $pod;

    # strip non-significant path components
    # _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);
    }
    else {
        $name =~ s:^.*/::;
    }
    $name =~ s/\.(pod|pm|pl)$//i;
    $name =~ s!/+!::!g;
    $name;
}

# basic simplification of the POD name:
# basename & strip extension
sub simplify_name {
    my ($str) = @_;
    $str =~ s:^.*/::;
    $str =~ s:\.p([lm]|od)$::i;
    $str;
}

1;
Commit	Line	Data
e2c3adef	1	#############################################################################
	2	# Pod/Find.pm -- finds files containing POD documentation
	3	#
	4	# Author: Marek Rouchal <marek@saftsack.fs.uni-bayreuth.de>
	5	#
	6	# borrowing code from Nick Ing-Simmon's PodToHtml
	7	# This file is part of "PodParser". Pod::Find is free software;
	8	# you can redistribute it and/or modify it under the same terms
	9	# as Perl itself.
	10	#############################################################################
	11
	12	package Pod::Find;
	13
	14	use vars qw($VERSION);
	15	$VERSION = 0.10; ## Current version of this package
	16	require 5.005; ## requires this Perl version or later
	17
	18	#############################################################################
	19
	20	=head1 NAME
	21
	22	Pod::Find - find POD documents in directory trees
	23
	24	=head1 SYNOPSIS
	25
	26	use Pod::Find qw(pod_find simplify_name);
	27	my %pods = pod_find({ -verbose => 1, -inc => 1 });
	28	foreach(keys %pods) {
	29	print "found library POD `$pods{$_}' in $_\n";
	30	}
	31
	32	print "podname=",simplify_name('a/b/c/mymodule.pod'),"\n";
	33
	34	=head1 DESCRIPTION
	35
	36	B<Pod::Find> provides a function B<pod_find> that searches for POD
	37	documents in a given set of files and directories. It returns a hash
	38	with the file names as keys and the POD name as value. The POD name
	39	is derived from the file name and its position in the directory tree.
	40
	41	E.g. when searching in F<$HOME/perl5lib>, the file
	42	F<$HOME/perl5lib/MyModule.pm> would get the POD name I<MyModule>,
	43	whereas F<$HOME/perl5lib/Myclass/Subclass.pm> would be
	44	I<Myclass::Subclass>. The name information can be used for POD
	45	translators.
	46
	47	Only text files containing at least one valid POD command are found.
	48
	49	A warning is printed if more than one POD file with the same POD name
	50	is found, e.g. F<CPAN.pm> in different directories. This usually
	51	indicates duplicate occurences of modules in the I<@INC> search path.
	52
	53	The function B<simplify_name> is equivalent to B<basename>, but also
	54	strips Perl-like extensions (.pm, .pl, .pod).
	55
	56	Note that neither B<pod_find> nor B<simplify_name> are exported by
	57	default so be sure to specify them in the B<use> statement if you need them:
	58
	59	use Pod::Find qw(pod_find simplify_name);
	60
	61	=head1 OPTIONS
	62
	63	The first argument for B<pod_find> may be a hash reference with options.
	64	The rest are either directories that are searched recursively or files.
65	The POD names of files are the plain basenames with any Perl-like extension
66	(.pm, .pl, .pod) stripped.
67
68	=over 4
69
70	=item B<-verbose>
71
72	Print progress information while scanning.
73
74	=item B<-perl>
75
76	Apply Perl-specific heuristics to find the correct PODs. This includes
77	stripping Perl-like extensions, omitting subdirectories that are numeric
78	but do I<not> match the current Perl interpreter's version id, suppressing
79	F<site_perl> as a module hierarchy name etc.
80
81	=item B<-script>
82
83	Search for PODs in the current Perl interpreter's installation
84	B<scriptdir>. This is taken from the local L<Config\|Config> module.
85
86	=item B<-inc>
87
88	Search for PODs in the current Perl interpreter's I<@INC> paths.
89
90	=back
91
92	=head1 AUTHOR
93
94	Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>,
95	heavily borrowing code from Nick Ing-Simmons' PodToHtml.
96
97	=head1 SEE ALSO
98
99	L<Pod::Parser>, L<Pod::Checker>
100
101	=cut
102
103	use strict;
104	#use diagnostics;
105	use Exporter;
106	use File::Find;
107	use Cwd;
108
109	use vars qw(@ISA @EXPORT_OK $VERSION);
110	@ISA = qw(Exporter);
111	@EXPORT_OK = qw(&pod_find &simplify_name);
112
113	# package global variables
114	my $SIMPLIFY_RX;
115
116	# return a hash of the
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"
145	# * remove e.g. 5.00503
146	# * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod)
147	$SIMPLIFY_RX =
148	qr!^(?i:site_perl/\|$Config::Config{archname}/\|\d+\.\d+([_.]?\d+)?/\|pod/(?=.?\.pod$))!o;
149	}
150
151	my %dirs_visited;
152	my %pods;
153	my %names;
154	my $pwd = cwd();
155
156	foreach my $try (@search) {
157	unless($try =~ m:^/:) {
158	# make path absolute
159	$try = join('/',$pwd,$try);
160	}
161	$try =~ s:/\.?(?=/\|$)::; # simplify path
162	my $name;
163	if(-f $try) {
164	if($name = _check_and_extract_name($try, $opts{-verbose})) {
165	_check_for_duplicates($try, $name, \%names, \%pods);
166	}
167	next;
168	}
169	my $root_rx = qr!^\Q$try\E/!;
170	File::Find::find( sub {
171	my $item = $File::Find::name;
172	if(-d) {
173	if($dirs_visited{$item}) {
174	warn "Directory '$item' already seen, skipping.\n"
175	if($opts{-verbose});
176	$File::Find::prune = 1;
177	return;
178	}
179	else {
180	$dirs_visited{$item} = 1;
181	}
182	if($opts{-perl} && /^(\d+\.[\d_]+)$/ && eval "$1" != $]) {
183	$File::Find::prune = 1;
184	warn "Perl $] version mismatch on $_, skipping.\n"
185	if($opts{-verbose});
186	}
187	return;
188	}
189	if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) {
190	_check_for_duplicates($item, $name, \%names, \%pods);
191	}
192	}, $try); # end of File::Find::find
193	}
194	chdir $pwd;
195	%pods;
196	}
197
198	sub _check_for_duplicates {
199	my ($file, $name, $names_ref, $pods_ref) = @_;
200	if($$names_ref{$name}) {
201	warn "Duplicate POD found (shadowing?): $name ($file)\n";
202	warn " Already seen in ",
203	join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n";
204	}
205	else {
206	$$names_ref{$name} = 1;
207	}
208	$$pods_ref{$file} = $name;
209	}
210
211	sub _check_and_extract_name {
212	my ($file, $verbose, $root_rx) = @_;
213
214	# check extension or executable
215	unless($file =~ /\.(pod\|pm\|pl)$/i \|\| (-f $file && -x _ && -T _)) {
216	return undef;
217	}
218
219	# check for one line of POD
220	unless(open(POD,"<$file")) {
221	warn "Error: $file is unreadable: $!\n";
222	return undef;
223	}
224	local $/ = undef;
225	my $pod = <POD>;
226	close(POD);
227	unless($pod =~ /\n=(head\d\|pod\|over\|item)\b/) {
228	warn "No POD in $file, skipping.\n"
229	if($verbose);
230	return;
231	}
232	undef $pod;
233
234	# strip non-significant path components
235	# _TODO_ what happens on e.g. Win32?
236	my $name = $file;
237	if(defined $root_rx) {
238	$name =~ s!$root_rx!!;
239	$name =~ s!$SIMPLIFY_RX!!o if(defined $SIMPLIFY_RX);
240	}
241	else {
242	$name =~ s:^.*/::;
243	}
244	$name =~ s/\.(pod\|pm\|pl)$//i;
245	$name =~ s!/+!::!g;
246	$name;
247	}
248
249	# basic simplification of the POD name:
250	# basename & strip extension
251	sub simplify_name {
252	my ($str) = @_;
253	$str =~ s:^.*/::;
254	$str =~ s:\.p([lm]\|od)$::i;
255	$str;
256	}
257
258	1;
259