Limit @ISA to actual DBM in AnyDBM

[perl5.git] / lib / diagnostics.pm

diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm
old mode 100755 (executable)
new mode 100644 (file)
index c3e5b93..0bdf1be
--- a/lib/diagnostics.pm
+++ b/lib/diagnostics.pm
@@ -1,18 +1,4 @@
-#!/usr/local/bin/perl
-eval 'exec perl -S $0  ${1+"$@"}'
-    if 0;
-
-use Config;
-if ($^O eq 'VMS') {
-   $diagnostics::PODFILE = VMS::Filespec::unixify($Config{'privlibexp'}) .
-                           '/pod/perldiag.pod';
-}
-else { $diagnostics::PODFILE= $Config{privlibexp} . "/pod/perldiag.pod"; }
-
 package diagnostics;
-require 5.001;
-use English;
-use Carp;
 
 =head1 NAME
 
@@ -164,22 +150,37 @@ You have to to this instead, and I<before> you load the module.
     BEGIN { $diagnostics::PRETTY = 1 } 
 
 I could start up faster by delaying compilation until it should be
-needed, but this gets a "panic: top_level"
-when using the pragma form in 5.001e.  
+needed, but this gets a "panic: top_level" when using the pragma form
+in Perl 5.001e.
 
 While it's true that this documentation is somewhat subserious, if you use
 a program named I<splain>, you should expect a bit of whimsy.
 
 =head1 AUTHOR
 
-Tom Christiansen F<E<lt>tchrist@mox.perl.comE<gt>>, 25 June 1995.
+Tom Christiansen <F<tchrist@mox.perl.com>>, 25 June 1995.
 
 =cut
 
+require 5.001;
+use Carp;
+
+use Config;
+($privlib, $archlib) = @Config{qw(privlibexp archlibexp)};
+if ($^O eq 'VMS') {
+    require VMS::Filespec;
+    $privlib = VMS::Filespec::unixify($privlib);
+    $archlib = VMS::Filespec::unixify($archlib);
+}
+@trypod = ("$archlib/pod/perldiag.pod",
+          "$privlib/pod/perldiag-$].pod",
+          "$privlib/pod/perldiag.pod");
+($PODFILE) = ((grep { -e } @trypod), $trypod[$#trypod])[0];
+
 $DEBUG ||= 0;
 my $WHOAMI = ref bless [];  # nobody's business, prolly not even mine
 
-$OUTPUT_AUTOFLUSH = 1;
+$| = 1;
 
 local $_;
 
@@ -191,7 +192,8 @@ CONFIG: {
     unless (caller) { 
        $standalone++;
        require Getopt::Std;
-       Getopt::Std::getopts('pdvf:') || die "Usage: $0 [-v] [-p] [-f splainpod]";
+       Getopt::Std::getopts('pdvf:')
+           or die "Usage: $0 [-v] [-p] [-f splainpod]";
        $PODFILE = $opt_f if $opt_f;
        $DEBUG = 2 if $opt_d;
        $VERBOSE = $opt_v;
@@ -315,7 +317,9 @@ EOFUNC
            }
            next;
        }
-       $header = $1;
+
+       # strip formatting directives in =item line
+       ($header = $1) =~ s/[A-Z]<(.*?)>/$1/g;
 
        if ($header =~ /%[sd]/) {
            $rhs = $lhs = $header;
@@ -328,8 +332,9 @@ EOFUNC
                #$lhs =~ s/\377([^\377]*)$/\Q$1\E\$/;
                $lhs =~ s/\377([^\377]*)$/\Q$1\E/;
                $lhs =~ s/\377//g;
+               $lhs =~ s/\.\*\?$/.*/; # Allow %s at the end to eat it all
            } 
-           $transmo .= "    s{^$lhs}\n     {\Q$rhs\E}\n\t&& return 1;\n";
+           $transmo .= "    s{^$lhs}\n     {\Q$rhs\E}s\n\t&& return 1;\n";
        } else {
            $transmo .= "    m{^\Q$header\E} && return 1;\n";
        } 
@@ -354,7 +359,7 @@ EOFUNC
 
 if ($standalone) {
     if (!@ARGV and -t STDIN) { print STDERR "$0: Reading from STDIN\n" } 
-    while ($error = <>) {
+    while (defined ($error = <>)) {
        splainthis($error) || print THITHER $error;
     } 
     exit;
@@ -499,7 +504,7 @@ sub unescape {
              exists $HTML_Escapes{$1}
                 ? do { $HTML_Escapes{$1} }
                 : do {
-                    warn "Unknown escape: $& in $_";
+                    warn "Unknown escape: E<$1> in $_";
                     "E<$1>";
                 } 
          } 
@@ -508,7 +513,7 @@ sub unescape {
 
 sub shorten {
     my $line = $_[0];
-    if (length $line > 79) {
+    if (length($line) > 79 and index($line, "\n") == -1) {
        my $space_place = rindex($line, ' ', 79);
        if ($space_place != -1) {
            substr($line, $space_place, 1) = "\n\t";