lib/diagnostics.pm

   1 package diagnostics;
   2
   3 =head1 NAME
   4
   5 diagnostics, splain - produce verbose warning diagnostics
   6
   7 =head1 SYNOPSIS
   8
   9 Using the C<diagnostics> pragma:
  10
  11     use diagnostics;
  12     use diagnostics -verbose;
  13
  14     enable  diagnostics;
  15     disable diagnostics;
  16
  17 Using the C<splain> standalone filter program:
  18
  19     perl program 2>diag.out
  20     splain [-v] [-p] diag.out
  21
  22 Using diagnostics to get stack traces from a misbehaving script:
  23
  24     perl -Mdiagnostics=-traceonly my_script.pl
  25
  26 =head1 DESCRIPTION
  27
  28 =head2 The C<diagnostics> Pragma
  29
  30 This module extends the terse diagnostics normally emitted by both the
  31 perl compiler and the perl interpreter (from running perl with a -w
  32 switch or C<use warnings>), augmenting them with the more
  33 explicative and endearing descriptions found in L<perldiag>.  Like the
  34 other pragmata, it affects the compilation phase of your program rather
  35 than merely the execution phase.
  36
  37 To use in your program as a pragma, merely invoke
  38
  39     use diagnostics;
  40
  41 at the start (or near the start) of your program.  (Note
  42 that this I<does> enable perl's B<-w> flag.)  Your whole
  43 compilation will then be subject(ed :-) to the enhanced diagnostics.
  44 These still go out B<STDERR>.
  45
  46 Due to the interaction between runtime and compiletime issues,
  47 and because it's probably not a very good idea anyway,
  48 you may not use C<no diagnostics> to turn them off at compiletime.
  49 However, you may control their behaviour at runtime using the
  50 disable() and enable() methods to turn them off and on respectively.
  51
  52 The B<-verbose> flag first prints out the L<perldiag> introduction before
  53 any other diagnostics.  The $diagnostics::PRETTY variable can generate nicer
  54 escape sequences for pagers.
  55
  56 Warnings dispatched from perl itself (or more accurately, those that match
  57 descriptions found in L<perldiag>) are only displayed once (no duplicate
  58 descriptions).  User code generated warnings a la warn() are unaffected,
  59 allowing duplicate user messages to be displayed.
  60
  61 This module also adds a stack trace to the error message when perl dies.
  62 This is useful for pinpointing what caused the death. The B<-traceonly> (or
  63 just B<-t>) flag turns off the explanations of warning messages leaving just
  64 the stack traces. So if your script is dieing, run it again with
  65
  66   perl -Mdiagnostics=-traceonly my_bad_script
  67
  68 to see the call stack at the time of death. By supplying the B<-warntrace>
  69 (or just B<-w>) flag, any warnings emitted will also come with a stack
  70 trace.
  71
  72 =head2 The I<splain> Program
  73
  74 While apparently a whole nuther program, I<splain> is actually nothing
  75 more than a link to the (executable) F<diagnostics.pm> module, as well as
  76 a link to the F<diagnostics.pod> documentation.  The B<-v> flag is like
  77 the C<use diagnostics -verbose> directive.
  78 The B<-p> flag is like the
  79 $diagnostics::PRETTY variable.  Since you're post-processing with
  80 I<splain>, there's no sense in being able to enable() or disable() processing.
  81
  82 Output from I<splain> is directed to B<STDOUT>, unlike the pragma.
  83
  84 =head1 EXAMPLES
  85
  86 The following file is certain to trigger a few errors at both
  87 runtime and compiletime:
  88
  89     use diagnostics;
  90     print NOWHERE "nothing\n";
  91     print STDERR "\n\tThis message should be unadorned.\n";
  92     warn "\tThis is a user warning";
  93     print "\nDIAGNOSTIC TESTER: Please enter a <CR> here: ";
  94     my $a, $b = scalar <STDIN>;
  95     print "\n";
  96     print $x/$y;
  97
  98 If you prefer to run your program first and look at its problem
  99 afterwards, do this:
 100
 101     perl -w test.pl 2>test.out
 102     ./splain < test.out
 103
 104 Note that this is not in general possible in shells of more dubious heritage,
 105 as the theoretical
 106
 107     (perl -w test.pl >/dev/tty) >& test.out
 108     ./splain < test.out
 109
 110 Because you just moved the existing B<stdout> to somewhere else.
 111
 112 If you don't want to modify your source code, but still have on-the-fly
 113 warnings, do this:
 114
 115     exec 3>&1; perl -w test.pl 2>&1 1>&3 3>&- | splain 1>&2 3>&-
 116
 117 Nifty, eh?
 118
 119 If you want to control warnings on the fly, do something like this.
 120 Make sure you do the C<use> first, or you won't be able to get
 121 at the enable() or disable() methods.
 122
 123     use diagnostics; # checks entire compilation phase
 124         print "\ntime for 1st bogus diags: SQUAWKINGS\n";
 125         print BOGUS1 'nada';
 126         print "done with 1st bogus\n";
 127
 128     disable diagnostics; # only turns off runtime warnings
 129         print "\ntime for 2nd bogus: (squelched)\n";
 130         print BOGUS2 'nada';
 131         print "done with 2nd bogus\n";
 132
 133     enable diagnostics; # turns back on runtime warnings
 134         print "\ntime for 3rd bogus: SQUAWKINGS\n";
 135         print BOGUS3 'nada';
 136         print "done with 3rd bogus\n";
 137
 138     disable diagnostics;
 139         print "\ntime for 4th bogus: (squelched)\n";
 140         print BOGUS4 'nada';
 141         print "done with 4th bogus\n";
 142
 143 =head1 INTERNALS
 144
 145 Diagnostic messages derive from the F<perldiag.pod> file when available at
 146 runtime.  Otherwise, they may be embedded in the file itself when the
 147 splain package is built.   See the F<Makefile> for details.
 148
 149 If an extant $SIG{__WARN__} handler is discovered, it will continue
 150 to be honored, but only after the diagnostics::splainthis() function
 151 (the module's $SIG{__WARN__} interceptor) has had its way with your
 152 warnings.
 153
 154 There is a $diagnostics::DEBUG variable you may set if you're desperately
 155 curious what sorts of things are being intercepted.
 156
 157     BEGIN { $diagnostics::DEBUG = 1 }
 158
 159
 160 =head1 BUGS
 161
 162 Not being able to say "no diagnostics" is annoying, but may not be
 163 insurmountable.
 164
 165 The C<-pretty> directive is called too late to affect matters.
 166 You have to do this instead, and I<before> you load the module.
 167
 168     BEGIN { $diagnostics::PRETTY = 1 }
 169
 170 I could start up faster by delaying compilation until it should be
 171 needed, but this gets a "panic: top_level" when using the pragma form
 172 in Perl 5.001e.
 173
 174 While it's true that this documentation is somewhat subserious, if you use
 175 a program named I<splain>, you should expect a bit of whimsy.
 176
 177 =head1 AUTHOR
 178
 179 Tom Christiansen <F<tchrist@mox.perl.com>>, 25 June 1995.
 180
 181 =cut
 182
 183 use strict;
 184 use 5.009001;
 185 use Carp;
 186 $Carp::Internal{__PACKAGE__.""}++;
 187
 188 our $VERSION = '1.25';
 189 our $DEBUG;
 190 our $VERBOSE;
 191 our $PRETTY;
 192 our $TRACEONLY = 0;
 193 our $WARNTRACE = 0;
 194
 195 use Config;
 196 my($privlib, $archlib) = @Config{qw(privlibexp archlibexp)};
 197 if ($^O eq 'VMS') {
 198     require VMS::Filespec;
 199     $privlib = VMS::Filespec::unixify($privlib);
 200     $archlib = VMS::Filespec::unixify($archlib);
 201 }
 202 my @trypod = (
 203            "$archlib/pod/perldiag.pod",
 204            "$privlib/pod/perldiag-$Config{version}.pod",
 205            "$privlib/pod/perldiag.pod",
 206            "$archlib/pods/perldiag.pod",
 207            "$privlib/pods/perldiag-$Config{version}.pod",
 208            "$privlib/pods/perldiag.pod",
 209           );
 210 # handy for development testing of new warnings etc
 211 unshift @trypod, "./pod/perldiag.pod" if -e "pod/perldiag.pod";
 212 (my $PODFILE) = ((grep { -e } @trypod), $trypod[$#trypod])[0];
 213
 214 $DEBUG ||= 0;
 215 my $WHOAMI = ref bless [];  # nobody's business, prolly not even mine
 216
 217 local $| = 1;
 218 my $_;
 219 local $.;
 220
 221 my $standalone;
 222 my(%HTML_2_Troff, %HTML_2_Latin_1, %HTML_2_ASCII_7);
 223
 224 CONFIG: {
 225     our $opt_p = our $opt_d = our $opt_v = our $opt_f = '';
 226
 227     unless (caller) {
 228         $standalone++;
 229         require Getopt::Std;
 230         Getopt::Std::getopts('pdvf:')
 231             or die "Usage: $0 [-v] [-p] [-f splainpod]";
 232         $PODFILE = $opt_f if $opt_f;
 233         $DEBUG = 2 if $opt_d;
 234         $VERBOSE = $opt_v;
 235         $PRETTY = $opt_p;
 236     }
 237
 238     if (open(POD_DIAG, $PODFILE)) {
 239         warn "Happy happy podfile from real $PODFILE\n" if $DEBUG;
 240         last CONFIG;
 241     }
 242
 243     if (caller) {
 244         INCPATH: {
 245             for my $file ( (map { "$_/$WHOAMI.pm" } @INC), $0) {
 246                 warn "Checking $file\n" if $DEBUG;
 247                 if (open(POD_DIAG, $file)) {
 248                     while (<POD_DIAG>) {
 249                         next unless
 250                             /^__END__\s*# wish diag dbase were more accessible/;
 251                         print STDERR "podfile is $file\n" if $DEBUG;
 252                         last INCPATH;
 253                     }
 254                 }
 255             }
 256         }
 257     } else {
 258         print STDERR "podfile is <DATA>\n" if $DEBUG;
 259         *POD_DIAG = *main::DATA;
 260     }
 261 }
 262 if (eof(POD_DIAG)) {
 263     die "couldn't find diagnostic data in $PODFILE @INC $0";
 264 }
 265
 266
 267 %HTML_2_Troff = (
 268     'amp'       =>      '&',    #   ampersand
 269     'lt'        =>      '<',    #   left chevron, less-than
 270     'gt'        =>      '>',    #   right chevron, greater-than
 271     'quot'      =>      '"',    #   double quote
 272
 273     "Aacute"    =>      "A\\*'",        #   capital A, acute accent
 274     # etc
 275
 276 );
 277
 278 %HTML_2_Latin_1 = (
 279     'amp'       =>      '&',    #   ampersand
 280     'lt'        =>      '<',    #   left chevron, less-than
 281     'gt'        =>      '>',    #   right chevron, greater-than
 282     'quot'      =>      '"',    #   double quote
 283
 284     "Aacute"    =>      "\xC1"  #   capital A, acute accent
 285
 286     # etc
 287 );
 288
 289 %HTML_2_ASCII_7 = (
 290     'amp'       =>      '&',    #   ampersand
 291     'lt'        =>      '<',    #   left chevron, less-than
 292     'gt'        =>      '>',    #   right chevron, greater-than
 293     'quot'      =>      '"',    #   double quote
 294
 295     "Aacute"    =>      "A"     #   capital A, acute accent
 296     # etc
 297 );
 298
 299 our %HTML_Escapes;
 300 *HTML_Escapes = do {
 301     if ($standalone) {
 302         $PRETTY ? \%HTML_2_Latin_1 : \%HTML_2_ASCII_7;
 303     } else {
 304         \%HTML_2_Latin_1;
 305     }
 306 };
 307
 308 *THITHER = $standalone ? *STDOUT : *STDERR;
 309
 310 my %transfmt = ();
 311 my $transmo = <<EOFUNC;
 312 sub transmo {
 313     #local \$^W = 0;  # recursive warnings we do NOT need!
 314     study;
 315 EOFUNC
 316
 317 my %msg;
 318 {
 319     print STDERR "FINISHING COMPILATION for $_\n" if $DEBUG;
 320     local $/ = '';
 321     my $header;
 322     my @headers;
 323     my $for_item;
 324     my $seen_body;
 325     while (<POD_DIAG>) {
 326
 327         sub _split_pod_link {
 328             $_[0] =~ '(?:([^|]*)\|)?([^/]*)(?:/("?)(.*)\3)?';
 329             ($1,$2,$4);
 330         }
 331
 332         unescape();
 333         if ($PRETTY) {
 334             sub noop   { return $_[0] }  # spensive for a noop
 335             sub bold   { my $str =$_[0];  $str =~ s/(.)/$1\b$1/g; return $str; }
 336             sub italic { my $str = $_[0]; $str =~ s/(.)/_\b$1/g;  return $str; }
 337             s/C<<< (.*?) >>>|C<< (.*?) >>|[BC]<(.*?)>/bold($+)/ges;
 338             s/[IF]<(.*?)>/italic($1)/ges;
 339             s/L<(.*?)>/
 340                my($text,$page,$sect) = _split_pod_link($1);
 341                defined $text
 342                 ? $text
 343                 : defined $sect
 344                    ? italic($sect) . ' in ' . italic($page)
 345                    : italic($page)
 346              /ges;
 347              s/S<(.*?)>/
 348                $1
 349              /ges;
 350         } else {
 351             s/C<<< (.*?) >>>|C<< (.*?) >>|[BC]<(.*?)>/$+/gs;
 352             s/[IF]<(.*?)>/$1/gs;
 353             s/L<(.*?)>/
 354                my($text,$page,$sect) = _split_pod_link($1);
 355                defined $text
 356                 ? $text
 357                 : defined $sect
 358                    ? qq '"$sect" in $page'
 359                    : $page
 360              /ges;
 361             s/S<(.*?)>/
 362                $1
 363              /ges;
 364         }
 365         unless (/^=/) {
 366             if (defined $header) {
 367                 if ( $header eq 'DESCRIPTION' &&
 368                     (   /Optional warnings are enabled/
 369                      || /Some of these messages are generic./
 370                     ) )
 371                 {
 372                     next;
 373                 }
 374                 s/^/    /gm;
 375                 $msg{$header} .= $_;
 376                 for my $h(@headers) { $msg{$h} .= $_ }
 377                 ++$seen_body;
 378                 undef $for_item;
 379             }
 380             next;
 381         }
 382
 383         # If we have not come across the body of the description yet, then
 384         # the previous header needs to share the same description.
 385         if ($seen_body) {
 386             @headers = ();
 387         }
 388         else {
 389             push @headers, $header if defined $header;
 390         }
 391
 392         unless ( s/=item (.*?)\s*\z//) {
 393
 394             if ( s/=head1\sDESCRIPTION//) {
 395                 $msg{$header = 'DESCRIPTION'} = '';
 396                 undef $for_item;
 397             }
 398             elsif( s/^=for\s+diagnostics\s*\n(.*?)\s*\z// ) {
 399                 $for_item = $1;
 400             }
 401             next;
 402         }
 403
 404         if( $for_item ) { $header = $for_item; undef $for_item }
 405         else {
 406             $header = $1;
 407             while( $header =~ /[;,]\z/ ) {
 408                 <POD_DIAG> =~ /^\s*(.*?)\s*\z/;
 409                 $header .= ' '.$1;
 410             }
 411         }
 412
 413         # strip formatting directives from =item line
 414         $header =~ s/[A-Z]<(.*?)>/$1/g;
 415
 416         # Since we strip "\.\n" when we search a warning, strip it here as well
 417         $header =~ s/\.?$//;
 418
 419         my @toks = split( /(%l?[dx]|%u|%c|%(?:\.\d+)?[fs])/, $header );
 420         if (@toks > 1) {
 421             my $conlen = 0;
 422             for my $i (0..$#toks){
 423                 if( $i % 2 ){
 424                     if(      $toks[$i] eq '%c' ){
 425                         $toks[$i] = '.';
 426                     } elsif( $toks[$i] =~ /^%(?:d|u)$/ ){
 427                         $toks[$i] = '\d+';
 428                     } elsif( $toks[$i] =~ '^%(?:s|.*f)$' ){
 429                         $toks[$i] = $i == $#toks ? '.*' : '.*?';
 430                     } elsif( $toks[$i] =~ '%.(\d+)s' ){
 431                         $toks[$i] = ".{$1}";
 432                     } elsif( $toks[$i] =~ '^%l*x$' ){
 433                         $toks[$i] = '[\da-f]+';
 434                     }
 435                 } elsif( length( $toks[$i] ) ){
 436                     $toks[$i] = quotemeta $toks[$i];
 437                     $conlen += length( $toks[$i] );
 438                 }
 439             }
 440             my $lhs = join( '', @toks );
 441             $transfmt{$header}{pat} =
 442               "    s{^$lhs}\n     {\Q$header\E}s\n\t&& return 1;\n";
 443             $transfmt{$header}{len} = $conlen;
 444         } else {
 445             $transfmt{$header}{pat} =
 446               "    m{^\Q$header\E} && return 1;\n";
 447             $transfmt{$header}{len} = length( $header );
 448         }
 449
 450         print STDERR "$WHOAMI: Duplicate entry: \"$header\"\n"
 451             if $msg{$header};
 452
 453         $msg{$header} = '';
 454         $seen_body = 0;
 455     }
 456
 457
 458     close POD_DIAG unless *main::DATA eq *POD_DIAG;
 459
 460     die "No diagnostics?" unless %msg;
 461
 462     # Apply patterns in order of decreasing sum of lengths of fixed parts
 463     # Seems the best way of hitting the right one.
 464     for my $hdr ( sort { $transfmt{$b}{len} <=> $transfmt{$a}{len} }
 465                   keys %transfmt ){
 466         $transmo .= $transfmt{$hdr}{pat};
 467     }
 468     $transmo .= "    return 0;\n}\n";
 469     print STDERR $transmo if $DEBUG;
 470     eval $transmo;
 471     die $@ if $@;
 472 }
 473
 474 if ($standalone) {
 475     if (!@ARGV and -t STDIN) { print STDERR "$0: Reading from STDIN\n" }
 476     while (defined (my $error = <>)) {
 477         splainthis($error) || print THITHER $error;
 478     }
 479     exit;
 480 }
 481
 482 my $olddie;
 483 my $oldwarn;
 484
 485 sub import {
 486     shift;
 487     $^W = 1; # yup, clobbered the global variable;
 488              # tough, if you want diags, you want diags.
 489     return if defined $SIG{__WARN__} && ($SIG{__WARN__} eq \&warn_trap);
 490
 491     for (@_) {
 492
 493         /^-d(ebug)?$/           && do {
 494                                     $DEBUG++;
 495                                     next;
 496                                    };
 497
 498         /^-v(erbose)?$/         && do {
 499                                     $VERBOSE++;
 500                                     next;
 501                                    };
 502
 503         /^-p(retty)?$/          && do {
 504                                     print STDERR "$0: I'm afraid it's too late for prettiness.\n";
 505                                     $PRETTY++;
 506                                     next;
 507                                };
 508         # matches trace and traceonly for legacy doc mixup reasons
 509         /^-t(race(only)?)?$/    && do {
 510                                     $TRACEONLY++;
 511                                     next;
 512                                };
 513         /^-w(arntrace)?$/       && do {
 514                                     $WARNTRACE++;
 515                                     next;
 516                                };
 517
 518         warn "Unknown flag: $_";
 519     }
 520
 521     $oldwarn = $SIG{__WARN__};
 522     $olddie = $SIG{__DIE__};
 523     $SIG{__WARN__} = \&warn_trap;
 524     $SIG{__DIE__} = \&death_trap;
 525 }
 526
 527 sub enable { &import }
 528
 529 sub disable {
 530     shift;
 531     return unless $SIG{__WARN__} eq \&warn_trap;
 532     $SIG{__WARN__} = $oldwarn || '';
 533     $SIG{__DIE__} = $olddie || '';
 534 }
 535
 536 sub warn_trap {
 537     my $warning = $_[0];
 538     if (caller eq $WHOAMI or !splainthis($warning)) {
 539         if ($WARNTRACE) {
 540             print STDERR Carp::longmess($warning);
 541         } else {
 542             print STDERR $warning;
 543         }
 544     }
 545     goto &$oldwarn if defined $oldwarn and $oldwarn and $oldwarn ne \&warn_trap;
 546 };
 547
 548 sub death_trap {
 549     my $exception = $_[0];
 550
 551     # See if we are coming from anywhere within an eval. If so we don't
 552     # want to explain the exception because it's going to get caught.
 553     my $in_eval = 0;
 554     my $i = 0;
 555     while (my $caller = (caller($i++))[3]) {
 556       if ($caller eq '(eval)') {
 557         $in_eval = 1;
 558         last;
 559       }
 560     }
 561
 562     splainthis($exception) unless $in_eval;
 563     if (caller eq $WHOAMI) { print STDERR "INTERNAL EXCEPTION: $exception"; }
 564     &$olddie if defined $olddie and $olddie and $olddie ne \&death_trap;
 565
 566     return if $in_eval;
 567
 568     # We don't want to unset these if we're coming from an eval because
 569     # then we've turned off diagnostics.
 570
 571     # Switch off our die/warn handlers so we don't wind up in our own
 572     # traps.
 573     $SIG{__DIE__} = $SIG{__WARN__} = '';
 574
 575     # Have carp skip over death_trap() when showing the stack trace.
 576     local($Carp::CarpLevel) = 1;
 577
 578     confess "Uncaught exception from user code:\n\t$exception";
 579         # up we go; where we stop, nobody knows, but i think we die now
 580         # but i'm deeply afraid of the &$olddie guy reraising and us getting
 581         # into an indirect recursion loop
 582 };
 583
 584 my %exact_duplicate;
 585 my %old_diag;
 586 my $count;
 587 my $wantspace;
 588 sub splainthis {
 589     return 0 if $TRACEONLY;
 590     $_ = shift;
 591     local $\;
 592     local $!;
 593     ### &finish_compilation unless %msg;
 594     s/\.?\n+$//;
 595     my $orig = $_;
 596     # return unless defined;
 597
 598     # get rid of the where-are-we-in-input part
 599     s/, <.*?> (?:line|chunk).*$//;
 600
 601     # Discard 1st " at <file> line <no>" and all text beyond
 602     # but be aware of messages containing " at this-or-that"
 603     my $real = 0;
 604     my @secs = split( / at / );
 605     return unless @secs;
 606     $_ = $secs[0];
 607     for my $i ( 1..$#secs ){
 608         if( $secs[$i] =~ /.+? (?:line|chunk) \d+/ ){
 609             $real = 1;
 610             last;
 611         } else {
 612             $_ .= ' at ' . $secs[$i];
 613         }
 614     }
 615
 616     # remove parenthesis occurring at the end of some messages
 617     s/^\((.*)\)$/$1/;
 618
 619     if ($exact_duplicate{$orig}++) {
 620         return &transmo;
 621     } else {
 622         return 0 unless &transmo;
 623     }
 624
 625     $orig = shorten($orig);
 626     if ($old_diag{$_}) {
 627         autodescribe();
 628         print THITHER "$orig (#$old_diag{$_})\n";
 629         $wantspace = 1;
 630     } else {
 631         autodescribe();
 632         $old_diag{$_} = ++$count;
 633         print THITHER "\n" if $wantspace;
 634         $wantspace = 0;
 635         print THITHER "$orig (#$old_diag{$_})\n";
 636         if ($msg{$_}) {
 637             print THITHER $msg{$_};
 638         } else {
 639             if (0 and $standalone) {
 640                 print THITHER "    **** Error #$old_diag{$_} ",
 641                         ($real ? "is" : "appears to be"),
 642                         " an unknown diagnostic message.\n\n";
 643             }
 644             return 0;
 645         }
 646     }
 647     return 1;
 648 }
 649
 650 sub autodescribe {
 651     if ($VERBOSE and not $count) {
 652         print THITHER &{$PRETTY ? \&bold : \&noop}("DESCRIPTION OF DIAGNOSTICS"),
 653                 "\n$msg{DESCRIPTION}\n";
 654     }
 655 }
 656
 657 sub unescape {
 658     s {
 659             E<
 660             ( [A-Za-z]+ )
 661             >
 662     } {
 663          do {
 664              exists $HTML_Escapes{$1}
 665                 ? do { $HTML_Escapes{$1} }
 666                 : do {
 667                     warn "Unknown escape: E<$1> in $_";
 668                     "E<$1>";
 669                 }
 670          }
 671     }egx;
 672 }
 673
 674 sub shorten {
 675     my $line = $_[0];
 676     if (length($line) > 79 and index($line, "\n") == -1) {
 677         my $space_place = rindex($line, ' ', 79);
 678         if ($space_place != -1) {
 679             substr($line, $space_place, 1) = "\n\t";
 680         }
 681     }
 682     return $line;
 683 }
 684
 685
 686 1 unless $standalone;  # or it'll complain about itself
 687 __END__ # wish diag dbase were more accessible