1N/Apackage warnings::register ;
1N/A
1N/Aour $VERSION = '1.00';
1N/A
1N/A=pod
1N/A
1N/A=head1 NAME
1N/A
1N/Awarnings::register - warnings import function
1N/A
1N/A=head1 SYNOPSIS
1N/A
1N/A use warnings::register ;
1N/A
1N/A=head1 DESCRIPTION
1N/A
1N/ACreate a warnings category with the same name as the current package.
1N/A
1N/ASee L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
1N/A
1N/A
1N/A=cut
1N/A
1N/Arequire warnings ;
1N/A
1N/Asub mkMask
1N/A{
1N/A my ($bit) = @_ ;
1N/A my $mask = "" ;
1N/A
1N/A vec($mask, $bit, 1) = 1 ;
1N/A return $mask ;
1N/A}
1N/A
1N/Asub import
1N/A{
1N/A shift ;
1N/A my $package = (caller(0))[0] ;
1N/A if (! defined $warnings::Bits{$package}) {
1N/A $warnings::Bits{$package} = mkMask($warnings::LAST_BIT) ;
1N/A vec($warnings::Bits{'all'}, $warnings::LAST_BIT, 1) = 1 ;
1N/A $warnings::Offsets{$package} = $warnings::LAST_BIT ++ ;
1N/A foreach my $k (keys %warnings::Bits) {
1N/A vec($warnings::Bits{$k}, $warnings::LAST_BIT, 1) = 0 ;
1N/A }
1N/A $warnings::DeadBits{$package} = mkMask($warnings::LAST_BIT);
1N/A vec($warnings::DeadBits{'all'}, $warnings::LAST_BIT++, 1) = 1 ;
1N/A }
1N/A}
1N/A
1N/A1 ;