[p5sagit/p5-mst-13.2.git] / lib / warnings.pm


# 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";

    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.

Two functions are provided to assist module authors.

=over 4

=item warnings::enabled($category)

Returns TRUE if the warnings category in C<$category> is enabled in the
calling module. Otherwise returns FALSE.


=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.

=back

See L<perlmod/Pragmatic Modules> and L<perllexwarn>.

=cut

use Carp ;

%Bits = (
    'all'		=> "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..47]
    'ambiguous'		=> "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
    'bareword'		=> "\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [28]
    'chmod'		=> "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [0]
    'closed'		=> "\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5]
    'closure'		=> "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
    'debugging'		=> "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20]
    'deprecated'	=> "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
    'digit'		=> "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
    'exec'		=> "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
    'exiting'		=> "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
    'glob'		=> "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
    'inplace'		=> "\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [21]
    'internal'		=> "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
    'io'		=> "\x00\x55\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4..9]
    'malloc'		=> "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
    'misc'		=> "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
    'newline'		=> "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
    'numeric'		=> "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
    'once'		=> "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
    'overflow'		=> "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
    'pack'		=> "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
    'parenthesis'	=> "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
    'pipe'		=> "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
    'portable'		=> "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
    'precedence'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
    'printf'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
    'prototype'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
    'qw'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
    'recursion'		=> "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
    'redefine'		=> "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
    'regexp'		=> "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
    'reserved'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
    'semicolon'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
    'severe'		=> "\x00\x00\x00\x00\x40\x55\x00\x00\x00\x00\x00\x00", # [19..23]
    'signal'		=> "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
    'substr'		=> "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
    'syntax'		=> "\x00\x00\x00\x00\x00\x00\x50\x55\x55\x05\x00\x00", # [26..37]
    'taint'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
    'umask'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
    'uninitialized'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
    'unopened'		=> "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
    'unpack'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
    'untie'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
    'utf8'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
    'void'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
    'y2k'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
  );

%DeadBits = (
    'all'		=> "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..47]
    'ambiguous'		=> "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
    'bareword'		=> "\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [28]
    'chmod'		=> "\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [0]
    'closed'		=> "\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5]
    'closure'		=> "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
    'debugging'		=> "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20]
    'deprecated'	=> "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
    'digit'		=> "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
    'exec'		=> "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
    'exiting'		=> "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
    'glob'		=> "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
    'inplace'		=> "\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [21]
    'internal'		=> "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
    'io'		=> "\x00\xaa\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4..9]
    'malloc'		=> "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
    'misc'		=> "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
    'newline'		=> "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
    'numeric'		=> "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
    'once'		=> "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
    'overflow'		=> "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
    'pack'		=> "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
    'parenthesis'	=> "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
    'pipe'		=> "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
    'portable'		=> "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
    'precedence'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
    'printf'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
    'prototype'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
    'qw'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
    'recursion'		=> "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
    'redefine'		=> "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
    'regexp'		=> "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
    'reserved'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
    'semicolon'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
    'severe'		=> "\x00\x00\x00\x00\x80\xaa\x00\x00\x00\x00\x00\x00", # [19..23]
    'signal'		=> "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
    'substr'		=> "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
    'syntax'		=> "\x00\x00\x00\x00\x00\x00\xa0\xaa\xaa\x0a\x00\x00", # [26..37]
    'taint'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
    'umask'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
    'uninitialized'	=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
    'unopened'		=> "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
    'unpack'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
    'untie'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
    'utf8'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
    'void'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
    'y2k'		=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
  );

$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";

sub bits {
    my $mask ;
    my $catmask ;
    my $fatal = 0 ;
    foreach my $word (@_) {
	if  ($word eq 'FATAL') {
	    $fatal = 1;
	}
	else {
	    if ($catmask = $Bits{$word}) {
		$mask |= $catmask ;
		$mask |= $DeadBits{$word} if $fatal ;
	    }
	}
    }

    return $mask ;
}

sub import {
    shift;
    ${^WARNING_BITS} |= bits(@_ ? @_ : 'all') ;
}

sub unimport {
    shift;
    ${^WARNING_BITS} &= ~ bits(@_ ? @_ : 'all') ;
}

sub enabled
{
    # If no parameters, check for any lexical warnings enabled
    # in the users scope.
    my $callers_bitmask = (caller(1))[9] ; 
    return ($callers_bitmask ne $NONE) if @_ == 0 ;

    # otherwise check for the category supplied.
    my $category = shift ;
    return 0
	unless $Bits{$category} ;
    return 0 unless defined $callers_bitmask ;
    return 1
	if ($callers_bitmask & $Bits{$category}) ne $NONE ;
   
    return 0 ; 
}

sub warn
{
    croak "Usage: warnings::warn('category', 'message')"
	unless @_ == 2 ;
    my $category = shift ;
    my $message = shift ;
    local $Carp::CarpLevel = 1 ;
    my $callers_bitmask = (caller(1))[9] ; 
    croak($message) 
	if defined $callers_bitmask &&
           ($callers_bitmask & $DeadBits{$category}) ne $NONE ;
    carp($message) ;
}

1;
Commit	Line	Data
599cee73	1
4438c4b7	2	# This file was created by warnings.pl
599cee73	3	# Any changes made here will be lost.
	4	#
	5
4438c4b7	6	package warnings;
599cee73	7
	8	=head1 NAME
	9
4438c4b7	10	warnings - Perl pragma to control optional warnings
599cee73	11
	12	=head1 SYNOPSIS
	13
4438c4b7	14	use warnings;
4438c4b7	15	no warnings;
599cee73	16
4438c4b7	17	use warnings "all";
4438c4b7	18	no warnings "all";
599cee73	19
e476b1b5	20	if (warnings::enabled("void") {
	21	warnings::warn("void", "some warning");
	22	}
	23
599cee73	24	=head1 DESCRIPTION
599cee73	25
0453d815	26	If no import list is supplied, all possible warnings are either enabled
0453d815	27	or disabled.
599cee73	28
e476b1b5	29	Two functions are provided to assist module authors.
	30
	31	=over 4
	32
	33	=item warnings::enabled($category)
	34
	35	Returns TRUE if the warnings category in C<$category> is enabled in the
	36	calling module. Otherwise returns FALSE.
	37
	38
	39	=item warnings::warn($category, $message)
599cee73	40
e476b1b5	41	If the calling module has I<not> set C<$category> to "FATAL", print
	42	C<$message> to STDERR.
	43	If the calling module has set C<$category> to "FATAL", print C<$message>
	44	STDERR then die.
	45
	46	=back
	47
	48	See L<perlmod/Pragmatic Modules> and L<perllexwarn>.
599cee73	49
	50	=cut
	51
	52	use Carp ;
	53
	54	%Bits = (
e476b1b5	55	'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..47]
	56	'ambiguous' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
	57	'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [28]
	58	'chmod' => "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [0]
	59	'closed' => "\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5]
	60	'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
	61	'debugging' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20]
	62	'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
	63	'digit' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
	64	'exec' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
	65	'exiting' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
	66	'glob' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
	67	'inplace' => "\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [21]
	68	'internal' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
	69	'io' => "\x00\x55\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4..9]
	70	'malloc' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
	71	'misc' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
	72	'newline' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
	73	'numeric' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
	74	'once' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
	75	'overflow' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
	76	'pack' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
	77	'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
	78	'pipe' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
	79	'portable' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
	80	'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
	81	'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
	82	'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
	83	'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
	84	'recursion' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
	85	'redefine' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
	86	'regexp' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
	87	'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
	88	'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
	89	'severe' => "\x00\x00\x00\x00\x40\x55\x00\x00\x00\x00\x00\x00", # [19..23]
	90	'signal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
	91	'substr' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
	92	'syntax' => "\x00\x00\x00\x00\x00\x00\x50\x55\x55\x05\x00\x00", # [26..37]
	93	'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
	94	'umask' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
	95	'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
	96	'unopened' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
	97	'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
	98	'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
	99	'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
	100	'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
	101	'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
599cee73	102	);
	103
	104	%DeadBits = (
e476b1b5	105	'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..47]
	106	'ambiguous' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
	107	'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [28]
	108	'chmod' => "\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [0]
	109	'closed' => "\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5]
	110	'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
	111	'debugging' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20]
	112	'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
	113	'digit' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
	114	'exec' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
	115	'exiting' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
	116	'glob' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
	117	'inplace' => "\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [21]
	118	'internal' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
	119	'io' => "\x00\xaa\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4..9]
	120	'malloc' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
	121	'misc' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
	122	'newline' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
	123	'numeric' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
	124	'once' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
	125	'overflow' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
	126	'pack' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
	127	'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
	128	'pipe' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
	129	'portable' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
	130	'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
	131	'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
	132	'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
	133	'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
	134	'recursion' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
	135	'redefine' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
	136	'regexp' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
	137	'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
	138	'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
	139	'severe' => "\x00\x00\x00\x00\x80\xaa\x00\x00\x00\x00\x00\x00", # [19..23]
	140	'signal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
	141	'substr' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
	142	'syntax' => "\x00\x00\x00\x00\x00\x00\xa0\xaa\xaa\x0a\x00\x00", # [26..37]
	143	'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
	144	'umask' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
	145	'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
	146	'unopened' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
	147	'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
	148	'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
	149	'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
	150	'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
	151	'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
599cee73	152	);
599cee73	153
e476b1b5	154	$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
599cee73	155
	156	sub bits {
	157	my $mask ;
	158	my $catmask ;
	159	my $fatal = 0 ;
	160	foreach my $word (@_) {
327afb7f	161	if ($word eq 'FATAL') {
	162	$fatal = 1;
	163	}
	164	else {
	165	if ($catmask = $Bits{$word}) {
	166	$mask \|= $catmask ;
	167	$mask \|= $DeadBits{$word} if $fatal ;
	168	}
599cee73	169	}
599cee73	170	}
	171
	172	return $mask ;
	173	}
	174
	175	sub import {
	176	shift;
6a818117	177	${^WARNING_BITS} \|= bits(@_ ? @_ : 'all') ;
599cee73	178	}
	179
	180	sub unimport {
	181	shift;
6a818117	182	${^WARNING_BITS} &= ~ bits(@_ ? @_ : 'all') ;
599cee73	183	}
	184
	185	sub enabled
	186	{
e476b1b5	187	# If no parameters, check for any lexical warnings enabled
	188	# in the users scope.
	189	my $callers_bitmask = (caller(1))[9] ;
	190	return ($callers_bitmask ne $NONE) if @_ == 0 ;
	191
	192	# otherwise check for the category supplied.
	193	my $category = shift ;
	194	return 0
	195	unless $Bits{$category} ;
	196	return 0 unless defined $callers_bitmask ;
599cee73	197	return 1
e476b1b5	198	if ($callers_bitmask & $Bits{$category}) ne $NONE ;
599cee73	199
	200	return 0 ;
	201	}
	202
e476b1b5	203	sub warn
	204	{
	205	croak "Usage: warnings::warn('category', 'message')"
	206	unless @_ == 2 ;
	207	my $category = shift ;
	208	my $message = shift ;
	209	local $Carp::CarpLevel = 1 ;
	210	my $callers_bitmask = (caller(1))[9] ;
	211	croak($message)
	212	if defined $callers_bitmask &&
	213	($callers_bitmask & $DeadBits{$category}) ne $NONE ;
	214	carp($message) ;
	215	}
	216
599cee73	217	1;