home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_utl.zip / perldoc.cmd < prev    next >
OS/2 REXX Batch file  |  1997-11-28  |  13KB  |  507 lines
  1. extproc perl -S
  2. #!f:/perllib/bin/perl
  3.     eval 'exec f:/perllib/bin/perl -S $0 ${1+"$@"}'
  4.     if $running_under_some_shell;
  5.  
  6. @pagers = ();
  7. push @pagers, "/usr/ucb/more" if -x "/usr/ucb/more";
  8.  
  9. #
  10. # Perldoc revision #1 -- look up a piece of documentation in .pod format that
  11. # is embedded in the perl installation tree.
  12. #
  13. # This is not to be confused with Tom Christianson's perlman, which is a
  14. # man replacement, written in perl. This perldoc is strictly for reading
  15. # the perl manuals, though it too is written in perl.
  16.  
  17. if(@ARGV<1) {
  18.     $me = $0;        # Editing $0 is unportable
  19.     $me =~ s,.*/,,;
  20.     die <<EOF;
  21. Usage: $me [-h] [-v] [-t] [-u] [-m] [-l] PageName|ModuleName|ProgramName
  22.        $me -f PerlFunc
  23.  
  24. We suggest you use "perldoc perldoc" to get aquainted 
  25. with the system.
  26. EOF
  27. }
  28.  
  29. use Getopt::Std;
  30. use Config '%Config';
  31.  
  32. @global_found = ();
  33. $global_target = "";
  34.  
  35. $Is_VMS = $^O eq 'VMS';
  36. $Is_MSWin32 = $^O eq 'MSWin32';
  37.  
  38. sub usage{
  39.     warn "@_\n" if @_;
  40.     # Erase evidence of previous errors (if any), so exit status is simple.
  41.     $! = 0;
  42.     die <<EOF;
  43. perldoc [options] PageName|ModuleName|ProgramName...
  44. perldoc [options] -f BuiltinFunction
  45.  
  46. Options:
  47.     -h   Display this help message
  48.     -t   Display pod using pod2text instead of pod2man and nroff
  49.              (-t is the default on win32)
  50.     -u     Display unformatted pod text
  51.     -m   Display modules file in its entirety
  52.     -l   Display the modules file name
  53.     -v     Verbosely describe what's going on
  54.  
  55. PageName|ModuleName...
  56.          is the name of a piece of documentation that you want to look at. You 
  57.          may either give a descriptive name of the page (as in the case of
  58.          `perlfunc') the name of a module, either like `Term::Info', 
  59.          `Term/Info', the partial name of a module, like `info', or 
  60.          `makemaker', or the name of a program, like `perldoc'.
  61.  
  62. BuiltinFunction
  63.          is the name of a perl function.  Will extract documentation from
  64.          `perlfunc'.
  65.          
  66. Any switches in the PERLDOC environment variable will be used before the 
  67. command line arguments.
  68.  
  69. EOF
  70. }
  71.  
  72. use Text::ParseWords;
  73.  
  74.  
  75. unshift(@ARGV,shellwords($ENV{"PERLDOC"}));
  76.  
  77. getopts("mhtluvf:") || usage;
  78.  
  79. usage if $opt_h || $opt_h; # avoid -w warning
  80.  
  81. if ($opt_t + $opt_u + $opt_m + $opt_l > 1) {
  82.     usage("only one of -t, -u, -m or -l")
  83. } elsif ($Is_MSWin32) {
  84.     $opt_t = 1 unless $opt_t + $opt_u + $opt_m + $opt_l;
  85. }
  86.  
  87. if ($opt_t) { require Pod::Text; import Pod::Text; }
  88.  
  89. if ($opt_f) {
  90.    @pages = ("perlfunc");
  91. } else {
  92.    @pages = @ARGV;
  93. }
  94.  
  95. # Does this look like a module or extension directory?
  96. if (-f "Makefile.PL") {
  97.     # Add ., lib and blib/* libs to @INC (if they exist)
  98.     unshift(@INC, '.');
  99.     unshift(@INC, 'lib') if -d 'lib';
  100.     require ExtUtils::testlib;
  101. }
  102.  
  103.  
  104.  
  105. sub containspod {
  106.     my($file, $readit) = @_;
  107.     return 1 if !$readit && $file =~ /\.pod$/i;
  108.     local($_);
  109.     open(TEST,"<$file");
  110.     while(<TEST>) {
  111.     if(/^=head/) {
  112.         close(TEST);
  113.         return 1;
  114.     }
  115.     }
  116.     close(TEST);
  117.     return 0;
  118. }
  119.  
  120. sub minus_f_nocase {
  121.      my($file) = @_;
  122.      # on a case-forgiving file system we can simply use -f $file
  123.      if ($Is_VMS or $Is_MSWin32 or $^O eq 'os2') {
  124.         return $file if -f $file and -r _;
  125.     warn "Ignored $file: unreadable\n" if -f _;
  126.     return '';
  127.      }
  128.      local *DIR;
  129.      local($")="/";
  130.      my(@p,$p,$cip);
  131.      foreach $p (split(/\//, $file)){
  132.     my $try = "@p/$p";
  133.     stat $try;
  134.      if (-d _){
  135.          push @p, $p;
  136.         if ( $p eq $global_target) {
  137.         $tmp_path = join ('/', @p);
  138.         my $path_f = 0;
  139.         for (@global_found) {
  140.             $path_f = 1 if $_ eq $tmp_path;
  141.         }
  142.         push (@global_found, $tmp_path) unless $path_f;
  143.         print STDERR "Found as @p but directory\n" if $opt_v;
  144.         }
  145.      } elsif (-f _ && -r _) {
  146.          return $try;
  147.      } elsif (-f _) {
  148.         warn "Ignored $try: unreadable\n";
  149.      } else {
  150.          my $found=0;
  151.          my $lcp = lc $p;
  152.          opendir DIR, "@p";
  153.          while ($cip=readdir(DIR)) {
  154.          if (lc $cip eq $lcp){
  155.              $found++;
  156.              last;
  157.          }
  158.          }
  159.          closedir DIR;
  160.          return "" unless $found;
  161.          push @p, $cip;
  162.          return "@p" if -f "@p" and -r _;
  163.         warn "Ignored $file: unreadable\n" if -f _;
  164.      }
  165.      }
  166.      return; # is not a file
  167. }
  168.  
  169.  
  170. sub check_file {
  171.     my($file) = @_;
  172.     return minus_f_nocase($file) && containspod($file) ? $file : "";
  173. }
  174.  
  175.  
  176. sub searchfor {
  177.     my($recurse,$s,@dirs) = @_;
  178.     $s =~ s!::!/!g;
  179.     $s = VMS::Filespec::unixify($s) if $Is_VMS;
  180.     return $s if -f $s && containspod($s);
  181.     printf STDERR "Looking for $s in @dirs\n" if $opt_v;
  182.     my $ret;
  183.     my $i;
  184.     my $dir;
  185.     $global_target = (split('/', $s))[-1];
  186.     for ($i=0; $i<@dirs; $i++) {
  187.     $dir = $dirs[$i];
  188.     ($dir = VMS::Filespec::unixpath($dir)) =~ s!/$!! if $Is_VMS;
  189.     if (       ( $ret = check_file "$dir/$s.pod")
  190.         or ( $ret = check_file "$dir/$s.pm")
  191.         or ( $ret = check_file "$dir/$s")
  192.         or ( $Is_VMS and
  193.              $ret = check_file "$dir/$s.com")
  194.         or ( $^O eq 'os2' and 
  195.              $ret = check_file "$dir/$s.cmd")
  196.         or ( ($Is_MSWin32 or $^O eq 'os2') and 
  197.              $ret = check_file "$dir/$s.bat")
  198.         or ( $ret = check_file "$dir/pod/$s.pod")
  199.         or ( $ret = check_file "$dir/pod/$s")
  200.     ) {
  201.         return $ret;
  202.     }
  203.     
  204.     if ($recurse) {
  205.         opendir(D,$dir);
  206.         my @newdirs = map "$dir/$_", grep {
  207.         not /^\.\.?$/ and
  208.         not /^auto$/  and   # save time! don't search auto dirs
  209.         -d  "$dir/$_"
  210.         } readdir D;
  211.         closedir(D);
  212.         next unless @newdirs;
  213.         @newdirs = map((s/.dir$//,$_)[1],@newdirs) if $Is_VMS;
  214.         print STDERR "Also looking in @newdirs\n" if $opt_v;
  215.         push(@dirs,@newdirs);
  216.     }
  217.     }
  218.     return ();
  219. }
  220.  
  221.  
  222. foreach (@pages) {
  223.     print STDERR "Searching for $_\n" if $opt_v;
  224.     # We must look both in @INC for library modules and in PATH
  225.     # for executables, like h2xs or perldoc itself.
  226.     @searchdirs = @INC;
  227.     unless ($opt_m) { 
  228.         if ($Is_VMS) {
  229.         my($i,$trn);
  230.         for ($i = 0; $trn = $ENV{'DCL$PATH'.$i}; $i++) {
  231.             push(@searchdirs,$trn);
  232.         }
  233.         } else {
  234.             push(@searchdirs, grep(-d, split($Config{path_sep}, 
  235.                          $ENV{'PATH'})));
  236.         }
  237.         @files= searchfor(0,$_,@searchdirs);
  238.     }
  239.     if( @files ) {
  240.         print STDERR "Found as @files\n" if $opt_v;
  241.     } else {
  242.         # no match, try recursive search
  243.         
  244.         @searchdirs = grep(!/^\.$/,@INC);
  245.         
  246.         @files= searchfor(1,$_,@searchdirs);
  247.         if( @files ) {
  248.             print STDERR "Loosely found as @files\n" if $opt_v;
  249.         } else {
  250.             print STDERR "No documentation found for \"$_\".\n";
  251.             if (@global_found) {
  252.                 print STDERR "However, try\n";
  253.                 my $dir = $file = "";
  254.                 for $dir (@global_found) {
  255.                 opendir(DIR, $dir) or die "$!";
  256.                 while ($file = readdir(DIR)) {
  257.                     next if ($file =~ /^\./);
  258.                     $file =~ s/\.(pm|pod)$//;
  259.                     print STDERR "\tperldoc $_\::$file\n";
  260.                 }
  261.                 closedir DIR;
  262.                 }
  263.             }
  264.         }
  265.     }
  266.     push(@found,@files);
  267. }
  268.  
  269. if(!@found) {
  270.     exit ($Is_VMS ? 98962 : 1);
  271. }
  272.  
  273. if ($opt_l) {
  274.     print join("\n", @found), "\n";
  275.     exit;
  276. }
  277.  
  278. if( ! -t STDOUT ) { $no_tty = 1 }
  279.  
  280. if ($Is_MSWin32) {
  281.     $tmp = "$ENV{TEMP}\\perldoc1.$$";
  282.     push @pagers, qw( more< less notepad );
  283.     unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
  284. } elsif ($Is_VMS) {
  285.     $tmp = 'Sys$Scratch:perldoc.tmp1_'.$$;
  286.     push @pagers, qw( most more less type/page );
  287. } else {
  288.     if ($^O eq 'os2') {
  289.       require POSIX;
  290.       $tmp = POSIX::tmpnam();
  291.     } else {
  292.       $tmp = "/tmp/perldoc1.$$";      
  293.     }
  294.     push @pagers, qw( more less pg view cat );
  295.     unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
  296. }
  297. unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
  298.  
  299. if ($opt_m) {
  300.     foreach $pager (@pagers) {
  301.         system("$pager @found") or exit;
  302.     }
  303.     if ($Is_VMS) { eval 'use vmsish qw(status exit); exit $?' }
  304.     exit 1;
  305. } 
  306.  
  307. if ($opt_f) {
  308.    my $perlfunc = shift @found;
  309.    open(PFUNC, $perlfunc) or die "Can't open $perlfunc: $!";
  310.  
  311.    # Skip introduction
  312.    while (<PFUNC>) {
  313.        last if /^=head2 Alphabetical Listing of Perl Functions/;
  314.    }
  315.  
  316.    # Look for our function
  317.    my $found = 0;
  318.    my @pod;
  319.    while (<PFUNC>) {
  320.        if (/^=item\s+\Q$opt_f\E\b/o)  {
  321.        $found = 1;
  322.        } elsif (/^=item/) {
  323.        last if $found > 1;
  324.        }
  325.        next unless $found;
  326.        push @pod, $_;
  327.        ++$found if /^\w/;    # found descriptive text
  328.    }
  329.    if (@pod) {
  330.        if ($opt_t) {
  331.        open(FORMATTER, "| pod2text") || die "Can't start filter";
  332.        print FORMATTER "=over 8\n\n";
  333.        print FORMATTER @pod;
  334.        print FORMATTER "=back\n";
  335.        close(FORMATTER);
  336.        } else {
  337.        print @pod;
  338.        }
  339.    } else {
  340.        die "No documentation for perl function `$opt_f' found\n";
  341.    }
  342.    exit;
  343. }
  344.  
  345. foreach (@found) {
  346.  
  347.     if($opt_t) {
  348.         open(TMP,">>$tmp");
  349.         Pod::Text::pod2text($_,*TMP);
  350.         close(TMP);
  351.     } elsif(not $opt_u) {
  352.         my $cmd = "pod2man --lax $_ | nroff -man";
  353.         $cmd .= " | col -x" if $^O =~ /hpux/;
  354.         $rslt = `$cmd`;
  355.         unless(($err = $?)) {
  356.             open(TMP,">>$tmp");
  357.             print TMP $rslt;
  358.             close TMP;
  359.         }
  360.     }
  361.                                                     
  362.     if( $opt_u or $err or -z $tmp) {
  363.         open(OUT,">>$tmp");
  364.         open(IN,"<$_");
  365.         $cut = 1;
  366.         while (<IN>) {
  367.             $cut = $1 eq 'cut' if /^=(\w+)/;
  368.             next if $cut;
  369.             print OUT;
  370.         }
  371.         close(IN);
  372.         close(OUT);
  373.     }
  374. }
  375.  
  376. if( $no_tty ) {
  377.     open(TMP,"<$tmp");
  378.     print while <TMP>;
  379.     close(TMP);
  380. } else {
  381.     foreach $pager (@pagers) {
  382.         system("$pager $tmp") or last;
  383.     }
  384. }
  385.  
  386. 1 while unlink($tmp); #Possibly pointless VMSism
  387.  
  388. exit 0;
  389.  
  390. __END__
  391.  
  392. =head1 NAME
  393.  
  394. perldoc - Look up Perl documentation in pod format.
  395.  
  396. =head1 SYNOPSIS
  397.  
  398. B<perldoc> [B<-h>] [B<-v>] [B<-t>] [B<-u>] [B<-m>] [B<-l>] PageName|ModuleName|ProgramName
  399.  
  400. B<perldoc> B<-f> BuiltinFunction
  401.  
  402. =head1 DESCRIPTION
  403.  
  404. I<perldoc> looks up a piece of documentation in .pod format that is embedded
  405. in the perl installation tree or in a perl script, and displays it via
  406. C<pod2man | nroff -man | $PAGER>. (In addition, if running under HP-UX,
  407. C<col -x> will be used.) This is primarily used for the documentation for
  408. the perl library modules.
  409.  
  410. Your system may also have man pages installed for those modules, in
  411. which case you can probably just use the man(1) command.
  412.  
  413. =head1 OPTIONS
  414.  
  415. =over 5
  416.  
  417. =item B<-h> help
  418.  
  419. Prints out a brief help message.
  420.  
  421. =item B<-v> verbose
  422.  
  423. Describes search for the item in detail.
  424.  
  425. =item B<-t> text output
  426.  
  427. Display docs using plain text converter, instead of nroff. This may be faster,
  428. but it won't look as nice.
  429.  
  430. =item B<-u> unformatted
  431.  
  432. Find docs only; skip reformatting by pod2*
  433.  
  434. =item B<-m> module
  435.  
  436. Display the entire module: both code and unformatted pod documentation.
  437. This may be useful if the docs don't explain a function in the detail
  438. you need, and you'd like to inspect the code directly; perldoc will find
  439. the file for you and simply hand it off for display.
  440.  
  441. =item B<-l> file name only
  442.  
  443. Display the file name of the module found.
  444.  
  445. =item B<-f> perlfunc
  446.  
  447. The B<-f> option followed by the name of a perl built in function will
  448. extract the documentation of this function from L<perlfunc>.
  449.  
  450. =item B<PageName|ModuleName|ProgramName>
  451.  
  452. The item you want to look up.  Nested modules (such as C<File::Basename>)
  453. are specified either as C<File::Basename> or C<File/Basename>.  You may also
  454. give a descriptive name of a page, such as C<perlfunc>. You make also give a
  455. partial or wrong-case name, such as "basename" for "File::Basename", but
  456. this will be slower, if there is more then one page with the same partial
  457. name, you will only get the first one.
  458.  
  459. =back
  460.  
  461. =head1 ENVIRONMENT
  462.  
  463. Any switches in the C<PERLDOC> environment variable will be used before the 
  464. command line arguments.  C<perldoc> also searches directories
  465. specified by the C<PERL5LIB> (or C<PERLLIB> if C<PERL5LIB> is not
  466. defined) and C<PATH> environment variables.
  467. (The latter is so that embedded pods for executables, such as
  468. C<perldoc> itself, are available.)
  469.  
  470. =head1 AUTHOR
  471.  
  472. Kenneth Albanowski <kjahds@kjahds.com>
  473.  
  474. Minor updates by Andy Dougherty <doughera@lafcol.lafayette.edu>
  475.  
  476. =cut
  477.  
  478. #
  479. # Version 1.12: Sat Apr 12 22:41:09 EST 1997
  480. #       Gurusamy Sarathy <gsar@umich.edu>
  481. #    -various fixes for win32
  482. # Version 1.11: Tue Dec 26 09:54:33 EST 1995
  483. #       Kenneth Albanowski <kjahds@kjahds.com>
  484. #   -added Charles Bailey's further VMS patches, and -u switch
  485. #   -added -t switch, with pod2text support
  486. # 
  487. # Version 1.10: Thu Nov  9 07:23:47 EST 1995
  488. #        Kenneth Albanowski <kjahds@kjahds.com>
  489. #    -added VMS support
  490. #    -added better error recognition (on no found pages, just exit. On
  491. #     missing nroff/pod2man, just display raw pod.)
  492. #    -added recursive/case-insensitive matching (thanks, Andreas). This
  493. #     slows things down a bit, unfortunately. Give a precise name, and
  494. #     it'll run faster.
  495. #
  496. # Version 1.01:    Tue May 30 14:47:34 EDT 1995
  497. #        Andy Dougherty  <doughera@lafcol.lafayette.edu>
  498. #   -added pod documentation.
  499. #   -added PATH searching.
  500. #   -added searching pod/ subdirectory (mainly to pick up perlfunc.pod
  501. #    and friends.
  502. #
  503. #
  504. # TODO:
  505. #
  506. #    Cache directories read during sloppy match
  507.