perl 5.003_06: utils/h2xs.PL
[p5sagit/p5-mst-13.2.git] / utils / perldoc.PL
index 3e72dad..46a89d0 100644 (file)
@@ -3,17 +3,19 @@
 use Config;
 use File::Basename qw(&basename &dirname);
 
-# List explicitly here the shell variables you want Configure
-# to look for.
+# 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)) =~ s/\.PL$//;
 $file =~ s/\.pl$//
-       if ($Config{'osname'} eq 'VMS' or
-           $Config{'osname'} eq 'OS2');  # "case-forgiving"
+       if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"
 
 open OUT,">$file" or die "Can't create $file: $!";
 
@@ -22,7 +24,7 @@ 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!";     
+print OUT <<"!GROK!THIS!";
 $Config{'startperl'}
     eval 'exec perl -S \$0 "\$@"'
        if 0;
@@ -31,6 +33,8 @@ $Config{'startperl'}
 # In the following, perl variables are not expanded during extraction.
 
 print OUT <<'!NO!SUBS!';
+    eval 'exec perl -S $0 "$@"'
+       if 0;
 
 #
 # Perldoc revision #1 -- look up a piece of documentation in .pod format that
@@ -39,94 +43,10 @@ print OUT <<'!NO!SUBS!';
 # 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.
-#
-# Version 1.1: 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
-#
-
-=head1 NAME
-
-perldoc - Look up Perl documentation in pod format.
-
-=head1 SYNOPSIS
-
-B<perldoc> [B<-h>] [B<-v>] PageName|ModuleName|ProgramName
-
-=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 pod2man | nroff -man | $PAGER.  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<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>
-
-=head1 SEE ALSO
-
-=head1 DIAGNOSTICS
-
-=cut
 
 if(@ARGV<1) {
        die <<EOF;
-Usage: $0 [-h] [-v] PageName|ModuleName|ProgramName
+Usage: $0 [-h] [-v] [-t] [-u] [-m] PageName|ModuleName|ProgramName
 
 We suggest you use "perldoc perldoc" to get aquainted 
 with the system.
@@ -134,12 +54,16 @@ EOF
 }
 
 use Getopt::Std;
+$Is_VMS = $^O eq 'VMS';
 
 sub usage{
         warn "@_\n" if @_;
     die <<EOF;
-perldoc [-h] [-v] PageName|ModuleName|ProgramName...
+perldoc [-h] [-v] [-u] PageName|ModuleName|ProgramName...
     -h   Display this help message.
+    -t   Display pod using pod2text instead of pod2man and nroff.
+    -u  Display unformatted pod text
+    -m   Display modules file in its entirety
     -v  Verbosely describe what's going on.
 PageName|ModuleName...
          is the name of a piece of documentation that you want to look at. You 
@@ -159,11 +83,14 @@ use Text::ParseWords;
 
 unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
 
-getopts("hv") || usage;
+getopts("mhtuv") || usage;
+
+usage if $opt_h || $opt_h; # avoid -w warning
+
+usage("only one of -t, -u, or -m") if $opt_t + $opt_u + $opt_m > 1;
 
-usage if $opt_h;
+if ($opt_t) { require Pod::Text; import Pod::Text; }
 
-$index = $opt_i;
 @pages = @ARGV;
 
 sub containspod {
@@ -186,6 +113,11 @@ sub containspod {
      local($")="/";
      my(@p,$p,$cip);
      foreach $p (split(/\//, $file)){
+       if ($Is_VMS and not scalar @p) {
+           # VMS filesystems don't begin at '/'
+           push(@p,$p);
+           next;
+       }
        if (-d ("@p/$p")){
            push @p, $p;
        } elsif (-f ("@p/$p")) {
@@ -195,6 +127,7 @@ sub containspod {
            my $lcp = lc $p;
            opendir DIR, "@p";
            while ($cip=readdir(DIR)) {
+               $cip =~ s/\.dir$// if $Is_VMS;
                if (lc $cip eq $lcp){
                    $found++;
                    last;
@@ -212,15 +145,19 @@ sub containspod {
   sub searchfor {
        my($recurse,$s,@dirs) = @_;
        $s =~ s!::!/!g;
+       $s = VMS::Filespec::unixify($s) if $Is_VMS;
        printf STDERR "looking for $s in @dirs\n" if $opt_v;
        my $ret;
        my $i;
        my $dir;
        for ($i=0;$i<@dirs;$i++) {
                $dir = $dirs[$i];
+               ($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
            if ((    $ret = minus_f_nocase "$dir/$s.pod")
                or ( $ret = minus_f_nocase "$dir/$s.pm"  and containspod($ret))
                or ( $ret = minus_f_nocase "$dir/$s"     and containspod($ret))
+               or ( $Is_VMS and 
+                    $ret = minus_f_nocase "$dir/$s.com" and containspod($ret))
                or ( $ret = minus_f_nocase "$dir/pod/$s.pod")
                or ( $ret = minus_f_nocase "$dir/pod/$s" and containspod($ret)))
                { return $ret; }
@@ -229,6 +166,8 @@ sub containspod {
                        opendir(D,$dir);
                        my(@newdirs) = grep(-d,map("$dir/$_",grep(!/^\.\.?$/,readdir(D))));
                        closedir(D);
+                       @newdirs = map((s/.dir$//,$_)[1],@newdirs) if $Is_VMS;
+                       next unless @newdirs;
                        print STDERR "Also looking in @newdirs\n" if $opt_v;
                        push(@dirs,@newdirs);
                }
@@ -242,8 +181,17 @@ foreach (@pages) {
        # We must look both in @INC for library modules and in PATH
        # for executables, like h2xs or perldoc itself.
        @searchdirs = @INC;
-       push(@searchdirs, grep(-d, split(':', $ENV{'PATH'})));
-       @files= searchfor(0,$_,@searchdirs);
+       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(':', $ENV{'PATH'})));
+           }
+           @files= searchfor(0,$_,@searchdirs);
+       }
        if( @files ) {
                print STDERR "Found as @files\n" if $opt_v;
        } else {
@@ -254,7 +202,7 @@ foreach (@pages) {
                
                @files= searchfor(1,$_,@searchdirs);
                if( @files ) {
-                       print STDERR "Loosly found as @files\n" if $opt_v;
+                       print STDERR "Loosely found as @files\n" if $opt_v;
                } else {
                        print STDERR "No documentation found for '$_'\n";
                }
@@ -263,42 +211,60 @@ foreach (@pages) {
 }
 
 if(!@found) {
-       exit 1;
+       exit ($Is_VMS ? 98962 : 1);
 }
 
-$cmd=$filter="";
-
 if( ! -t STDOUT ) { $opt_f = 1 }
 
-require Config;
-
-$VMS = $Config::Config{'osname'} eq "VMS";
-
-unless($VMS) {
+unless($Is_VMS) {
        $tmp = "/tmp/perldoc1.$$";
-       $tmp2 = "/tmp/perldoc2.$$";
        $goodresult = 0;
+       @pagers = qw( more less pg view cat );
+       unshift(@pagers,$ENV{PAGER}) if $ENV{PAGER};
 } else {
+       require Config;
        $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
-       $tmp2 = 'Sys$Scratch:perldoc.tmp2_'.$$;
+       @pagers = ($Config::Config{'pager'},qw( most more less type/page ));
+       unshift(@pagers,$ENV{PERLDOC_PAGER}) if $ENV{PERLDOC_PAGER};
        $goodresult = 1;
 }
 
+if ($opt_m) {
+    foreach $pager (@pagers) {
+       my($sts) = system("$pager @found");
+       exit 0 if ($Is_VMS ? ($sts & 1) : !$sts);
+    }
+    exit $Is_VMS ? $sts : 1;
+} 
+
 foreach (@found) {
-       
-       open(TMP,">>$tmp");
-       $rslt = `pod2man $_ | nroff -man`;
-       if ($VMS) { $err = !($? % 2) || $rslt =~ /IVVERB/; }
-       else      { $err = $?; }
-       print TMP $rslt unless $err;
-       close TMP;
+
+       if($opt_t) {
+               open(TMP,">>$tmp");
+               Pod::Text::pod2text($_,*TMP);
+               close(TMP);
+       } elsif(not $opt_u) {
+               open(TMP,">>$tmp");
+               if($^O =~ /hpux/) {
+                       $rslt = `pod2man $_ | nroff -man | col -x`;
+               } else {
+                       $rslt = `pod2man $_ | nroff -man`;
+               }
+               if ($Is_VMS) { $err = !($? % 2) || $rslt =~ /IVVERB/; }
+               else      { $err = $?; }
+               print TMP $rslt unless $err;
+               close TMP;
+       }
                                                        
-       1 while unlink($tmp2); # Possibly pointless VMSism
-       
-       if( $err or -z $tmp) {
+       if( $opt_u or $err or -z $tmp) {
                open(OUT,">>$tmp");
                open(IN,"<$_");
-               print OUT while <IN>;
+               $cut = 1;
+               while (<IN>) {
+                       $cut = $1 eq 'cut' if /^=(\w+)/;
+                       next if $cut;
+                       print OUT;
+               }
                close(IN);
                close(OUT);
        }
@@ -309,26 +275,124 @@ if( $opt_f ) {
        print while <TMP>;
        close(TMP);
 } else {
-    pager:
-    {
-               if( $ENV{PAGER} and system("$ENV{PAGER} $tmp")==$goodresult) 
-                       { last pager }
-               if( $Config{pager} and system("$Config{pager} $tmp")==$goodresult) 
-                       { last pager }
-               if( system("more $tmp")==$goodresult)
-                       { last pager }
-               if( system("less $tmp")==$goodresult) 
-                       { last pager }
-               if( system("pg $tmp")==$goodresult) 
-                       { last pager }
-               if( system("view $tmp")==$goodresult) 
-                       { last pager }
+       foreach $pager (@pagers) {
+               $sts = system("$pager $tmp");
+               last if $Is_VMS && ($sts & 1);
+               last unless $sts;
        }
 }
 
 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>] PageName|ModuleName|ProgramName
+
+=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<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>
+
+=head1 SEE ALSO
+
+=head1 DIAGNOSTICS
+
+=cut
+
+#
+# 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: $!";