Commit | Line | Data |
---|---|---|
5ca7f68d | 1 | package warnings::register; |
d3a7d8c7 | 2 | |
98225a64 | 3 | our $VERSION = '1.01'; |
b75c8c73 | 4 | |
4755096e | 5 | =pod |
6 | ||
7 | =head1 NAME | |
8 | ||
9 | warnings::register - warnings import function | |
10 | ||
c5035329 | 11 | =head1 SYNOPSIS |
12 | ||
5ca7f68d | 13 | use warnings::register; |
c5035329 | 14 | |
15 | =head1 DESCRIPTION | |
16 | ||
5ca7f68d | 17 | Creates a warnings category with the same name as the current package. |
c5035329 | 18 | |
5ca7f68d | 19 | See L<warnings> and L<perllexwarn> for more information on this module's |
20 | usage. | |
c5035329 | 21 | |
4755096e | 22 | =cut |
23 | ||
5ca7f68d | 24 | require warnings; |
d3a7d8c7 | 25 | |
26 | sub mkMask | |
27 | { | |
5ca7f68d | 28 | my ($bit) = @_; |
29 | my $mask = ""; | |
d3a7d8c7 | 30 | |
5ca7f68d | 31 | vec($mask, $bit, 1) = 1; |
32 | return $mask; | |
d3a7d8c7 | 33 | } |
34 | ||
35 | sub import | |
36 | { | |
5ca7f68d | 37 | shift; |
38 | my $package = (caller(0))[0]; | |
d3a7d8c7 | 39 | if (! defined $warnings::Bits{$package}) { |
5ca7f68d | 40 | $warnings::Bits{$package} = mkMask($warnings::LAST_BIT); |
41 | vec($warnings::Bits{'all'}, $warnings::LAST_BIT, 1) = 1; | |
42 | $warnings::Offsets{$package} = $warnings::LAST_BIT ++; | |
d3a7d8c7 | 43 | foreach my $k (keys %warnings::Bits) { |
5ca7f68d | 44 | vec($warnings::Bits{$k}, $warnings::LAST_BIT, 1) = 0; |
d3a7d8c7 | 45 | } |
46 | $warnings::DeadBits{$package} = mkMask($warnings::LAST_BIT); | |
5ca7f68d | 47 | vec($warnings::DeadBits{'all'}, $warnings::LAST_BIT++, 1) = 1; |
d3a7d8c7 | 48 | } |
49 | } | |
50 | ||
5ca7f68d | 51 | 1; |