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