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