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