[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] [-X] PageName|ModuleName|ProgramName
       $me -f PerlFunc

The -h option prints more help.  Also try "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
    -X	 use index if present (looks for pod.idx at $Config{archlib})

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.  The optional pod index file contains a list of
filenames, one per line.

EOF
}

use Text::ParseWords;


unshift(@ARGV,shellwords($ENV{"PERLDOC"}));

getopts("mhtluvFf:X") || usage;

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

$podidx = "$Config{'archlib'}/pod.idx";
$podidx = "" if $opt_X || !-f "pod.idx" && !-r _ && -M _ > 7;

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) {
        if ($podidx && open(PODIDX, $podidx)) {
	    my $searchfor = $_;
	    local($_);
	    $searchfor =~ s,::,/,g;
	    print STDERR "Searching for '$searchfor' in $podidx\n" if $opt_v;
	    while (<PODIDX>) {
		chomp;
		push(@found, $_) if m,/$searchfor(?:\.(?:pod|pm))?$,i;
	    }
	    close(PODIDX);
	    next;
        }
	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);
		}
	    push(@dirs,'perl_root:[lib.pod]')  # installed pods
	    } 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>] [B<-F>]  [B<-X>] 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 will 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<-X> use an index if present

The B<-X> option looks for a entry whose basename matches the name given on the
command line in the file C<$Config{archlib}/pod.idx>.  The pod.idx file should
contain fully qualified filenames, one per line.

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