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