lib/warnings.pm

   1 # -*- buffer-read-only: t -*-
   2 # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
   3 # This file was created by warnings.pl
   4 # Any changes made here will be lost.
   5 #
   6
   7 package warnings;
   8
   9 our $VERSION = '1.06';
  10
  11 # Verify that we're called correctly so that warnings will work.
  12 # see also strict.pm.
  13 unless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) {
  14     my (undef, $f, $l) = caller;
  15     die("Incorrect use of pragma '${\__PACKAGE__}' at $f line $l.\n");
  16 }
  17
  18 =head1 NAME
  19
  20 warnings - Perl pragma to control optional warnings
  21
  22 =head1 SYNOPSIS
  23
  24     use warnings;
  25     no warnings;
  26
  27     use warnings "all";
  28     no warnings "all";
  29
  30     use warnings::register;
  31     if (warnings::enabled()) {
  32         warnings::warn("some warning");
  33     }
  34
  35     if (warnings::enabled("void")) {
  36         warnings::warn("void", "some warning");
  37     }
  38
  39     if (warnings::enabled($object)) {
  40         warnings::warn($object, "some warning");
  41     }
  42
  43     warnings::warnif("some warning");
  44     warnings::warnif("void", "some warning");
  45     warnings::warnif($object, "some warning");
  46
  47 =head1 DESCRIPTION
  48
  49 The C<warnings> pragma is a replacement for the command line flag C<-w>,
  50 but the pragma is limited to the enclosing block, while the flag is global.
  51 See L<perllexwarn> for more information.
  52
  53 If no import list is supplied, all possible warnings are either enabled
  54 or disabled.
  55
  56 A number of functions are provided to assist module authors.
  57
  58 =over 4
  59
  60 =item use warnings::register
  61
  62 Creates a new warnings category with the same name as the package where
  63 the call to the pragma is used.
  64
  65 =item warnings::enabled()
  66
  67 Use the warnings category with the same name as the current package.
  68
  69 Return TRUE if that warnings category is enabled in the calling module.
  70 Otherwise returns FALSE.
  71
  72 =item warnings::enabled($category)
  73
  74 Return TRUE if the warnings category, C<$category>, is enabled in the
  75 calling module.
  76 Otherwise returns FALSE.
  77
  78 =item warnings::enabled($object)
  79
  80 Use the name of the class for the object reference, C<$object>, as the
  81 warnings category.
  82
  83 Return TRUE if that warnings category is enabled in the first scope
  84 where the object is used.
  85 Otherwise returns FALSE.
  86
  87 =item warnings::warn($message)
  88
  89 Print C<$message> to STDERR.
  90
  91 Use the warnings category with the same name as the current package.
  92
  93 If that warnings category has been set to "FATAL" in the calling module
  94 then die. Otherwise return.
  95
  96 =item warnings::warn($category, $message)
  97
  98 Print C<$message> to STDERR.
  99
 100 If the warnings category, C<$category>, has been set to "FATAL" in the
 101 calling module then die. Otherwise return.
 102
 103 =item warnings::warn($object, $message)
 104
 105 Print C<$message> to STDERR.
 106
 107 Use the name of the class for the object reference, C<$object>, as the
 108 warnings category.
 109
 110 If that warnings category has been set to "FATAL" in the scope where C<$object>
 111 is first used then die. Otherwise return.
 112
 113
 114 =item warnings::warnif($message)
 115
 116 Equivalent to:
 117
 118     if (warnings::enabled())
 119       { warnings::warn($message) }
 120
 121 =item warnings::warnif($category, $message)
 122
 123 Equivalent to:
 124
 125     if (warnings::enabled($category))
 126       { warnings::warn($category, $message) }
 127
 128 =item warnings::warnif($object, $message)
 129
 130 Equivalent to:
 131
 132     if (warnings::enabled($object))
 133       { warnings::warn($object, $message) }
 134
 135 =back
 136
 137 See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
 138
 139 =cut
 140
 141 our %Offsets = (
 142
 143     # Warnings Categories added in Perl 5.008
 144
 145     'all'               => 0,
 146     'closure'           => 2,
 147     'deprecated'        => 4,
 148     'exiting'           => 6,
 149     'glob'              => 8,
 150     'io'                => 10,
 151     'closed'            => 12,
 152     'exec'              => 14,
 153     'layer'             => 16,
 154     'newline'           => 18,
 155     'pipe'              => 20,
 156     'unopened'          => 22,
 157     'misc'              => 24,
 158     'numeric'           => 26,
 159     'once'              => 28,
 160     'overflow'          => 30,
 161     'pack'              => 32,
 162     'portable'          => 34,
 163     'recursion'         => 36,
 164     'redefine'          => 38,
 165     'regexp'            => 40,
 166     'severe'            => 42,
 167     'debugging'         => 44,
 168     'inplace'           => 46,
 169     'internal'          => 48,
 170     'malloc'            => 50,
 171     'signal'            => 52,
 172     'substr'            => 54,
 173     'syntax'            => 56,
 174     'ambiguous'         => 58,
 175     'bareword'          => 60,
 176     'digit'             => 62,
 177     'parenthesis'       => 64,
 178     'precedence'        => 66,
 179     'printf'            => 68,
 180     'prototype'         => 70,
 181     'qw'                => 72,
 182     'reserved'          => 74,
 183     'semicolon'         => 76,
 184     'taint'             => 78,
 185     'threads'           => 80,
 186     'uninitialized'     => 82,
 187     'unpack'            => 84,
 188     'untie'             => 86,
 189     'utf8'              => 88,
 190     'void'              => 90,
 191
 192     # Warnings Categories added in Perl 5.011
 193
 194     'imprecision'       => 92,
 195   );
 196
 197 our %Bits = (
 198     'all'               => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..46]
 199     'ambiguous'         => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
 200     'bareword'          => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
 201     'closed'            => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
 202     'closure'           => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
 203     'debugging'         => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
 204     'deprecated'        => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
 205     'digit'             => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
 206     'exec'              => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
 207     'exiting'           => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
 208     'glob'              => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
 209     'imprecision'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46]
 210     'inplace'           => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
 211     'internal'          => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
 212     'io'                => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
 213     'layer'             => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
 214     'malloc'            => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
 215     'misc'              => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
 216     'newline'           => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
 217     'numeric'           => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
 218     'once'              => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
 219     'overflow'          => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
 220     'pack'              => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
 221     'parenthesis'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
 222     'pipe'              => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
 223     'portable'          => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
 224     'precedence'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
 225     'printf'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
 226     'prototype'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
 227     'qw'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
 228     'recursion'         => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
 229     'redefine'          => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19]
 230     'regexp'            => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20]
 231     'reserved'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
 232     'semicolon'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
 233     'severe'            => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00", # [21..25]
 234     'signal'            => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26]
 235     'substr'            => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
 236     'syntax'            => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x00", # [28..38]
 237     'taint'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
 238     'threads'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
 239     'uninitialized'     => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
 240     'unopened'          => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
 241     'unpack'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
 242     'untie'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
 243     'utf8'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
 244     'void'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
 245   );
 246
 247 our %DeadBits = (
 248     'all'               => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..46]
 249     'ambiguous'         => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
 250     'bareword'          => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
 251     'closed'            => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
 252     'closure'           => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
 253     'debugging'         => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
 254     'deprecated'        => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
 255     'digit'             => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
 256     'exec'              => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
 257     'exiting'           => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
 258     'glob'              => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
 259     'imprecision'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [46]
 260     'inplace'           => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
 261     'internal'          => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
 262     'io'                => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
 263     'layer'             => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
 264     'malloc'            => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
 265     'misc'              => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
 266     'newline'           => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
 267     'numeric'           => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
 268     'once'              => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
 269     'overflow'          => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
 270     'pack'              => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
 271     'parenthesis'       => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
 272     'pipe'              => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
 273     'portable'          => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
 274     'precedence'        => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
 275     'printf'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
 276     'prototype'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
 277     'qw'                => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
 278     'recursion'         => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
 279     'redefine'          => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19]
 280     'regexp'            => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20]
 281     'reserved'          => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
 282     'semicolon'         => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
 283     'severe'            => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00", # [21..25]
 284     'signal'            => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26]
 285     'substr'            => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
 286     'syntax'            => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x00", # [28..38]
 287     'taint'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
 288     'threads'           => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
 289     'uninitialized'     => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
 290     'unopened'          => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
 291     'unpack'            => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
 292     'untie'             => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
 293     'utf8'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
 294     'void'              => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
 295   );
 296
 297 $NONE     = "\0\0\0\0\0\0\0\0\0\0\0\0";
 298 $LAST_BIT = 94 ;
 299 $BYTES    = 12 ;
 300
 301 $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
 302
 303 sub Croaker
 304 {
 305     require Carp::Heavy; # this initializes %CarpInternal
 306     local $Carp::CarpInternal{'warnings'};
 307     delete $Carp::CarpInternal{'warnings'};
 308     Carp::croak(@_);
 309 }
 310
 311 sub bits
 312 {
 313     # called from B::Deparse.pm
 314
 315     push @_, 'all' unless @_;
 316
 317     my $mask;
 318     my $catmask ;
 319     my $fatal = 0 ;
 320     my $no_fatal = 0 ;
 321
 322     foreach my $word ( @_ ) {
 323         if ($word eq 'FATAL') {
 324             $fatal = 1;
 325             $no_fatal = 0;
 326         }
 327         elsif ($word eq 'NONFATAL') {
 328             $fatal = 0;
 329             $no_fatal = 1;
 330         }
 331         elsif ($catmask = $Bits{$word}) {
 332             $mask |= $catmask ;
 333             $mask |= $DeadBits{$word} if $fatal ;
 334             $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
 335         }
 336         else
 337           { Croaker("Unknown warnings category '$word'")}
 338     }
 339
 340     return $mask ;
 341 }
 342
 343 sub import
 344 {
 345     shift;
 346
 347     my $catmask ;
 348     my $fatal = 0 ;
 349     my $no_fatal = 0 ;
 350
 351     my $mask = ${^WARNING_BITS} ;
 352
 353     if (vec($mask, $Offsets{'all'}, 1)) {
 354         $mask |= $Bits{'all'} ;
 355         $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
 356     }
 357
 358     push @_, 'all' unless @_;
 359
 360     foreach my $word ( @_ ) {
 361         if ($word eq 'FATAL') {
 362             $fatal = 1;
 363             $no_fatal = 0;
 364         }
 365         elsif ($word eq 'NONFATAL') {
 366             $fatal = 0;
 367             $no_fatal = 1;
 368         }
 369         elsif ($catmask = $Bits{$word}) {
 370             $mask |= $catmask ;
 371             $mask |= $DeadBits{$word} if $fatal ;
 372             $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
 373         }
 374         else
 375           { Croaker("Unknown warnings category '$word'")}
 376     }
 377
 378     ${^WARNING_BITS} = $mask ;
 379 }
 380
 381 sub unimport
 382 {
 383     shift;
 384
 385     my $catmask ;
 386     my $mask = ${^WARNING_BITS} ;
 387
 388     if (vec($mask, $Offsets{'all'}, 1)) {
 389         $mask |= $Bits{'all'} ;
 390         $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
 391     }
 392
 393     push @_, 'all' unless @_;
 394
 395     foreach my $word ( @_ ) {
 396         if ($word eq 'FATAL') {
 397             next;
 398         }
 399         elsif ($catmask = $Bits{$word}) {
 400             $mask &= ~($catmask | $DeadBits{$word} | $All);
 401         }
 402         else
 403           { Croaker("Unknown warnings category '$word'")}
 404     }
 405
 406     ${^WARNING_BITS} = $mask ;
 407 }
 408
 409 my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
 410
 411 sub __chk
 412 {
 413     my $category ;
 414     my $offset ;
 415     my $isobj = 0 ;
 416
 417     if (@_) {
 418         # check the category supplied.
 419         $category = shift ;
 420         if (my $type = ref $category) {
 421             Croaker("not an object")
 422                 if exists $builtin_type{$type};
 423             $category = $type;
 424             $isobj = 1 ;
 425         }
 426         $offset = $Offsets{$category};
 427         Croaker("Unknown warnings category '$category'")
 428             unless defined $offset;
 429     }
 430     else {
 431         $category = (caller(1))[0] ;
 432         $offset = $Offsets{$category};
 433         Croaker("package '$category' not registered for warnings")
 434             unless defined $offset ;
 435     }
 436
 437     my $this_pkg = (caller(1))[0] ;
 438     my $i = 2 ;
 439     my $pkg ;
 440
 441     if ($isobj) {
 442         while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
 443             last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
 444         }
 445         $i -= 2 ;
 446     }
 447     else {
 448         $i = _error_loc(); # see where Carp will allocate the error
 449     }
 450
 451     my $callers_bitmask = (caller($i))[9] ;
 452     return ($callers_bitmask, $offset, $i) ;
 453 }
 454
 455 sub _error_loc {
 456     require Carp::Heavy;
 457     goto &Carp::short_error_loc; # don't introduce another stack frame
 458 }
 459
 460 sub enabled
 461 {
 462     Croaker("Usage: warnings::enabled([category])")
 463         unless @_ == 1 || @_ == 0 ;
 464
 465     my ($callers_bitmask, $offset, $i) = __chk(@_) ;
 466
 467     return 0 unless defined $callers_bitmask ;
 468     return vec($callers_bitmask, $offset, 1) ||
 469            vec($callers_bitmask, $Offsets{'all'}, 1) ;
 470 }
 471
 472
 473 sub warn
 474 {
 475     Croaker("Usage: warnings::warn([category,] 'message')")
 476         unless @_ == 2 || @_ == 1 ;
 477
 478     my $message = pop ;
 479     my ($callers_bitmask, $offset, $i) = __chk(@_) ;
 480     require Carp;
 481     Carp::croak($message)
 482         if vec($callers_bitmask, $offset+1, 1) ||
 483            vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
 484     Carp::carp($message) ;
 485 }
 486
 487 sub warnif
 488 {
 489     Croaker("Usage: warnings::warnif([category,] 'message')")
 490         unless @_ == 2 || @_ == 1 ;
 491
 492     my $message = pop ;
 493     my ($callers_bitmask, $offset, $i) = __chk(@_) ;
 494
 495     return
 496         unless defined $callers_bitmask &&
 497                 (vec($callers_bitmask, $offset, 1) ||
 498                 vec($callers_bitmask, $Offsets{'all'}, 1)) ;
 499
 500     require Carp;
 501     Carp::croak($message)
 502         if vec($callers_bitmask, $offset+1, 1) ||
 503            vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
 504
 505     Carp::carp($message) ;
 506 }
 507
 508 1;
 509 # ex: set ro: