[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)) =~ s/\.PL$//;
$file =~ s/\.pl$//
	if ($Config{'osname'} eq 'VMS' or
	    $Config{'osname'} eq 'OS2');  # "case-forgiving"

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 perl -S \$0 "\$@"'
	if 0;
!GROK!THIS!

# In the following, perl variables are not expanded during extraction.

print OUT <<'!NO!SUBS!';
    eval 'exec perl -S $0 "$@"'
	if 0;

#
# 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.
#
# 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
#

=head1 NAME

perldoc - Look up Perl documentation in pod format.

=head1 SYNOPSIS

B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] PageName|ModuleName|ProgramName

=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 pod2man | nroff -man | $PAGER.  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<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>

=head1 SEE ALSO

=head1 DIAGNOSTICS

=cut

if(@ARGV<1) {
	die <<EOF;
Usage: $0 [-h] [-v] [-t] [-u] PageName|ModuleName|ProgramName

We suggest you use "perldoc perldoc" to get aquainted 
with the system.
EOF
}

use Getopt::Std;
use Config;
$Is_VMS = $Config{'osname'} eq 'VMS';

sub usage{
        warn "@_\n" if @_;
    die <<EOF;
perldoc [-h] [-v] [-u] PageName|ModuleName|ProgramName...
    -h   Display this help message.
    -t   Display pod using pod2text instead of pod2man and nroff.
    -u	 Display unformatted pod text
    -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'.
         
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("htuv") || usage;

usage if $opt_h || $opt_h; # avoid -w warning

eval "use Pod::Text" if $opt_t;

@pages = @ARGV;

# VMS only -- use this hack until support for searchlist
# logical names is better integrated into the Perl core
sub translate_searchlist_logical {
	my($lnm) = @_;
	my($trans,@trans);
	return unless $ENV{$lnm};
	$trans = `show logical $lnm`;
	$trans =~ s/\n1(.|\n)*//;  # clip off iterative translations
	@trans = split(/[\"=\s\n]+/,$trans); # break into words
	splice(@trans,0,2); # pop off initial blank and orig name
	@trans = grep(!/^\(/,@trans); # filter out table names
	wantarray ? @trans : $trans[0];
}

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 and not scalar @p) {
	    # VMS 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;
  	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;
			last 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;
	if ($Is_VMS) {
		push(@searchdirs, translate_searchlist_logical('DCL$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( ! -t STDOUT ) { $opt_f = 1 }

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

foreach (@found) {
	
	if($opt_t) {
		open(TMP,">>$tmp");
		Pod::Text::pod2text($_,*TMP);
		close(TMP);
	} elsif(not $opt_u) {
		open(TMP,">>$tmp");
		$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( $opt_f ) {
	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;
!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.
	15	chdir(dirname($0));
	16	($file = basename($0)) =~ s/\.PL$//;
	17	$file =~ s/\.pl$//
	18	if ($Config{'osname'} eq 'VMS' or
	19	$Config{'osname'} eq 'OS2'); # "case-forgiving"
	20
	21	open OUT,">$file" or die "Can't create $file: $!";
	22
	23	print "Extracting $file (with variable substitutions)\n";
	24
	25	# In this section, perl variables will be expanded during extraction.
	26	# You can use $Config{...} to use Configure variables.
	27
85880f03	28	print OUT <<"!GROK!THIS!";
4633a7c4 LW	29	$Config{'startperl'}
	30	eval 'exec perl -S \$0 "\$@"'
	31	if 0;
	32	!GROK!THIS!
	33
	34	# In the following, perl variables are not expanded during extraction.
	35
	36	print OUT <<'!NO!SUBS!';
85880f03	37	eval 'exec perl -S $0 "$@"'
85880f03	38	if 0;
4633a7c4 LW	39
	40	#
	41	# Perldoc revision #1 -- look up a piece of documentation in .pod format that
	42	# is embedded in the perl installation tree.
	43	#
	44	# This is not to be confused with Tom Christianson's perlman, which is a
	45	# man replacement, written in perl. This perldoc is strictly for reading
	46	# the perl manuals, though it too is written in perl.
	47	#
85880f03	48	# Version 1.11: Tue Dec 26 09:54:33 EST 1995
	49	# Kenneth Albanowski <kjahds@kjahds.com>
	50	# -added Charles Bailey's further VMS patches, and -u switch
	51	# -added -t switch, with pod2text support
	52	#
	53	# Version 1.10: Thu Nov 9 07:23:47 EST 1995
4633a7c4 LW	54	# Kenneth Albanowski <kjahds@kjahds.com>
	55	# -added VMS support
	56	# -added better error recognition (on no found pages, just exit. On
	57	# missing nroff/pod2man, just display raw pod.)
	58	# -added recursive/case-insensitive matching (thanks, Andreas). This
	59	# slows things down a bit, unfortunately. Give a precise name, and
	60	# it'll run faster.
	61	#
	62	# Version 1.01: Tue May 30 14:47:34 EDT 1995
	63	# Andy Dougherty <doughera@lafcol.lafayette.edu>
	64	# -added pod documentation.
	65	# -added PATH searching.
	66	# -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
	67	# and friends.
	68	#
	69	#
	70	# TODO:
	71	#
	72	# Cache directories read during sloppy match
	73	#
	74
	75	=head1 NAME
	76
	77	perldoc - Look up Perl documentation in pod format.
	78
	79	=head1 SYNOPSIS
	80
85880f03	81	B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] PageName\|ModuleName\|ProgramName
4633a7c4 LW	82
	83	=head1 DESCRIPTION
	84
	85	I<perldoc> looks up a piece of documentation in .pod format that is
	86	embedded in the perl installation tree or in a perl script, and displays
	87	it via pod2man \| nroff -man \| $PAGER. This is primarily used for the
	88	documentation for the perl library modules.
	89
	90	Your system may also have man pages installed for those modules, in
	91	which case you can probably just use the man(1) command.
	92
	93	=head1 OPTIONS
	94
	95	=over 5
	96
	97	=item B<-h> help
	98
	99	Prints out a brief help message.
	100
	101	=item B<-v> verbose
	102
	103	Describes search for the item in detail.
	104
85880f03	105	=item B<-t> text output
	106
	107	Display docs using plain text converter, instead of nroff. This may be faster,
	108	but it won't look as nice.
	109
	110	=item B<-u> unformatted
	111
	112	Find docs only; skip reformatting by pod2*
	113
4633a7c4 LW	114	=item B<PageName\|ModuleName\|ProgramName>
	115
	116	The item you want to look up. Nested modules (such as C<File::Basename>)
	117	are specified either as C<File::Basename> or C<File/Basename>. You may also
	118	give a descriptive name of a page, such as C<perlfunc>. You make also give a
	119	partial or wrong-case name, such as "basename" for "File::Basename", but
	120	this will be slower, if there is more then one page with the same partial
	121	name, you will only get the first one.
	122
	123	=back
	124
	125	=head1 ENVIRONMENT
	126
	127	Any switches in the C<PERLDOC> environment variable will be used before the
	128	command line arguments. C<perldoc> also searches directories
	129	specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
	130	defined) and C<PATH> environment variables.
	131	(The latter is so that embedded pods for executables, such as
	132	C<perldoc> itself, are available.)
	133
	134	=head1 AUTHOR
	135
	136	Kenneth Albanowski <kjahds@kjahds.com>
	137
	138	Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>
	139
	140	=head1 SEE ALSO
	141
	142	=head1 DIAGNOSTICS
	143
	144	=cut
	145
	146	if(@ARGV<1) {
	147	die <<EOF;
85880f03	148	Usage: $0 [-h] [-v] [-t] [-u] PageName\|ModuleName\|ProgramName
4633a7c4 LW	149
	150	We suggest you use "perldoc perldoc" to get aquainted
	151	with the system.
	152	EOF
	153	}
	154
	155	use Getopt::Std;
85880f03	156	use Config;
85880f03	157	$Is_VMS = $Config{'osname'} eq 'VMS';
4633a7c4 LW	158
	159	sub usage{
	160	warn "@_\n" if @_;
	161	die <<EOF;
85880f03	162	perldoc [-h] [-v] [-u] PageName\|ModuleName\|ProgramName...
4633a7c4	163	-h Display this help message.
85880f03	164	-t Display pod using pod2text instead of pod2man and nroff.
85880f03	165	-u Display unformatted pod text
4633a7c4 LW	166	-v Verbosely describe what's going on.
	167	PageName\|ModuleName...
	168	is the name of a piece of documentation that you want to look at. You
	169	may either give a descriptive name of the page (as in the case of
	170	`perlfunc') the name of a module, either like `Term::Info',
	171	`Term/Info', the partial name of a module, like `info', or
	172	`makemaker', or the name of a program, like `perldoc'.
	173
	174	Any switches in the PERLDOC environment variable will be used before the
	175	command line arguments.
	176
	177	EOF
	178	}
	179
	180	use Text::ParseWords;
	181
	182
	183	unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
	184
85880f03	185	getopts("htuv") \|\| usage;
	186
	187	usage if $opt_h \|\| $opt_h; # avoid -w warning
4633a7c4	188
85880f03	189	eval "use Pod::Text" if $opt_t;
4633a7c4	190
4633a7c4 LW	191	@pages = @ARGV;
4633a7c4 LW	192
85880f03	193	# VMS only -- use this hack until support for searchlist
	194	# logical names is better integrated into the Perl core
	195	sub translate_searchlist_logical {
	196	my($lnm) = @_;
	197	my($trans,@trans);
	198	return unless $ENV{$lnm};
	199	$trans = `show logical $lnm`;
	200	$trans =~ s/\n1(.\|\n)*//; # clip off iterative translations
	201	@trans = split(/[\"=\s\n]+/,$trans); # break into words
	202	splice(@trans,0,2); # pop off initial blank and orig name
	203	@trans = grep(!/^\(/,@trans); # filter out table names
	204	wantarray ? @trans : $trans[0];
	205	}
	206
4633a7c4 LW	207	sub containspod {
	208	my($file) = @_;
	209	local($_);
	210	open(TEST,"<$file");
	211	while(<TEST>) {
	212	if(/^=head/) {
	213	close(TEST);
	214	return 1;
	215	}
	216	}
	217	close(TEST);
	218	return 0;
	219	}
	220
	221	sub minus_f_nocase {
	222	my($file) = @_;
	223	local *DIR;
	224	local($")="/";
	225	my(@p,$p,$cip);
	226	foreach $p (split(/\//, $file)){
85880f03	227	if ($Is_VMS and not scalar @p) {
	228	# VMS filesystems don't begin at '/'
	229	push(@p,$p);
	230	next;
	231	}
4633a7c4 LW	232	if (-d ("@p/$p")){
	233	push @p, $p;
	234	} elsif (-f ("@p/$p")) {
	235	return "@p/$p";
	236	} else {
	237	my $found=0;
	238	my $lcp = lc $p;
	239	opendir DIR, "@p";
	240	while ($cip=readdir(DIR)) {
85880f03	241	$cip =~ s/\.dir$// if $Is_VMS;
4633a7c4 LW	242	if (lc $cip eq $lcp){
	243	$found++;
	244	last;
	245	}
	246	}
	247	closedir DIR;
	248	return "" unless $found;
	249	push @p, $cip;
	250	return "@p" if -f "@p";
	251	}
	252	}
	253	return; # is not a file
	254	}
	255
	256	sub searchfor {
	257	my($recurse,$s,@dirs) = @_;
	258	$s =~ s!::!/!g;
85880f03	259	$s = VMS::Filespec::unixify($s) if $Is_VMS;
4633a7c4 LW	260	printf STDERR "looking for $s in @dirs\n" if $opt_v;
	261	my $ret;
	262	my $i;
	263	my $dir;
	264	for ($i=0;$i<@dirs;$i++) {
	265	$dir = $dirs[$i];
85880f03	266	($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
4633a7c4 LW	267	if (( $ret = minus_f_nocase "$dir/$s.pod")
	268	or ( $ret = minus_f_nocase "$dir/$s.pm" and containspod($ret))
	269	or ( $ret = minus_f_nocase "$dir/$s" and containspod($ret))
85880f03	270	or ( $Is_VMS and
85880f03	271	$ret = minus_f_nocase "$dir/$s.com" and containspod($ret))
4633a7c4 LW	272	or ( $ret = minus_f_nocase "$dir/pod/$s.pod")
	273	or ( $ret = minus_f_nocase "$dir/pod/$s" and containspod($ret)))
	274	{ return $ret; }
	275
	276	if($recurse) {
	277	opendir(D,$dir);
	278	my(@newdirs) = grep(-d,map("$dir/$_",grep(!/^\.\.?$/,readdir(D))));
	279	closedir(D);
85880f03	280	@newdirs = map((s/.dir$//,$_)[1],@newdirs) if $Is_VMS;
85880f03	281	last unless @newdirs;
4633a7c4 LW	282	print STDERR "Also looking in @newdirs\n" if $opt_v;
	283	push(@dirs,@newdirs);
	284	}
	285	}
	286	return ();
	287	}
	288
	289
	290	foreach (@pages) {
	291	print STDERR "Searching for $_\n" if $opt_v;
	292	# We must look both in @INC for library modules and in PATH
	293	# for executables, like h2xs or perldoc itself.
	294	@searchdirs = @INC;
85880f03	295	if ($Is_VMS) {
	296	push(@searchdirs, translate_searchlist_logical('DCL$PATH'));
	297	} else {
	298	push(@searchdirs, grep(-d, split(':', $ENV{'PATH'})));
	299	}
4633a7c4 LW	300	@files= searchfor(0,$_,@searchdirs);
	301	if( @files ) {
	302	print STDERR "Found as @files\n" if $opt_v;
	303	} else {
	304	# no match, try recursive search
	305
	306	@searchdirs = grep(!/^\.$/,@INC);
	307
	308
	309	@files= searchfor(1,$_,@searchdirs);
	310	if( @files ) {
85880f03	311	print STDERR "Loosely found as @files\n" if $opt_v;
4633a7c4 LW	312	} else {
	313	print STDERR "No documentation found for '$_'\n";
	314	}
	315	}
	316	push(@found,@files);
	317	}
	318
	319	if(!@found) {
85880f03	320	exit ($Is_VMS ? 98962 : 1);
4633a7c4 LW	321	}
4633a7c4 LW	322
4633a7c4 LW	323	if( ! -t STDOUT ) { $opt_f = 1 }
4633a7c4 LW	324
85880f03	325	unless($Is_VMS) {
4633a7c4	326	$tmp = "/tmp/perldoc1.$$";
4633a7c4	327	$goodresult = 0;
85880f03	328	@pagers = qw( more less pg view cat );
85880f03	329	unshift(@pagers,$ENV{PAGER}) if $ENV{PAGER};
4633a7c4 LW	330	} else {
4633a7c4 LW	331	$tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
85880f03	332	@pagers = qw( most more less type/page );
85880f03	333	unshift(@pagers,$ENV{PERLDOC_PAGER}) if $ENV{PERLDOC_PAGER};
4633a7c4 LW	334	$goodresult = 1;
	335	}
	336
	337	foreach (@found) {
	338
85880f03	339	if($opt_t) {
	340	open(TMP,">>$tmp");
	341	Pod::Text::pod2text($_,*TMP);
	342	close(TMP);
	343	} elsif(not $opt_u) {
	344	open(TMP,">>$tmp");
	345	$rslt = `pod2man $_ \| nroff -man`;
	346	if ($Is_VMS) { $err = !($? % 2) \|\| $rslt =~ /IVVERB/; }
	347	else { $err = $?; }
	348	print TMP $rslt unless $err;
	349	close TMP;
	350	}
4633a7c4	351
85880f03	352	if( $opt_u or $err or -z $tmp) {
4633a7c4 LW	353	open(OUT,">>$tmp");
4633a7c4 LW	354	open(IN,"<$_");
85880f03	355	$cut = 1;
	356	while (<IN>) {
	357	$cut = $1 eq 'cut' if /^=(\w+)/;
	358	next if $cut;
	359	print OUT;
	360	}
4633a7c4 LW	361	close(IN);
	362	close(OUT);
	363	}
	364	}
	365
	366	if( $opt_f ) {
	367	open(TMP,"<$tmp");
	368	print while <TMP>;
	369	close(TMP);
	370	} else {
85880f03	371	foreach $pager (@pagers) {
	372	$sts = system("$pager $tmp");
	373	last if $Is_VMS && ($sts & 1);
	374	last unless $sts;
4633a7c4 LW	375	}
	376	}
	377
	378	1 while unlink($tmp); #Possibly pointless VMSism
	379
	380	exit 0;
	381	!NO!SUBS!
	382
	383	close OUT or die "Can't close $file: $!";
	384	chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
	385	exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';