Line | |
---|
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;
|
---|
Note:
See
TracBrowser
for help on using the repository browser.