lib/warnings/register.pm

   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 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;