Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | package warnings::register; |
2 | ||
3 | our $VERSION = '1.01'; | |
4 | ||
5 | =pod | |
6 | ||
7 | =head1 NAME | |
8 | ||
9 | warnings::register - warnings import function | |
10 | ||
11 | =head1 SYNOPSIS | |
12 | ||
13 | use warnings::register; | |
14 | ||
15 | =head1 DESCRIPTION | |
16 | ||
17 | Creates a warnings category with the same name as the current package. | |
18 | ||
19 | See L<warnings> and L<perllexwarn> for more information on this module's | |
20 | usage. | |
21 | ||
22 | =cut | |
23 | ||
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; |