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