| 1 | package warnings::register; |
| 2 | |
| 3 | our $VERSION = '1.02'; |
| 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 | # left here as cruft in case other users were using this undocumented routine |
| 27 | # -- rjbs, 2010-09-08 |
| 28 | sub mkMask |
| 29 | { |
| 30 | my ($bit) = @_; |
| 31 | my $mask = ""; |
| 32 | |
| 33 | vec($mask, $bit, 1) = 1; |
| 34 | return $mask; |
| 35 | } |
| 36 | |
| 37 | sub import |
| 38 | { |
| 39 | shift; |
| 40 | my @categories = @_; |
| 41 | |
| 42 | my $package = (caller(0))[0]; |
| 43 | warnings::register_categories($package); |
| 44 | |
| 45 | warnings::register_categories($package . "::$_") for @categories; |
| 46 | } |
| 47 | |
| 48 | 1; |