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