Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | package warnings::register ; |
2 | ||
3 | our $VERSION = '1.00'; | |
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 | Create a warnings category with the same name as the current package. | |
18 | ||
19 | See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>. | |
20 | ||
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 ; |