[p5sagit/p5-mst-13.2.git] / utils / perldoc.PL

#!/usr/local/bin/perl

use Config;
use File::Basename qw(&basename &dirname);
use Cwd;

# 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.
$origdir = cwd;
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] [-r] [-i] [-v] [-t] [-u] [-m] [-l] [-F] [-X] PageName|ModuleName|ProgramName
       $me -f PerlFunc
       $me -q FAQKeywords

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
perldoc [options] -q FAQRegex

Options:
    -h   Display this help message
    -r   Recursive search (slow)
    -i   Ignore case 
    -t   Display pod using pod2text instead of pod2man and nroff
             (-t is the default on win32)
    -u	 Display unformatted pod text
    -m   Display module's file in its entirety
    -l   Display the module's 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'.

FAQRegex
         is a regex. Will search perlfaq[1-9] for and extract any
         questions that match.

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("mhtluvriFf:Xq:") || 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");
} elsif ($opt_q) {
   @pages = ("perlfaq1" .. "perlfaq9");
} 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($dir,$file) = @_;
     my $path = join('/',$dir,$file);
     return $path if -f $path and -r _;
     if (!$opt_i or $Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') {
        # on a case-forgiving file system or if case is important 
	# that is it all we can do
	warn "Ignored $file: unreadable\n" if -f _;
	return '';
     }
     local *DIR;
     local($")="/";
     my @p = ($dir);
     my($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 "";
}
 

sub check_file {
    my($dir,$file) = @_;
    if ($opt_m) {
	return minus_f_nocase($dir,$file);
    } else {
	my $path = minus_f_nocase($dir,$file);
        return $path if length $path and containspod($path);
    }
    return "";
}


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(@searchdirs,'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 $opt_r;
		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;
}

my $lines = $ENV{LINES} || 24;

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();
	  unshift @pagers, 'less', 'cmd /c more <';
	} 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);
       } elsif (@pod < $lines-2) {
	   print @pod;
       } else {
	   foreach $pager (@pagers) {
		open (PAGER, "| $pager") or next;
		print PAGER @pod ;
		close(PAGER) or next;
		last;
	   }
       }
   } else {
       die "No documentation for perl function `$opt_f' found\n";
   }
   exit;
}

if ($opt_q) {
   local @ARGV = @found;	# I'm lazy, sue me.
   my $found = 0;
   my %found_in;
   my @pod;

   while (<>) {
      if (/^=head2\s+.*$opt_q/oi) {
	 $found = 1;
	 push @pod, "=head1 Found in $ARGV\n\n" unless $found_in{$ARGV}++;
      } elsif (/^=head2/) {
	 $found = 0;
      }
      next unless $found;
      push @pod, $_;
   }
   
   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);
      } elsif (@pod < $lines-2) {
	 print @pod;
      } else {
	 foreach $pager (@pagers) {
	    open (PAGER, "| $pager") or next;
	    print PAGER @pod ;
	    close(PAGER) or next;
	    last;
	 }
      }
   } else {
      die "No documentation for perl FAQ keyword `$opt_q' 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

B<perldoc> B<-q> FAQ Keyword

=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<-q> perlfaq

The B<-q> option takes a regular expression as an argument.  It will search
the question headings in perlfaq[1-9] and print the entries matching
the regular expression.

=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.)  C<perldoc> will use, in order of
preference, the pager defined in C<PERLDOC_PAGER>, C<MANPAGER>, or
C<PAGER> before trying to find a pager on its own.  (C<MANPAGER> is not
used if C<perldoc> was told to display plain text or unformatted pod.)

=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 ':';
chdir $origdir;
Commit	Line	Data
4633a7c4	1	#!/usr/local/bin/perl
	2
	3	use Config;
	4	use File::Basename qw(&basename &dirname);
8a5546a1	5	use Cwd;
4633a7c4	6
85880f03	7	# List explicitly here the variables you want Configure to
	8	# generate. Metaconfig only looks for shell variables, so you
	9	# have to mention them as if they were shell variables, not
	10	# %Config entries. Thus you write
4633a7c4	11	# $startperl
85880f03	12	# to ensure Configure will look for $Config{startperl}.
4633a7c4	13
	14	# This forces PL files to create target in same directory as PL file.
	15	# This is so that make depend always knows where to find PL derivatives.
8a5546a1	16	$origdir = cwd;
44a8e56a	17	chdir dirname($0);
44a8e56a	18	$file = basename($0, '.PL');
774d564b	19	$file .= '.com' if $^O eq 'VMS';
4633a7c4	20
	21	open OUT,">$file" or die "Can't create $file: $!";
	22
	23	print "Extracting $file (with variable substitutions)\n";
	24
	25	# In this section, perl variables will be expanded during extraction.
	26	# You can use $Config{...} to use Configure variables.
	27
85880f03	28	print OUT <<"!GROK!THIS!";
5f05dabc	29	$Config{startperl}
	30	eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
	31	if \$running_under_some_shell;
55497cff	32
	33	\@pagers = ();
	34	push \@pagers, "$Config{'pager'}" if -x "$Config{'pager'}";
4633a7c4	35	!GROK!THIS!
	36
	37	# In the following, perl variables are not expanded during extraction.
	38
	39	print OUT <<'!NO!SUBS!';
	40
	41	#
	42	# Perldoc revision #1 -- look up a piece of documentation in .pod format that
	43	# is embedded in the perl installation tree.
	44	#
	45	# This is not to be confused with Tom Christianson's perlman, which is a
	46	# man replacement, written in perl. This perldoc is strictly for reading
	47	# the perl manuals, though it too is written in perl.
4633a7c4	48
4633a7c4	49	if(@ARGV<1) {
0b166b66	50	$me = $0; # Editing $0 is unportable
fb73857a	51	$me =~ s,.*/,,;
4633a7c4	52	die <<EOF;
5315ba28	53	Usage: $me [-h] [-r] [-i] [-v] [-t] [-u] [-m] [-l] [-F] [-X] PageName\|ModuleName\|ProgramName
0b166b66	54	$me -f PerlFunc
a3cb178b	55	$me -q FAQKeywords
4633a7c4	56
89b8affa	57	The -h option prints more help. Also try "perldoc perldoc" to get
89b8affa	58	aquainted with the system.
4633a7c4	59	EOF
	60	}
	61
	62	use Getopt::Std;
59586d77	63	use Config '%Config';
59586d77	64
fb73857a	65	@global_found = ();
	66	$global_target = "";
	67
7eda7aea	68	$Is_VMS = $^O eq 'VMS';
137443ea	69	$Is_MSWin32 = $^O eq 'MSWin32';
0151c6ef	70	$Is_Dos = $^O eq 'dos';
4633a7c4	71
4633a7c4	72	sub usage{
ff0cee69	73	warn "@_\n" if @_;
	74	# Erase evidence of previous errors (if any), so exit status is simple.
	75	$! = 0;
4633a7c4	76	die <<EOF;
31bdbec1	77	perldoc [options] PageName\|ModuleName\|ProgramName...
31bdbec1	78	perldoc [options] -f BuiltinFunction
a3cb178b	79	perldoc [options] -q FAQRegex
31bdbec1	80
31bdbec1	81	Options:
137443ea	82	-h Display this help message
5315ba28	83	-r Recursive search (slow)
5315ba28	84	-i Ignore case
137443ea	85	-t Display pod using pod2text instead of pod2man and nroff
137443ea	86	(-t is the default on win32)
85880f03	87	-u Display unformatted pod text
a3cb178b	88	-m Display module's file in its entirety
a3cb178b	89	-l Display the module's file name
cce34969	90	-F Arguments are file names, not modules
137443ea	91	-v Verbosely describe what's going on
89b8affa	92	-X use index if present (looks for pod.idx at $Config{archlib})
31bdbec1	93
a3cb178b	94
4633a7c4	95	PageName\|ModuleName...
	96	is the name of a piece of documentation that you want to look at. You
	97	may either give a descriptive name of the page (as in the case of
	98	`perlfunc') the name of a module, either like `Term::Info',
	99	`Term/Info', the partial name of a module, like `info', or
	100	`makemaker', or the name of a program, like `perldoc'.
31bdbec1	101
	102	BuiltinFunction
	103	is the name of a perl function. Will extract documentation from
	104	`perlfunc'.
a3cb178b	105
	106	FAQRegex
	107	is a regex. Will search perlfaq[1-9] for and extract any
	108	questions that match.
	109
4633a7c4	110	Any switches in the PERLDOC environment variable will be used before the
89b8affa	111	command line arguments. The optional pod index file contains a list of
89b8affa	112	filenames, one per line.
4633a7c4	113
	114	EOF
	115	}
	116
	117	use Text::ParseWords;
	118
	119
	120	unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
	121
c8950503	122	getopts("mhtluvriFf:Xq:") \|\| usage;
85880f03	123
85880f03	124	usage if $opt_h \|\| $opt_h; # avoid -w warning
4633a7c4	125
89b8affa	126	$podidx = "$Config{'archlib'}/pod.idx";
	127	$podidx = "" if $opt_X \|\| !-f "pod.idx" && !-r _ && -M _ > 7;
	128
137443ea	129	if ($opt_t + $opt_u + $opt_m + $opt_l > 1) {
137443ea	130	usage("only one of -t, -u, -m or -l")
0151c6ef	131	} elsif ($Is_MSWin32 \|\| $Is_Dos) {
137443ea	132	$opt_t = 1 unless $opt_t + $opt_u + $opt_m + $opt_l;
137443ea	133	}
4633a7c4	134
7eda7aea	135	if ($opt_t) { require Pod::Text; import Pod::Text; }
4633a7c4	136
31bdbec1	137	if ($opt_f) {
31bdbec1	138	@pages = ("perlfunc");
a3cb178b	139	} elsif ($opt_q) {
a3cb178b	140	@pages = ("perlfaq1" .. "perlfaq9");
31bdbec1	141	} else {
	142	@pages = @ARGV;
	143	}
	144
fb73857a	145	# Does this look like a module or extension directory?
	146	if (-f "Makefile.PL") {
	147	# Add ., lib and blib/* libs to @INC (if they exist)
	148	unshift(@INC, '.');
	149	unshift(@INC, 'lib') if -d 'lib';
	150	require ExtUtils::testlib;
	151	}
	152
31bdbec1	153
85880f03	154
4633a7c4	155	sub containspod {
fb73857a	156	my($file, $readit) = @_;
	157	return 1 if !$readit && $file =~ /\.pod$/i;
	158	local($_);
	159	open(TEST,"<$file");
	160	while(<TEST>) {
	161	if(/^=head/) {
	162	close(TEST);
	163	return 1;
4633a7c4	164	}
fb73857a	165	}
	166	close(TEST);
	167	return 0;
4633a7c4	168	}
4633a7c4	169
84902520	170	sub minus_f_nocase {
5315ba28	171	my($dir,$file) = @_;
	172	my $path = join('/',$dir,$file);
	173	return $path if -f $path and -r _;
	174	if (!$opt_i or $Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') {
	175	# on a case-forgiving file system or if case is important
	176	# that is it all we can do
2d7a9237	177	warn "Ignored $file: unreadable\n" if -f _;
fb73857a	178	return '';
84902520	179	}
4633a7c4	180	local *DIR;
4633a7c4	181	local($")="/";
5315ba28	182	my @p = ($dir);
5315ba28	183	my($p,$cip);
4633a7c4	184	foreach $p (split(/\//, $file)){
fb73857a	185	my $try = "@p/$p";
	186	stat $try;
	187	if (-d _){
4633a7c4	188	push @p, $p;
fb73857a	189	if ( $p eq $global_target) {
	190	$tmp_path = join ('/', @p);
	191	my $path_f = 0;
	192	for (@global_found) {
	193	$path_f = 1 if $_ eq $tmp_path;
	194	}
	195	push (@global_found, $tmp_path) unless $path_f;
	196	print STDERR "Found as @p but directory\n" if $opt_v;
	197	}
	198	} elsif (-f _ && -r _) {
	199	return $try;
	200	} elsif (-f _) {
	201	warn "Ignored $try: unreadable\n";
4633a7c4	202	} else {
	203	my $found=0;
	204	my $lcp = lc $p;
	205	opendir DIR, "@p";
	206	while ($cip=readdir(DIR)) {
	207	if (lc $cip eq $lcp){
	208	$found++;
	209	last;
	210	}
	211	}
	212	closedir DIR;
	213	return "" unless $found;
	214	push @p, $cip;
fb73857a	215	return "@p" if -f "@p" and -r _;
fb73857a	216	warn "Ignored $file: unreadable\n" if -f _;
4633a7c4	217	}
4633a7c4	218	}
5315ba28	219	return "";
fb73857a	220	}
4633a7c4	221
fb73857a	222
fb73857a	223	sub check_file {
5315ba28	224	my($dir,$file) = @_;
3046dd9f	225	if ($opt_m) {
5315ba28	226	return minus_f_nocase($dir,$file);
3046dd9f	227	} else {
5315ba28	228	my $path = minus_f_nocase($dir,$file);
249edfdf	229	return $path if length $path and containspod($path);
3046dd9f	230	}
5315ba28	231	return "";
fb73857a	232	}
	233
	234
	235	sub searchfor {
	236	my($recurse,$s,@dirs) = @_;
	237	$s =~ s!::!/!g;
	238	$s = VMS::Filespec::unixify($s) if $Is_VMS;
	239	return $s if -f $s && containspod($s);
	240	printf STDERR "Looking for $s in @dirs\n" if $opt_v;
	241	my $ret;
	242	my $i;
	243	my $dir;
	244	$global_target = (split('/', $s))[-1];
	245	for ($i=0; $i<@dirs; $i++) {
	246	$dir = $dirs[$i];
	247	($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
5315ba28	248	if ( ( $ret = check_file $dir,"$s.pod")
	249	or ( $ret = check_file $dir,"$s.pm")
	250	or ( $ret = check_file $dir,$s)
fb73857a	251	or ( $Is_VMS and
5315ba28	252	$ret = check_file $dir,"$s.com")
59586d77	253	or ( $^O eq 'os2' and
5315ba28	254	$ret = check_file $dir,"$s.cmd")
0151c6ef	255	or ( ($Is_MSWin32 or $Is_Dos or $^O eq 'os2') and
5315ba28	256	$ret = check_file $dir,"$s.bat")
	257	or ( $ret = check_file "$dir/pod","$s.pod")
	258	or ( $ret = check_file "$dir/pod",$s)
fb73857a	259	) {
	260	return $ret;
	261	}
	262
	263	if ($recurse) {
	264	opendir(D,$dir);
	265	my @newdirs = map "$dir/$_", grep {
	266	not /^\.\.?$/ and
	267	not /^auto$/ and # save time! don't search auto dirs
	268	-d "$dir/$_"
	269	} readdir D;
	270	closedir(D);
	271	next unless @newdirs;
	272	@newdirs = map((s/.dir$//,$_)[1],@newdirs) if $Is_VMS;
	273	print STDERR "Also looking in @newdirs\n" if $opt_v;
	274	push(@dirs,@newdirs);
	275	}
	276	}
	277	return ();
	278	}
4633a7c4	279
	280
	281	foreach (@pages) {
89b8affa	282	if ($podidx && open(PODIDX, $podidx)) {
	283	my $searchfor = $_;
	284	local($_);
	285	$searchfor =~ s,::,/,g;
	286	print STDERR "Searching for '$searchfor' in $podidx\n" if $opt_v;
	287	while (<PODIDX>) {
	288	chomp;
	289	push(@found, $_) if m,/$searchfor(?:\.(?:pod\|pm))?$,i;
	290	}
	291	close(PODIDX);
	292	next;
	293	}
4633a7c4	294	print STDERR "Searching for $_\n" if $opt_v;
	295	# We must look both in @INC for library modules and in PATH
	296	# for executables, like h2xs or perldoc itself.
	297	@searchdirs = @INC;
cce34969	298	if ($opt_F) {
	299	next unless -r;
	300	push @found, $_ if $opt_m or containspod($_);
	301	next;
	302	}
7eda7aea	303	unless ($opt_m) {
	304	if ($Is_VMS) {
	305	my($i,$trn);
	306	for ($i = 0; $trn = $ENV{'DCL$PATH'.$i}; $i++) {
	307	push(@searchdirs,$trn);
	308	}
877622ba	309	push(@searchdirs,'perl_root:[lib.pod]') # installed pods
7eda7aea	310	} else {
59586d77	311	push(@searchdirs, grep(-d, split($Config{path_sep},
59586d77	312	$ENV{'PATH'})));
7eda7aea	313	}
85880f03	314	}
877622ba	315	@files = searchfor(0,$_,@searchdirs);
4633a7c4	316	if( @files ) {
	317	print STDERR "Found as @files\n" if $opt_v;
	318	} else {
	319	# no match, try recursive search
	320
	321	@searchdirs = grep(!/^\.$/,@INC);
	322
5315ba28	323	@files= searchfor(1,$_,@searchdirs) if $opt_r;
4633a7c4	324	if( @files ) {
85880f03	325	print STDERR "Loosely found as @files\n" if $opt_v;
4633a7c4	326	} else {
fb73857a	327	print STDERR "No documentation found for \"$_\".\n";
	328	if (@global_found) {
	329	print STDERR "However, try\n";
	330	my $dir = $file = "";
	331	for $dir (@global_found) {
	332	opendir(DIR, $dir) or die "$!";
	333	while ($file = readdir(DIR)) {
	334	next if ($file =~ /^\./);
	335	$file =~ s/\.(pm\|pod)$//;
	336	print STDERR "\tperldoc $_\::$file\n";
	337	}
	338	closedir DIR;
	339	}
	340	}
4633a7c4	341	}
	342	}
	343	push(@found,@files);
	344	}
	345
	346	if(!@found) {
85880f03	347	exit ($Is_VMS ? 98962 : 1);
4633a7c4	348	}
4633a7c4	349
44a8e56a	350	if ($opt_l) {
	351	print join("\n", @found), "\n";
	352	exit;
	353	}
	354
877622ba	355	my $lines = $ENV{LINES} \|\| 24;
877622ba	356
31bdbec1	357	if( ! -t STDOUT ) { $no_tty = 1 }
4633a7c4	358
137443ea	359	if ($Is_MSWin32) {
	360	$tmp = "$ENV{TEMP}\\perldoc1.$$";
	361	push @pagers, qw( more< less notepad );
55497cff	362	unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
137443ea	363	} elsif ($Is_VMS) {
4633a7c4	364	$tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
55497cff	365	push @pagers, qw( most more less type/page );
0151c6ef	366	} elsif ($Is_Dos) {
	367	$tmp = "$ENV{TEMP}/perldoc1.$$";
	368	$tmp =~ tr!\\/!//!s;
	369	push @pagers, qw( less.exe more.com< );
	370	unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
137443ea	371	} else {
59586d77	372	if ($^O eq 'os2') {
	373	require POSIX;
	374	$tmp = POSIX::tmpnam();
491527d0	375	unshift @pagers, 'less', 'cmd /c more <';
59586d77	376	} else {
	377	$tmp = "/tmp/perldoc1.$$";
	378	}
137443ea	379	push @pagers, qw( more less pg view cat );
137443ea	380	unshift @pagers, $ENV{PAGER} if $ENV{PAGER};
4633a7c4	381	}
44a8e56a	382	unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
4633a7c4	383
7eda7aea	384	if ($opt_m) {
1e422769	385	foreach $pager (@pagers) {
	386	system("$pager @found") or exit;
	387	}
	388	if ($Is_VMS) { eval 'use vmsish qw(status exit); exit $?' }
	389	exit 1;
7eda7aea	390	}
7eda7aea	391
31bdbec1	392	if ($opt_f) {
	393	my $perlfunc = shift @found;
	394	open(PFUNC, $perlfunc) or die "Can't open $perlfunc: $!";
	395
	396	# Skip introduction
	397	while (<PFUNC>) {
	398	last if /^=head2 Alphabetical Listing of Perl Functions/;
	399	}
	400
	401	# Look for our function
	402	my $found = 0;
fb73857a	403	my @pod;
31bdbec1	404	while (<PFUNC>) {
31bdbec1	405	if (/^=item\s+\Q$opt_f\E\b/o) {
fb73857a	406	$found = 1;
31bdbec1	407	} elsif (/^=item/) {
fb73857a	408	last if $found > 1;
31bdbec1	409	}
fb73857a	410	next unless $found;
	411	push @pod, $_;
	412	++$found if /^\w/; # found descriptive text
31bdbec1	413	}
	414	if (@pod) {
	415	if ($opt_t) {
	416	open(FORMATTER, "\| pod2text") \|\| die "Can't start filter";
	417	print FORMATTER "=over 8\n\n";
	418	print FORMATTER @pod;
	419	print FORMATTER "=back\n";
	420	close(FORMATTER);
43051805	421	} elsif (@pod < $lines-2) {
31bdbec1	422	print @pod;
43051805	423	} else {
	424	foreach $pager (@pagers) {
	425	open (PAGER, "\| $pager") or next;
	426	print PAGER @pod ;
	427	close(PAGER) or next;
	428	last;
	429	}
31bdbec1	430	}
31bdbec1	431	} else {
ed5c9e50	432	die "No documentation for perl function `$opt_f' found\n";
31bdbec1	433	}
	434	exit;
	435	}
	436
a3cb178b	437	if ($opt_q) {
	438	local @ARGV = @found; # I'm lazy, sue me.
	439	my $found = 0;
	440	my %found_in;
	441	my @pod;
	442
	443	while (<>) {
	444	if (/^=head2\s+.*$opt_q/oi) {
	445	$found = 1;
	446	push @pod, "=head1 Found in $ARGV\n\n" unless $found_in{$ARGV}++;
	447	} elsif (/^=head2/) {
	448	$found = 0;
	449	}
	450	next unless $found;
	451	push @pod, $_;
	452	}
	453
	454	if (@pod) {
	455	if ($opt_t) {
	456	open(FORMATTER, "\| pod2text") \|\| die "Can't start filter";
	457	print FORMATTER "=over 8\n\n";
	458	print FORMATTER @pod;
	459	print FORMATTER "=back\n";
	460	close(FORMATTER);
877622ba	461	} elsif (@pod < $lines-2) {
a3cb178b	462	print @pod;
877622ba	463	} else {
	464	foreach $pager (@pagers) {
	465	open (PAGER, "\| $pager") or next;
	466	print PAGER @pod ;
	467	close(PAGER) or next;
	468	last;
	469	}
a3cb178b	470	}
a3cb178b	471	} else {
877622ba	472	die "No documentation for perl FAQ keyword `$opt_q' found\n";
a3cb178b	473	}
	474	exit;
	475	}
	476
4633a7c4	477	foreach (@found) {
7eda7aea	478
85880f03	479	if($opt_t) {
	480	open(TMP,">>$tmp");
	481	Pod::Text::pod2text($_,*TMP);
	482	close(TMP);
	483	} elsif(not $opt_u) {
1e422769	484	my $cmd = "pod2man --lax $_ \| nroff -man";
	485	$cmd .= " \| col -x" if $^O =~ /hpux/;
	486	$rslt = `$cmd`;
	487	unless(($err = $?)) {
	488	open(TMP,">>$tmp");
	489	print TMP $rslt;
	490	close TMP;
40fc7247	491	}
85880f03	492	}
4633a7c4	493
85880f03	494	if( $opt_u or $err or -z $tmp) {
4633a7c4	495	open(OUT,">>$tmp");
4633a7c4	496	open(IN,"<$_");
85880f03	497	$cut = 1;
	498	while (<IN>) {
	499	$cut = $1 eq 'cut' if /^=(\w+)/;
	500	next if $cut;
	501	print OUT;
	502	}
4633a7c4	503	close(IN);
	504	close(OUT);
	505	}
	506	}
	507
31bdbec1	508	if( $no_tty ) {
4633a7c4	509	open(TMP,"<$tmp");
	510	print while <TMP>;
	511	close(TMP);
	512	} else {
85880f03	513	foreach $pager (@pagers) {
1e422769	514	system("$pager $tmp") or last;
4633a7c4	515	}
	516	}
	517
	518	1 while unlink($tmp); #Possibly pointless VMSism
	519
	520	exit 0;
7eda7aea	521
	522	__END__
	523
	524	=head1 NAME
	525
	526	perldoc - Look up Perl documentation in pod format.
	527
	528	=head1 SYNOPSIS
	529
89b8affa	530	B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] [B<-F>] [B<-X>] PageName\|ModuleName\|ProgramName
7eda7aea	531
31bdbec1	532	B<perldoc> B<-f> BuiltinFunction
31bdbec1	533
c8950503	534	B<perldoc> B<-q> FAQ Keyword
c8950503	535
7eda7aea	536	=head1 DESCRIPTION
7eda7aea	537
40fc7247	538	I<perldoc> looks up a piece of documentation in .pod format that is embedded
	539	in the perl installation tree or in a perl script, and displays it via
	540	C<pod2man \| nroff -man \| $PAGER>. (In addition, if running under HP-UX,
	541	C<col -x> will be used.) This is primarily used for the documentation for
	542	the perl library modules.
7eda7aea	543
	544	Your system may also have man pages installed for those modules, in
	545	which case you can probably just use the man(1) command.
	546
	547	=head1 OPTIONS
	548
	549	=over 5
	550
	551	=item B<-h> help
	552
	553	Prints out a brief help message.
	554
	555	=item B<-v> verbose
	556
	557	Describes search for the item in detail.
	558
	559	=item B<-t> text output
	560
	561	Display docs using plain text converter, instead of nroff. This may be faster,
	562	but it won't look as nice.
	563
	564	=item B<-u> unformatted
	565
	566	Find docs only; skip reformatting by pod2*
	567
	568	=item B<-m> module
	569
	570	Display the entire module: both code and unformatted pod documentation.
	571	This may be useful if the docs don't explain a function in the detail
	572	you need, and you'd like to inspect the code directly; perldoc will find
	573	the file for you and simply hand it off for display.
	574
44a8e56a	575	=item B<-l> file name only
	576
	577	Display the file name of the module found.
	578
cce34969	579	=item B<-F> file names
cce34969	580
89b8affa	581	Consider arguments as file names, no search in directories will be performed.
cce34969	582
31bdbec1	583	=item B<-f> perlfunc
	584
	585	The B<-f> option followed by the name of a perl built in function will
	586	extract the documentation of this function from L<perlfunc>.
	587
c8950503	588	=item B<-q> perlfaq
	589
	590	The B<-q> option takes a regular expression as an argument. It will search
	591	the question headings in perlfaq[1-9] and print the entries matching
	592	the regular expression.
	593
89b8affa	594	=item B<-X> use an index if present
	595
	596	The B<-X> option looks for a entry whose basename matches the name given on the
	597	command line in the file C<$Config{archlib}/pod.idx>. The pod.idx file should
	598	contain fully qualified filenames, one per line.
	599
7eda7aea	600	=item B<PageName\|ModuleName\|ProgramName>
	601
	602	The item you want to look up. Nested modules (such as C<File::Basename>)
	603	are specified either as C<File::Basename> or C<File/Basename>. You may also
	604	give a descriptive name of a page, such as C<perlfunc>. You make also give a
	605	partial or wrong-case name, such as "basename" for "File::Basename", but
	606	this will be slower, if there is more then one page with the same partial
	607	name, you will only get the first one.
	608
	609	=back
	610
	611	=head1 ENVIRONMENT
	612
	613	Any switches in the C<PERLDOC> environment variable will be used before the
	614	command line arguments. C<perldoc> also searches directories
	615	specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
	616	defined) and C<PATH> environment variables.
	617	(The latter is so that embedded pods for executables, such as
a3cb178b	618	C<perldoc> itself, are available.) C<perldoc> will use, in order of
	619	preference, the pager defined in C<PERLDOC_PAGER>, C<MANPAGER>, or
	620	C<PAGER> before trying to find a pager on its own. (C<MANPAGER> is not
	621	used if C<perldoc> was told to display plain text or unformatted pod.)
7eda7aea	622
	623	=head1 AUTHOR
	624
	625	Kenneth Albanowski <kjahds@kjahds.com>
	626
	627	Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>
	628
7eda7aea	629	=cut
	630
	631	#
89b8affa	632	# Version 1.13: Fri Feb 27 16:20:50 EST 1997
	633	# Gurusamy Sarathy <gsar@umich.edu>
	634	# -doc tweaks for -F and -X options
137443ea	635	# Version 1.12: Sat Apr 12 22:41:09 EST 1997
	636	# Gurusamy Sarathy <gsar@umich.edu>
	637	# -various fixes for win32
7eda7aea	638	# Version 1.11: Tue Dec 26 09:54:33 EST 1995
	639	# Kenneth Albanowski <kjahds@kjahds.com>
	640	# -added Charles Bailey's further VMS patches, and -u switch
	641	# -added -t switch, with pod2text support
	642	#
	643	# Version 1.10: Thu Nov 9 07:23:47 EST 1995
	644	# Kenneth Albanowski <kjahds@kjahds.com>
	645	# -added VMS support
	646	# -added better error recognition (on no found pages, just exit. On
	647	# missing nroff/pod2man, just display raw pod.)
	648	# -added recursive/case-insensitive matching (thanks, Andreas). This
	649	# slows things down a bit, unfortunately. Give a precise name, and
	650	# it'll run faster.
	651	#
	652	# Version 1.01: Tue May 30 14:47:34 EDT 1995
	653	# Andy Dougherty <doughera@lafcol.lafayette.edu>
	654	# -added pod documentation.
	655	# -added PATH searching.
	656	# -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
	657	# and friends.
	658	#
	659	#
	660	# TODO:
	661	#
	662	# Cache directories read during sloppy match
4633a7c4	663	!NO!SUBS!
	664
	665	close OUT or die "Can't close $file: $!";
	666	chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
	667	exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
8a5546a1	668	chdir $origdir;