[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) {
	$me = $0;		# Editing $0 is unportable
	$me =~ s,.*/,,;
	die <<EOF;
Usage: $me [-h] [-v] [-t] [-u] [-m] [-l] [-F] PageName|ModuleName|ProgramName
       $me -f PerlFunc

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

use Getopt::Std;
use Config '%Config';

@global_found = ();
$global_target = "";

$Is_VMS = $^O eq 'VMS';
$Is_MSWin32 = $^O eq 'MSWin32';
$Is_Dos = $^O eq 'dos';

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
    -F   Arguments are file names, not modules
    -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("mhtluvFf:") || 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 || $Is_Dos) {
    $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;
}

# Does this look like a module or extension directory?
if (-f "Makefile.PL") {
	# Add ., lib and blib/* libs to @INC (if they exist)
	unshift(@INC, '.');
	unshift(@INC, 'lib') if -d 'lib';
	require ExtUtils::testlib;
}


sub containspod {
    my($file, $readit) = @_;
    return 1 if !$readit && $file =~ /\.pod$/i;
    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 $Is_Dos or $^O eq 'os2') {
        return $file if -f $file and -r _;
	warn "Ignored $file: unreadable\n" if -f _;
	return '';
     }
     local *DIR;
     local($")="/";
     my(@p,$p,$cip);
     foreach $p (split(/\//, $file)){
	my $try = "@p/$p";
	stat $try;
 	if (-d _){
 	    push @p, $p;
	    if ( $p eq $global_target) {
		$tmp_path = join ('/', @p);
		my $path_f = 0;
		for (@global_found) {
		    $path_f = 1 if $_ eq $tmp_path;
		}
		push (@global_found, $tmp_path) unless $path_f;
		print STDERR "Found as @p but directory\n" if $opt_v;
	    }
 	} elsif (-f _ && -r _) {
 	    return $try;
 	} elsif (-f _) {
	    warn "Ignored $try: unreadable\n";
 	} 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" and -r _;
	    warn "Ignored $file: unreadable\n" if -f _;
 	}
     }
     return; # is not a file
}
 

sub check_file {
    my($file) = @_;
    return minus_f_nocase($file) && containspod($file) ? $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;
    $global_target = (split('/', $s))[-1];
    for ($i=0; $i<@dirs; $i++) {
	$dir = $dirs[$i];
	($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
	if (       ( $ret = check_file "$dir/$s.pod")
		or ( $ret = check_file "$dir/$s.pm")
		or ( $ret = check_file "$dir/$s")
		or ( $Is_VMS and
		     $ret = check_file "$dir/$s.com")
		or ( $^O eq 'os2' and 
		     $ret = check_file "$dir/$s.cmd")
		or ( ($Is_MSWin32 or $Is_Dos or $^O eq 'os2') and
		     $ret = check_file "$dir/$s.bat")
		or ( $ret = check_file "$dir/pod/$s.pod")
		or ( $ret = check_file "$dir/pod/$s")
	) {
	    return $ret;
	}
	
	if ($recurse) {
	    opendir(D,$dir);
	    my @newdirs = map "$dir/$_", grep {
		not /^\.\.?$/ and
		not /^auto$/  and   # save time! don't search auto dirs
		-d  "$dir/$_"
	    } readdir D;
	    closedir(D);
	    next unless @newdirs;
	    @newdirs = map((s/.dir$//,$_)[1],@newdirs) if $Is_VMS;
	    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 ($opt_F) {
	  next unless -r;
	  push @found, $_ if $opt_m or containspod($_);
	  next;
	}
	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";
			if (@global_found) {
			    print STDERR "However, try\n";
			    my $dir = $file = "";
			    for $dir (@global_found) {
				opendir(DIR, $dir) or die "$!";
				while ($file = readdir(DIR)) {
				    next if ($file =~ /^\./);
				    $file =~ s/\.(pm|pod)$//;
				    print STDERR "\tperldoc $_\::$file\n";
				}
				closedir DIR;
			    }
			}
		}
	}
	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 );
} elsif ($Is_Dos) {
	$tmp = "$ENV{TEMP}/perldoc1.$$";
	$tmp =~ tr!\\/!//!s;
	push @pagers, qw( less.exe more.com< );
	unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
} 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;
   my @pod;
   while (<PFUNC>) {
       if (/^=item\s+\Q$opt_f\E\b/o)  {
	   $found = 1;
       } elsif (/^=item/) {
	   last if $found > 1;
       }
       next unless $found;
       push @pod, $_;
       ++$found if /^\w/;	# found descriptive text
   }
   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> file names

Consider arguments as file names, no search in directories should be performed.

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