diff options
Diffstat (limited to 'contrib/perl5/lib/warnings.pm')
-rw-r--r-- | contrib/perl5/lib/warnings.pm | 318 |
1 files changed, 0 insertions, 318 deletions
diff --git a/contrib/perl5/lib/warnings.pm b/contrib/perl5/lib/warnings.pm deleted file mode 100644 index 11558d50d4426..0000000000000 --- a/contrib/perl5/lib/warnings.pm +++ /dev/null @@ -1,318 +0,0 @@ - -# This file was created by warnings.pl -# Any changes made here will be lost. -# - -package warnings; - -=head1 NAME - -warnings - Perl pragma to control optional warnings - -=head1 SYNOPSIS - - use warnings; - no warnings; - - use warnings "all"; - no warnings "all"; - - use warnings::register; - if (warnings::enabled()) { - warnings::warn("some warning"); - } - - if (warnings::enabled("void")) { - warnings::warn("void", "some warning"); - } - -=head1 DESCRIPTION - -If no import list is supplied, all possible warnings are either enabled -or disabled. - -A number of functions are provided to assist module authors. - -=over 4 - -=item use warnings::register - -Creates a new warnings category which has the same name as the module -where the call to the pragma is used. - -=item warnings::enabled([$category]) - -Returns TRUE if the warnings category C<$category> is enabled in the -calling module. Otherwise returns FALSE. - -If the parameter, C<$category>, isn't supplied, the current package name -will be used. - -=item warnings::warn([$category,] $message) - -If the calling module has I<not> set C<$category> to "FATAL", print -C<$message> to STDERR. -If the calling module has set C<$category> to "FATAL", print C<$message> -STDERR then die. - -If the parameter, C<$category>, isn't supplied, the current package name -will be used. - -=back - -See L<perlmod/Pragmatic Modules> and L<perllexwarn>. - -=cut - -use Carp ; - -%Offsets = ( - 'all' => 0, - 'chmod' => 2, - 'closure' => 4, - 'exiting' => 6, - 'glob' => 8, - 'io' => 10, - 'closed' => 12, - 'exec' => 14, - 'newline' => 16, - 'pipe' => 18, - 'unopened' => 20, - 'misc' => 22, - 'numeric' => 24, - 'once' => 26, - 'overflow' => 28, - 'pack' => 30, - 'portable' => 32, - 'recursion' => 34, - 'redefine' => 36, - 'regexp' => 38, - 'severe' => 40, - 'debugging' => 42, - 'inplace' => 44, - 'internal' => 46, - 'malloc' => 48, - 'signal' => 50, - 'substr' => 52, - 'syntax' => 54, - 'ambiguous' => 56, - 'bareword' => 58, - 'deprecated' => 60, - 'digit' => 62, - 'parenthesis' => 64, - 'precedence' => 66, - 'printf' => 68, - 'prototype' => 70, - 'qw' => 72, - 'reserved' => 74, - 'semicolon' => 76, - 'taint' => 78, - 'umask' => 80, - 'uninitialized' => 82, - 'unpack' => 84, - 'untie' => 86, - 'utf8' => 88, - 'void' => 90, - 'y2k' => 92, - ); - -%Bits = ( - 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..46] - 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [28] - 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29] - 'chmod' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1] - 'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6] - 'closure' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2] - 'debugging' => "\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [21] - 'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30] - 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31] - 'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7] - 'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3] - 'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4] - 'inplace' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22] - 'internal' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23] - 'io' => "\x00\x54\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..10] - 'malloc' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24] - 'misc' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11] - 'newline' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8] - 'numeric' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12] - 'once' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13] - 'overflow' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14] - 'pack' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15] - 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32] - 'pipe' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9] - 'portable' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16] - 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33] - 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34] - 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35] - 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36] - 'recursion' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17] - 'redefine' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18] - 'regexp' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19] - 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37] - 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38] - 'severe' => "\x00\x00\x00\x00\x00\x55\x01\x00\x00\x00\x00\x00", # [20..24] - 'signal' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25] - 'substr' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26] - 'syntax' => "\x00\x00\x00\x00\x00\x00\x40\x55\x55\x15\x00\x00", # [27..38] - 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39] - 'umask' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40] - 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41] - 'unopened' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10] - 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42] - 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43] - 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44] - 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45] - 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46] - ); - -%DeadBits = ( - 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..46] - 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [28] - 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29] - 'chmod' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1] - 'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6] - 'closure' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2] - 'debugging' => "\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [21] - 'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30] - 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31] - 'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7] - 'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3] - 'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4] - 'inplace' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22] - 'internal' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23] - 'io' => "\x00\xa8\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..10] - 'malloc' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24] - 'misc' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11] - 'newline' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8] - 'numeric' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12] - 'once' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13] - 'overflow' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14] - 'pack' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15] - 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32] - 'pipe' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9] - 'portable' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16] - 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33] - 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34] - 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35] - 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36] - 'recursion' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17] - 'redefine' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18] - 'regexp' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19] - 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37] - 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38] - 'severe' => "\x00\x00\x00\x00\x00\xaa\x02\x00\x00\x00\x00\x00", # [20..24] - 'signal' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25] - 'substr' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26] - 'syntax' => "\x00\x00\x00\x00\x00\x00\x80\xaa\xaa\x2a\x00\x00", # [27..38] - 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39] - 'umask' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40] - 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41] - 'unopened' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10] - 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42] - 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43] - 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44] - 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45] - 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [46] - ); - -$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0"; -$LAST_BIT = 94 ; -$BYTES = 12 ; - -$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ; - -sub bits { - my $mask ; - my $catmask ; - my $fatal = 0 ; - foreach my $word (@_) { - if ($word eq 'FATAL') { - $fatal = 1; - } - elsif ($catmask = $Bits{$word}) { - $mask |= $catmask ; - $mask |= $DeadBits{$word} if $fatal ; - } - else - { croak("unknown warnings category '$word'")} - } - - return $mask ; -} - -sub import { - shift; - ${^WARNING_BITS} |= bits(@_ ? @_ : 'all') ; -} - -sub unimport { - shift; - my $mask = ${^WARNING_BITS} ; - if (vec($mask, $Offsets{'all'}, 1)) { - $mask = $Bits{'all'} ; - $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1); - } - ${^WARNING_BITS} = $mask & ~ (bits(@_ ? @_ : 'all') | $All) ; -} - -sub enabled -{ - croak("Usage: warnings::enabled([category])") - unless @_ == 1 || @_ == 0 ; - local $Carp::CarpLevel = 1 ; - my $category ; - my $offset ; - my $callers_bitmask = (caller(1))[9] ; - return 0 unless defined $callers_bitmask ; - - - if (@_) { - # check the category supplied. - $category = shift ; - $offset = $Offsets{$category}; - croak("unknown warnings category '$category'") - unless defined $offset; - } - else { - $category = (caller(0))[0] ; - $offset = $Offsets{$category}; - croak("package '$category' not registered for warnings") - unless defined $offset ; - } - - return vec($callers_bitmask, $offset, 1) || - vec($callers_bitmask, $Offsets{'all'}, 1) ; -} - - -sub warn -{ - croak("Usage: warnings::warn([category,] 'message')") - unless @_ == 2 || @_ == 1 ; - local $Carp::CarpLevel = 1 ; - my $category ; - my $offset ; - my $callers_bitmask = (caller(1))[9] ; - - if (@_ == 2) { - $category = shift ; - $offset = $Offsets{$category}; - croak("unknown warnings category '$category'") - unless defined $offset ; - } - else { - $category = (caller(0))[0] ; - $offset = $Offsets{$category}; - croak("package '$category' not registered for warnings") - unless defined $offset ; - } - - my $message = shift ; - croak($message) - if vec($callers_bitmask, $offset+1, 1) || - vec($callers_bitmask, $Offsets{'all'}+1, 1) ; - carp($message) ; -} - -1; |