Commit | Line | Data |
---|---|---|
d3a7d8c7 GS |
1 | package warnings::register ; |
2 | ||
b75c8c73 MS |
3 | our $VERSION = '1.00'; |
4 | ||
4755096e GS |
5 | =pod |
6 | ||
7 | =head1 NAME | |
8 | ||
9 | warnings::register - warnings import function | |
10 | ||
c5035329 PM |
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 GS |
22 | =cut |
23 | ||
d3a7d8c7 GS |
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 ; |