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