[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';

sub usage{
        warn "@_\n" if @_;
    # Make sure exit status is success under VMS, so shell doesn't
    # display error messages left over from startup.
    ($! = 0, $^E = 1) if $^O eq 'VMS';
    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.
    -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

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

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 $^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 ( $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(':', $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 }

unless($Is_VMS) {
	$tmp = "/tmp/perldoc1.$$";
	push @pagers, qw( more less pg view cat );
	unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
} else {
	$tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
	push @pagers, qw( most more less type/page );
}
unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};

if ($opt_m) {
    foreach $pager (@pagers) {
	my($sts) = system("$pager @found");
	exit 0 if ($Is_VMS ? ($sts & 1) : !$sts);
    }
    exit $Is_VMS ? $sts : 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 `$func' found\n";
   }
   exit;
}

foreach (@found) {

	if($opt_t) {
		open(TMP,">>$tmp");
		Pod::Text::pod2text($_,*TMP);
		close(TMP);
	} elsif(not $opt_u) {
		open(TMP,">>$tmp");
		if($^O =~ /hpux/) {
			$rslt = `pod2man $_ | nroff -man | col -x`;
		} else {
			$rslt = `pod2man $_ | nroff -man`;
		}
		if ($Is_VMS) { $err = !($? % 2) || $rslt =~ /IVVERB/; }
		else      { $err = $?; }
		print TMP $rslt unless $err;
		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) {
		$sts = system("$pager $tmp");
		last if $Is_VMS && ($sts & 1);
		last unless $sts;
	}
}

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