[p5sagit/p5-mst-13.2.git] / utils / perldoc.PL

#!/usr/local/bin/perl

use Config;
use File::Basename qw(&basename &dirname);

# List explicitly here the variables you want Configure to
# generate.  Metaconfig only looks for shell variables, so you
# have to mention them as if they were shell variables, not
# %Config entries.  Thus you write
#  $startperl
# to ensure Configure will look for $Config{startperl}.

# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
chdir dirname($0);
$file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';

open OUT,">$file" or die "Can't create $file: $!";

print "Extracting $file (with variable substitutions)\n";

# In this section, perl variables will be expanded during extraction.
# You can use $Config{...} to use Configure variables.

print OUT <<"!GROK!THIS!";
$Config{startperl}
    eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
	if \$running_under_some_shell;

\@pagers = ();
push \@pagers, "$Config{'pager'}" if -x "$Config{'pager'}";
!GROK!THIS!

# In the following, perl variables are not expanded during extraction.

print OUT <<'!NO!SUBS!';

#
# Perldoc revision #1 -- look up a piece of documentation in .pod format that
# is embedded in the perl installation tree.
#
# This is not to be confused with Tom Christianson's perlman, which is a
# man replacement, written in perl. This perldoc is strictly for reading
# the perl manuals, though it too is written in perl.

if(@ARGV<1) {
        $0 =~ s,.*/,,;
	die <<EOF;
Usage: $0 [-h] [-v] [-t] [-u] [-m] [-l] PageName|ModuleName|ProgramName
       $0 -f PerlFunc

We suggest you use "perldoc perldoc" to get aquainted 
with the system.
EOF
}

use Getopt::Std;
use Config '%Config';

$Is_VMS = $^O eq 'VMS';
$Is_MSWin32 = $^O eq 'MSWin32';

sub usage{
    warn "@_\n" if @_;
    # Erase evidence of previous errors (if any), so exit status is simple.
    $! = 0;
    die <<EOF;
perldoc [options] PageName|ModuleName|ProgramName...
perldoc [options] -f BuiltinFunction

Options:
    -h   Display this help message
    -t   Display pod using pod2text instead of pod2man and nroff
             (-t is the default on win32)
    -u	 Display unformatted pod text
    -m   Display modules file in its entirety
    -l   Display the modules file name
    -v	 Verbosely describe what's going on

PageName|ModuleName...
         is the name of a piece of documentation that you want to look at. You 
         may either give a descriptive name of the page (as in the case of
         `perlfunc') the name of a module, either like `Term::Info', 
         `Term/Info', the partial name of a module, like `info', or 
         `makemaker', or the name of a program, like `perldoc'.

BuiltinFunction
         is the name of a perl function.  Will extract documentation from
         `perlfunc'.
         
Any switches in the PERLDOC environment variable will be used before the 
command line arguments.

EOF
}

use Text::ParseWords;


unshift(@ARGV,shellwords($ENV{"PERLDOC"}));

getopts("mhtluvf:") || usage;

usage if $opt_h || $opt_h; # avoid -w warning

if ($opt_t + $opt_u + $opt_m + $opt_l > 1) {
    usage("only one of -t, -u, -m or -l")
} elsif ($Is_MSWin32) {
    $opt_t = 1 unless $opt_t + $opt_u + $opt_m + $opt_l;
}

if ($opt_t) { require Pod::Text; import Pod::Text; }

if ($opt_f) {
   @pages = ("perlfunc");
} else {
   @pages = @ARGV;
}


sub containspod {
	my($file) = @_;
	local($_);
	open(TEST,"<$file");
	while(<TEST>) {
		if(/^=head/) {
			close(TEST);
			return 1;
		}
	}
	close(TEST);
	return 0;
}

 sub minus_f_nocase {
     my($file) = @_;
     local *DIR;
     local($")="/";
     my(@p,$p,$cip);
     $file =~ tr|\\|/| if $Is_MSWin32 or $^O eq 'os2';
     if ( $Is_MSWin32 and $file =~ s|^(//[^/]+)/|| ) {	# UNC path?
         push(@p,$1);
     }
     foreach $p (split(/\//, $file)){
	if (($Is_VMS or $Is_MSWin32 or $^O eq 'os2') and not scalar @p) {
	    # VMSish filesystems don't begin at '/'
	    push(@p,$p);
	    next;
	}
 	if (-d ("@p/$p")){
 	    push @p, $p;
 	} elsif (-f ("@p/$p")) {
 	    return "@p/$p";
 	} else {
 	    my $found=0;
 	    my $lcp = lc $p;
 	    opendir DIR, "@p";
 	    while ($cip=readdir(DIR)) {
		$cip =~ s/\.dir$// if $Is_VMS;
 		if (lc $cip eq $lcp){
 		    $found++;
 		    last;
 		}
 	    }
 	    closedir DIR;
 	    return "" unless $found;
 	    push @p, $cip;
 	    return "@p" if -f "@p";
 	}
     }
     return; # is not a file
 }
 
  sub searchfor {
  	my($recurse,$s,@dirs) = @_;
  	$s =~ s!::!/!g;
  	$s = VMS::Filespec::unixify($s) if $Is_VMS;
	return $s if -f $s && containspod($s);
  	printf STDERR "looking for $s in @dirs\n" if $opt_v;
 	my $ret;
 	my $i;
 	my $dir;
  	for ($i=0;$i<@dirs;$i++) {
  		$dir = $dirs[$i];
  		($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
 	    if ((    $ret = minus_f_nocase "$dir/$s.pod")
 		or ( $ret = minus_f_nocase "$dir/$s.pm"  and containspod($ret))
 		or ( $ret = minus_f_nocase "$dir/$s"     and containspod($ret))
  		or ( $Is_VMS and 
 		     $ret = minus_f_nocase "$dir/$s.com" and containspod($ret))
		or ( $^O eq 'os2' and 
 		     $ret = minus_f_nocase "$dir/$s.cmd" and containspod($ret))
		or ( ($Is_MSWin32 or $^O eq 'os2') and 
 		     $ret = minus_f_nocase "$dir/$s.bat" and containspod($ret))
 		or ( $ret = minus_f_nocase "$dir/pod/$s.pod")
 		or ( $ret = minus_f_nocase "$dir/pod/$s" and containspod($ret)))
 		{ return $ret; }
 		
 		if($recurse) {
			opendir(D,$dir);
			my(@newdirs) = grep(-d,map("$dir/$_",grep(!/^\.\.?$/,readdir(D))));
			closedir(D);
			@newdirs = map((s/.dir$//,$_)[1],@newdirs) if $Is_VMS;
			next unless @newdirs;
			print STDERR "Also looking in @newdirs\n" if $opt_v;
			push(@dirs,@newdirs);
 		}
 	}
  	return ();
  }


foreach (@pages) {
	print STDERR "Searching for $_\n" if $opt_v;
	# We must look both in @INC for library modules and in PATH
	# for executables, like h2xs or perldoc itself.
	@searchdirs = @INC;
	unless ($opt_m) { 
	    if ($Is_VMS) {
		my($i,$trn);
		for ($i = 0; $trn = $ENV{'DCL$PATH'.$i}; $i++) {
		    push(@searchdirs,$trn);
		}
	    } else {
	        push(@searchdirs, grep(-d, split($Config{path_sep}, 
						 $ENV{'PATH'})));
	    }
	    @files= searchfor(0,$_,@searchdirs);
	}
	if( @files ) {
		print STDERR "Found as @files\n" if $opt_v;
	} else {
		# no match, try recursive search
		
		@searchdirs = grep(!/^\.$/,@INC);
		
		
		@files= searchfor(1,$_,@searchdirs);
		if( @files ) {
			print STDERR "Loosely found as @files\n" if $opt_v;
		} else {
			print STDERR "No documentation found for '$_'\n";
		}
	}
	push(@found,@files);
}

if(!@found) {
	exit ($Is_VMS ? 98962 : 1);
}

if ($opt_l) {
    print join("\n", @found), "\n";
    exit;
}

if( ! -t STDOUT ) { $no_tty = 1 }

if ($Is_MSWin32) {
	$tmp = "$ENV{TEMP}\\perldoc1.$$";
	push @pagers, qw( more< less notepad );
	unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
} elsif ($Is_VMS) {
	$tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
	push @pagers, qw( most more less type/page );
} else {
	if ($^O eq 'os2') {
	  require POSIX;
	  $tmp = POSIX::tmpnam();
	} else {
	  $tmp = "/tmp/perldoc1.$$";	  
	}
	push @pagers, qw( more less pg view cat );
	unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
}
unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};

if ($opt_m) {
	foreach $pager (@pagers) {
		system("$pager @found") or exit;
	}
	if ($Is_VMS) { eval 'use vmsish qw(status exit); exit $?' }
	exit 1;
} 

if ($opt_f) {
   my $perlfunc = shift @found;
   open(PFUNC, $perlfunc) or die "Can't open $perlfunc: $!";

   # Skip introduction
   while (<PFUNC>) {
       last if /^=head2 Alphabetical Listing of Perl Functions/;
   }

   # Look for our function
   my $found = 0;
   while (<PFUNC>) {
       if (/^=item\s+\Q$opt_f\E\b/o)  {
	   $found++;
       } elsif (/^=item/) {
	   last if $found;
       }
       push(@pod, $_) if $found;
   }
   if (@pod) {
       if ($opt_t) {
	   open(FORMATTER, "| pod2text") || die "Can't start filter";
	   print FORMATTER "=over 8\n\n";
	   print FORMATTER @pod;
	   print FORMATTER "=back\n";
	   close(FORMATTER);
       } else {
	   print @pod;
       }
   } else {
       die "No documentation for perl function `$opt_f' found\n";
   }
   exit;
}

foreach (@found) {

	if($opt_t) {
		open(TMP,">>$tmp");
		Pod::Text::pod2text($_,*TMP);
		close(TMP);
	} elsif(not $opt_u) {
		my $cmd = "pod2man --lax $_ | nroff -man";
		$cmd .= " | col -x" if $^O =~ /hpux/;
		$rslt = `$cmd`;
		unless(($err = $?)) {
			open(TMP,">>$tmp");
			print TMP $rslt;
			close TMP;
		}
	}
	                                                
	if( $opt_u or $err or -z $tmp) {
		open(OUT,">>$tmp");
		open(IN,"<$_");
		$cut = 1;
		while (<IN>) {
			$cut = $1 eq 'cut' if /^=(\w+)/;
			next if $cut;
			print OUT;
		}
		close(IN);
		close(OUT);
	}
}

if( $no_tty ) {
	open(TMP,"<$tmp");
	print while <TMP>;
	close(TMP);
} else {
	foreach $pager (@pagers) {
		system("$pager $tmp") or last;
	}
}

1 while unlink($tmp); #Possibly pointless VMSism

exit 0;

__END__

=head1 NAME

perldoc - Look up Perl documentation in pod format.

=head1 SYNOPSIS

B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] PageName|ModuleName|ProgramName

B<perldoc> B<-f> BuiltinFunction

=head1 DESCRIPTION

I<perldoc> looks up a piece of documentation in .pod format that is embedded
in the perl installation tree or in a perl script, and displays it via
C<pod2man | nroff -man | $PAGER>. (In addition, if running under HP-UX,
C<col -x> will be used.) This is primarily used for the documentation for
the perl library modules.

Your system may also have man pages installed for those modules, in
which case you can probably just use the man(1) command.

=head1 OPTIONS

=over 5

=item B<-h> help

Prints out a brief help message.

=item B<-v> verbose

Describes search for the item in detail.

=item B<-t> text output

Display docs using plain text converter, instead of nroff. This may be faster,
but it won't look as nice.

=item B<-u> unformatted

Find docs only; skip reformatting by pod2*

=item B<-m> module

Display the entire module: both code and unformatted pod documentation.
This may be useful if the docs don't explain a function in the detail
you need, and you'd like to inspect the code directly; perldoc will find
the file for you and simply hand it off for display.

=item B<-l> file name only

Display the file name of the module found.

=item B<-f> perlfunc

The B<-f> option followed by the name of a perl built in function will
extract the documentation of this function from L<perlfunc>.

=item B<PageName|ModuleName|ProgramName>

The item you want to look up.  Nested modules (such as C<File::Basename>)
are specified either as C<File::Basename> or C<File/Basename>.  You may also
give a descriptive name of a page, such as C<perlfunc>. You make also give a
partial or wrong-case name, such as "basename" for "File::Basename", but
this will be slower, if there is more then one page with the same partial
name, you will only get the first one.

=back

=head1 ENVIRONMENT

Any switches in the C<PERLDOC> environment variable will be used before the 
command line arguments.  C<perldoc> also searches directories
specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
defined) and C<PATH> environment variables.
(The latter is so that embedded pods for executables, such as
C<perldoc> itself, are available.)

=head1 AUTHOR

Kenneth Albanowski <kjahds@kjahds.com>

Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>

=cut

#
# Version 1.12: Sat Apr 12 22:41:09 EST 1997
#       Gurusamy Sarathy <gsar@umich.edu>
#	-various fixes for win32
# Version 1.11: Tue Dec 26 09:54:33 EST 1995
#       Kenneth Albanowski <kjahds@kjahds.com>
#   -added Charles Bailey's further VMS patches, and -u switch
#   -added -t switch, with pod2text support
# 
# Version 1.10: Thu Nov  9 07:23:47 EST 1995
#		Kenneth Albanowski <kjahds@kjahds.com>
#	-added VMS support
#	-added better error recognition (on no found pages, just exit. On
#	 missing nroff/pod2man, just display raw pod.)
#	-added recursive/case-insensitive matching (thanks, Andreas). This
#	 slows things down a bit, unfortunately. Give a precise name, and
#	 it'll run faster.
#
# Version 1.01:	Tue May 30 14:47:34 EDT 1995
#		Andy Dougherty  <doughera@lafcol.lafayette.edu>
#   -added pod documentation.
#   -added PATH searching.
#   -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
#    and friends.
#
#
# TODO:
#
#	Cache directories read during sloppy match
!NO!SUBS!

close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
Commit	Line	Data
4633a7c4	1	#!/usr/local/bin/perl
	2
	3	use Config;
	4	use File::Basename qw(&basename &dirname);
	5
85880f03	6	# List explicitly here the variables you want Configure to
	7	# generate. Metaconfig only looks for shell variables, so you
	8	# have to mention them as if they were shell variables, not
	9	# %Config entries. Thus you write
4633a7c4	10	# $startperl
85880f03	11	# to ensure Configure will look for $Config{startperl}.
4633a7c4	12
	13	# This forces PL files to create target in same directory as PL file.
	14	# This is so that make depend always knows where to find PL derivatives.
44a8e56a	15	chdir dirname($0);
44a8e56a	16	$file = basename($0, '.PL');
774d564b	17	$file .= '.com' if $^O eq 'VMS';
4633a7c4	18
	19	open OUT,">$file" or die "Can't create $file: $!";
	20
	21	print "Extracting $file (with variable substitutions)\n";
	22
	23	# In this section, perl variables will be expanded during extraction.
	24	# You can use $Config{...} to use Configure variables.
	25
85880f03	26	print OUT <<"!GROK!THIS!";
5f05dabc	27	$Config{startperl}
	28	eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
	29	if \$running_under_some_shell;
55497cff	30
	31	\@pagers = ();
	32	push \@pagers, "$Config{'pager'}" if -x "$Config{'pager'}";
4633a7c4	33	!GROK!THIS!
	34
	35	# In the following, perl variables are not expanded during extraction.
	36
	37	print OUT <<'!NO!SUBS!';
	38
	39	#
	40	# Perldoc revision #1 -- look up a piece of documentation in .pod format that
	41	# is embedded in the perl installation tree.
	42	#
	43	# This is not to be confused with Tom Christianson's perlman, which is a
	44	# man replacement, written in perl. This perldoc is strictly for reading
	45	# the perl manuals, though it too is written in perl.
4633a7c4	46
4633a7c4	47	if(@ARGV<1) {
31bdbec1	48	$0 =~ s,.*/,,;
4633a7c4	49	die <<EOF;
44a8e56a	50	Usage: $0 [-h] [-v] [-t] [-u] [-m] [-l] PageName\|ModuleName\|ProgramName
31bdbec1	51	$0 -f PerlFunc
4633a7c4	52
	53	We suggest you use "perldoc perldoc" to get aquainted
	54	with the system.
	55	EOF
	56	}
	57
	58	use Getopt::Std;
59586d77	59	use Config '%Config';
59586d77	60
7eda7aea	61	$Is_VMS = $^O eq 'VMS';
137443ea	62	$Is_MSWin32 = $^O eq 'MSWin32';
4633a7c4	63
4633a7c4	64	sub usage{
ff0cee69	65	warn "@_\n" if @_;
	66	# Erase evidence of previous errors (if any), so exit status is simple.
	67	$! = 0;
4633a7c4	68	die <<EOF;
31bdbec1	69	perldoc [options] PageName\|ModuleName\|ProgramName...
	70	perldoc [options] -f BuiltinFunction
	71
	72	Options:
137443ea	73	-h Display this help message
	74	-t Display pod using pod2text instead of pod2man and nroff
	75	(-t is the default on win32)
85880f03	76	-u Display unformatted pod text
7eda7aea	77	-m Display modules file in its entirety
44a8e56a	78	-l Display the modules file name
137443ea	79	-v Verbosely describe what's going on
31bdbec1	80
4633a7c4	81	PageName\|ModuleName...
	82	is the name of a piece of documentation that you want to look at. You
	83	may either give a descriptive name of the page (as in the case of
	84	`perlfunc') the name of a module, either like `Term::Info',
	85	`Term/Info', the partial name of a module, like `info', or
	86	`makemaker', or the name of a program, like `perldoc'.
31bdbec1	87
	88	BuiltinFunction
	89	is the name of a perl function. Will extract documentation from
	90	`perlfunc'.
4633a7c4	91
	92	Any switches in the PERLDOC environment variable will be used before the
	93	command line arguments.
	94
	95	EOF
	96	}
	97
	98	use Text::ParseWords;
	99
	100
	101	unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
	102
31bdbec1	103	getopts("mhtluvf:") \|\| usage;
85880f03	104
85880f03	105	usage if $opt_h \|\| $opt_h; # avoid -w warning
4633a7c4	106
137443ea	107	if ($opt_t + $opt_u + $opt_m + $opt_l > 1) {
	108	usage("only one of -t, -u, -m or -l")
	109	} elsif ($Is_MSWin32) {
	110	$opt_t = 1 unless $opt_t + $opt_u + $opt_m + $opt_l;
	111	}
4633a7c4	112
7eda7aea	113	if ($opt_t) { require Pod::Text; import Pod::Text; }
4633a7c4	114
31bdbec1	115	if ($opt_f) {
	116	@pages = ("perlfunc");
	117	} else {
	118	@pages = @ARGV;
	119	}
	120
	121
85880f03	122
4633a7c4	123	sub containspod {
	124	my($file) = @_;
	125	local($_);
	126	open(TEST,"<$file");
	127	while(<TEST>) {
	128	if(/^=head/) {
	129	close(TEST);
	130	return 1;
	131	}
	132	}
	133	close(TEST);
	134	return 0;
	135	}
	136
	137	sub minus_f_nocase {
	138	my($file) = @_;
	139	local *DIR;
	140	local($")="/";
	141	my(@p,$p,$cip);
f72119fc	142	$file =~ tr\|\\\|/\| if $Is_MSWin32 or $^O eq 'os2';
	143	if ( $Is_MSWin32 and $file =~ s\|^(//[^/]+)/\|\| ) { # UNC path?
	144	push(@p,$1);
	145	}
4633a7c4	146	foreach $p (split(/\//, $file)){
137443ea	147	if (($Is_VMS or $Is_MSWin32 or $^O eq 'os2') and not scalar @p) {
9c9e9fb7	148	# VMSish filesystems don't begin at '/'
85880f03	149	push(@p,$p);
	150	next;
	151	}
4633a7c4	152	if (-d ("@p/$p")){
	153	push @p, $p;
	154	} elsif (-f ("@p/$p")) {
	155	return "@p/$p";
	156	} else {
	157	my $found=0;
	158	my $lcp = lc $p;
	159	opendir DIR, "@p";
	160	while ($cip=readdir(DIR)) {
85880f03	161	$cip =~ s/\.dir$// if $Is_VMS;
4633a7c4	162	if (lc $cip eq $lcp){
	163	$found++;
	164	last;
	165	}
	166	}
	167	closedir DIR;
	168	return "" unless $found;
	169	push @p, $cip;
	170	return "@p" if -f "@p";
	171	}
	172	}
	173	return; # is not a file
	174	}
	175
	176	sub searchfor {
	177	my($recurse,$s,@dirs) = @_;
	178	$s =~ s!::!/!g;
85880f03	179	$s = VMS::Filespec::unixify($s) if $Is_VMS;
44a8e56a	180	return $s if -f $s && containspod($s);
4633a7c4	181	printf STDERR "looking for $s in @dirs\n" if $opt_v;
	182	my $ret;
	183	my $i;
	184	my $dir;
	185	for ($i=0;$i<@dirs;$i++) {
	186	$dir = $dirs[$i];
85880f03	187	($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
4633a7c4	188	if (( $ret = minus_f_nocase "$dir/$s.pod")
	189	or ( $ret = minus_f_nocase "$dir/$s.pm" and containspod($ret))
	190	or ( $ret = minus_f_nocase "$dir/$s" and containspod($ret))
137443ea	191	or ( $Is_VMS and
85880f03	192	$ret = minus_f_nocase "$dir/$s.com" and containspod($ret))
59586d77	193	or ( $^O eq 'os2' and
	194	$ret = minus_f_nocase "$dir/$s.cmd" and containspod($ret))
	195	or ( ($Is_MSWin32 or $^O eq 'os2') and
137443ea	196	$ret = minus_f_nocase "$dir/$s.bat" and containspod($ret))
4633a7c4	197	or ( $ret = minus_f_nocase "$dir/pod/$s.pod")
	198	or ( $ret = minus_f_nocase "$dir/pod/$s" and containspod($ret)))
	199	{ return $ret; }
	200
	201	if($recurse) {
	202	opendir(D,$dir);
	203	my(@newdirs) = grep(-d,map("$dir/$_",grep(!/^\.\.?$/,readdir(D))));
	204	closedir(D);
85880f03	205	@newdirs = map((s/.dir$//,$_)[1],@newdirs) if $Is_VMS;
7eda7aea	206	next unless @newdirs;
4633a7c4	207	print STDERR "Also looking in @newdirs\n" if $opt_v;
	208	push(@dirs,@newdirs);
	209	}
	210	}
	211	return ();
	212	}
	213
	214
	215	foreach (@pages) {
	216	print STDERR "Searching for $_\n" if $opt_v;
	217	# We must look both in @INC for library modules and in PATH
	218	# for executables, like h2xs or perldoc itself.
	219	@searchdirs = @INC;
7eda7aea	220	unless ($opt_m) {
	221	if ($Is_VMS) {
	222	my($i,$trn);
	223	for ($i = 0; $trn = $ENV{'DCL$PATH'.$i}; $i++) {
	224	push(@searchdirs,$trn);
	225	}
	226	} else {
59586d77	227	push(@searchdirs, grep(-d, split($Config{path_sep},
59586d77	228	$ENV{'PATH'})));
7eda7aea	229	}
7eda7aea	230	@files= searchfor(0,$_,@searchdirs);
85880f03	231	}
4633a7c4	232	if( @files ) {
	233	print STDERR "Found as @files\n" if $opt_v;
	234	} else {
	235	# no match, try recursive search
	236
	237	@searchdirs = grep(!/^\.$/,@INC);
	238
	239
	240	@files= searchfor(1,$_,@searchdirs);
	241	if( @files ) {
85880f03	242	print STDERR "Loosely found as @files\n" if $opt_v;
4633a7c4	243	} else {
	244	print STDERR "No documentation found for '$_'\n";
	245	}
	246	}
	247	push(@found,@files);
	248	}
	249
	250	if(!@found) {
85880f03	251	exit ($Is_VMS ? 98962 : 1);
4633a7c4	252	}
4633a7c4	253
44a8e56a	254	if ($opt_l) {
	255	print join("\n", @found), "\n";
	256	exit;
	257	}
	258
31bdbec1	259	if( ! -t STDOUT ) { $no_tty = 1 }
4633a7c4	260
137443ea	261	if ($Is_MSWin32) {
	262	$tmp = "$ENV{TEMP}\\perldoc1.$$";
	263	push @pagers, qw( more< less notepad );
55497cff	264	unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
137443ea	265	} elsif ($Is_VMS) {
4633a7c4	266	$tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
55497cff	267	push @pagers, qw( most more less type/page );
137443ea	268	} else {
59586d77	269	if ($^O eq 'os2') {
	270	require POSIX;
	271	$tmp = POSIX::tmpnam();
	272	} else {
	273	$tmp = "/tmp/perldoc1.$$";
	274	}
137443ea	275	push @pagers, qw( more less pg view cat );
137443ea	276	unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
4633a7c4	277	}
44a8e56a	278	unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
4633a7c4	279
7eda7aea	280	if ($opt_m) {
1e422769	281	foreach $pager (@pagers) {
	282	system("$pager @found") or exit;
	283	}
	284	if ($Is_VMS) { eval 'use vmsish qw(status exit); exit $?' }
	285	exit 1;
7eda7aea	286	}
7eda7aea	287
31bdbec1	288	if ($opt_f) {
	289	my $perlfunc = shift @found;
	290	open(PFUNC, $perlfunc) or die "Can't open $perlfunc: $!";
	291
	292	# Skip introduction
	293	while (<PFUNC>) {
	294	last if /^=head2 Alphabetical Listing of Perl Functions/;
	295	}
	296
	297	# Look for our function
	298	my $found = 0;
	299	while (<PFUNC>) {
	300	if (/^=item\s+\Q$opt_f\E\b/o) {
	301	$found++;
	302	} elsif (/^=item/) {
	303	last if $found;
	304	}
	305	push(@pod, $_) if $found;
	306	}
	307	if (@pod) {
	308	if ($opt_t) {
	309	open(FORMATTER, "\| pod2text") \|\| die "Can't start filter";
	310	print FORMATTER "=over 8\n\n";
	311	print FORMATTER @pod;
	312	print FORMATTER "=back\n";
	313	close(FORMATTER);
	314	} else {
	315	print @pod;
	316	}
	317	} else {
ed5c9e50	318	die "No documentation for perl function `$opt_f' found\n";
31bdbec1	319	}
	320	exit;
	321	}
	322
4633a7c4	323	foreach (@found) {
7eda7aea	324
85880f03	325	if($opt_t) {
	326	open(TMP,">>$tmp");
	327	Pod::Text::pod2text($_,*TMP);
	328	close(TMP);
	329	} elsif(not $opt_u) {
1e422769	330	my $cmd = "pod2man --lax $_ \| nroff -man";
	331	$cmd .= " \| col -x" if $^O =~ /hpux/;
	332	$rslt = `$cmd`;
	333	unless(($err = $?)) {
	334	open(TMP,">>$tmp");
	335	print TMP $rslt;
	336	close TMP;
40fc7247	337	}
85880f03	338	}
4633a7c4	339
85880f03	340	if( $opt_u or $err or -z $tmp) {
4633a7c4	341	open(OUT,">>$tmp");
4633a7c4	342	open(IN,"<$_");
85880f03	343	$cut = 1;
	344	while (<IN>) {
	345	$cut = $1 eq 'cut' if /^=(\w+)/;
	346	next if $cut;
	347	print OUT;
	348	}
4633a7c4	349	close(IN);
	350	close(OUT);
	351	}
	352	}
	353
31bdbec1	354	if( $no_tty ) {
4633a7c4	355	open(TMP,"<$tmp");
	356	print while <TMP>;
	357	close(TMP);
	358	} else {
85880f03	359	foreach $pager (@pagers) {
1e422769	360	system("$pager $tmp") or last;
4633a7c4	361	}
	362	}
	363
	364	1 while unlink($tmp); #Possibly pointless VMSism
	365
	366	exit 0;
7eda7aea	367
	368	__END__
	369
	370	=head1 NAME
	371
	372	perldoc - Look up Perl documentation in pod format.
	373
	374	=head1 SYNOPSIS
	375
44a8e56a	376	B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] PageName\|ModuleName\|ProgramName
7eda7aea	377
31bdbec1	378	B<perldoc> B<-f> BuiltinFunction
31bdbec1	379
7eda7aea	380	=head1 DESCRIPTION
7eda7aea	381
40fc7247	382	I<perldoc> looks up a piece of documentation in .pod format that is embedded
	383	in the perl installation tree or in a perl script, and displays it via
	384	C<pod2man \| nroff -man \| $PAGER>. (In addition, if running under HP-UX,
	385	C<col -x> will be used.) This is primarily used for the documentation for
	386	the perl library modules.
7eda7aea	387
	388	Your system may also have man pages installed for those modules, in
	389	which case you can probably just use the man(1) command.
	390
	391	=head1 OPTIONS
	392
	393	=over 5
	394
	395	=item B<-h> help
	396
	397	Prints out a brief help message.
	398
	399	=item B<-v> verbose
	400
	401	Describes search for the item in detail.
	402
	403	=item B<-t> text output
	404
	405	Display docs using plain text converter, instead of nroff. This may be faster,
	406	but it won't look as nice.
	407
	408	=item B<-u> unformatted
	409
	410	Find docs only; skip reformatting by pod2*
	411
	412	=item B<-m> module
	413
	414	Display the entire module: both code and unformatted pod documentation.
	415	This may be useful if the docs don't explain a function in the detail
	416	you need, and you'd like to inspect the code directly; perldoc will find
	417	the file for you and simply hand it off for display.
	418
44a8e56a	419	=item B<-l> file name only
	420
	421	Display the file name of the module found.
	422
31bdbec1	423	=item B<-f> perlfunc
	424
	425	The B<-f> option followed by the name of a perl built in function will
	426	extract the documentation of this function from L<perlfunc>.
	427
7eda7aea	428	=item B<PageName\|ModuleName\|ProgramName>
	429
	430	The item you want to look up. Nested modules (such as C<File::Basename>)
	431	are specified either as C<File::Basename> or C<File/Basename>. You may also
	432	give a descriptive name of a page, such as C<perlfunc>. You make also give a
	433	partial or wrong-case name, such as "basename" for "File::Basename", but
	434	this will be slower, if there is more then one page with the same partial
	435	name, you will only get the first one.
	436
	437	=back
	438
	439	=head1 ENVIRONMENT
	440
	441	Any switches in the C<PERLDOC> environment variable will be used before the
	442	command line arguments. C<perldoc> also searches directories
	443	specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
	444	defined) and C<PATH> environment variables.
	445	(The latter is so that embedded pods for executables, such as
	446	C<perldoc> itself, are available.)
	447
	448	=head1 AUTHOR
	449
	450	Kenneth Albanowski <kjahds@kjahds.com>
	451
	452	Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>
	453
7eda7aea	454	=cut
	455
	456	#
137443ea	457	# Version 1.12: Sat Apr 12 22:41:09 EST 1997
	458	# Gurusamy Sarathy <gsar@umich.edu>
	459	# -various fixes for win32
7eda7aea	460	# Version 1.11: Tue Dec 26 09:54:33 EST 1995
	461	# Kenneth Albanowski <kjahds@kjahds.com>
	462	# -added Charles Bailey's further VMS patches, and -u switch
	463	# -added -t switch, with pod2text support
	464	#
	465	# Version 1.10: Thu Nov 9 07:23:47 EST 1995
	466	# Kenneth Albanowski <kjahds@kjahds.com>
	467	# -added VMS support
	468	# -added better error recognition (on no found pages, just exit. On
	469	# missing nroff/pod2man, just display raw pod.)
	470	# -added recursive/case-insensitive matching (thanks, Andreas). This
	471	# slows things down a bit, unfortunately. Give a precise name, and
	472	# it'll run faster.
	473	#
	474	# Version 1.01: Tue May 30 14:47:34 EDT 1995
	475	# Andy Dougherty <doughera@lafcol.lafayette.edu>
	476	# -added pod documentation.
	477	# -added PATH searching.
	478	# -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
	479	# and friends.
	480	#
	481	#
	482	# TODO:
	483	#
	484	# Cache directories read during sloppy match
4633a7c4	485	!NO!SUBS!
	486
	487	close OUT or die "Can't close $file: $!";
	488	chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
	489	exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';