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