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