improve registration of warning categories
authorRicardo Signes <rjbs@cpan.org>
Wed, 8 Sep 2010 20:40:26 +0000 (16:40 -0400)
committerRicardo Signes <rjbs@cpan.org>
Fri, 10 Sep 2010 15:06:27 +0000 (11:06 -0400)
1. &warnings::register is added as the public mechanism for adding
   new warning categories, rather than warnings::register::import
   knowing about warnings's internals

2. warnings::register::import is updated to use &warnings::register

3. warnings::register::import can take a list of subcategories

The upshot is that you can now write:

  package MyTool;
  use warnings::register qw(io typos);

  warnings::warnif('MyTool::io', $message);

...and tools that register new warnings categories do not need to cargo cult
code from warnings/register.pm

lib/warnings.pm
lib/warnings/register.pm
pod/perllexwarn.pod
t/lib/warnings/9enabled

index eedbc32..e01027e 100644 (file)
@@ -153,6 +153,12 @@ Equivalent to:
     if (warnings::enabled($object))
       { warnings::warn($object, $message) }
 
+
+=item warnings::register(@names)
+
+This registers warning categories for the given names and is primarily for
+use by the warnings::register pragma, for which see L<perllexwarn>.
+
 =back
 
 See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
@@ -490,6 +496,33 @@ sub __chk
     Carp::carp($message);
 }
 
+sub _mkMask
+{
+    my ($bit) = @_;
+    my $mask = "";
+
+    vec($mask, $bit, 1) = 1;
+    return $mask;
+}
+
+sub register
+{
+    my @names = @_;
+
+    for my $name (@names) {
+       if (! defined $Bits{$name}) {
+           $Bits{$name}     = _mkMask($LAST_BIT);
+           vec($Bits{'all'}, $LAST_BIT, 1) = 1;
+           $Offsets{$name}  = $LAST_BIT ++;
+           foreach my $k (keys %Bits) {
+               vec($Bits{$k}, $LAST_BIT, 1) = 0;
+           }
+           $DeadBits{$name} = _mkMask($LAST_BIT);
+           vec($DeadBits{'all'}, $LAST_BIT++, 1) = 1;
+       }
+    }
+}
+
 sub _error_loc {
     require Carp;
     goto &Carp::short_error_loc; # don't introduce another stack frame
index 57c865d..4cf93b2 100644 (file)
@@ -23,6 +23,8 @@ usage.
 
 require warnings;
 
+# left here as cruft in case other users were using this undocumented routine
+# -- rjbs, 2010-09-08
 sub mkMask
 {
     my ($bit) = @_;
@@ -35,17 +37,12 @@ sub mkMask
 sub import
 {
     shift;
+    my @categories = @_;
+
     my $package = (caller(0))[0];
-    if (! defined $warnings::Bits{$package}) {
-        $warnings::Bits{$package}     = mkMask($warnings::LAST_BIT);
-        vec($warnings::Bits{'all'}, $warnings::LAST_BIT, 1) = 1;
-        $warnings::Offsets{$package}  = $warnings::LAST_BIT ++;
-       foreach my $k (keys %warnings::Bits) {
-           vec($warnings::Bits{$k}, $warnings::LAST_BIT, 1) = 0;
-       }
-        $warnings::DeadBits{$package} = mkMask($warnings::LAST_BIT);
-        vec($warnings::DeadBits{'all'}, $warnings::LAST_BIT++, 1) = 1;
-    }
+    warnings::register($package);
+
+    warnings::register($package . "::$_") for @categories;
 }
 
 1;
index 835914e..ab71729 100644 (file)
@@ -520,6 +520,16 @@ a warning.
 Notice also that the warning is reported at the line where the object is first
 used.
 
+When registering new categories of warning, you can supply more names to
+warnings::register like this:
+
+    package MyModule;
+    use warnings::register qw(format precision);
+
+    ...
+
+    warnings::warnif('MyModule::format', '...');
+
 =head1 SEE ALSO
 
 L<warnings>, L<perldiag>.
index a535689..68b0a27 100644 (file)
@@ -1181,6 +1181,24 @@ my message 2 at - line 8
 my message 4 at - line 8
 ########
 
+--FILE-- abc52.pm
+package abc52 ;
+use warnings::register ('foo', 'bar');
+sub check {
+    warnings::warnif('abc52', "hello");
+    warnings::warnif('abc52::foo', "hello foo");
+    warnings::warnif('abc52::bar', "hello bar");
+}
+1;
+--FILE--
+use abc52;
+use warnings("abc52", "abc52::bar");
+abc52::check() ;
+EXPECT
+hello at - line 3
+hello bar at - line 3
+########
+
 --FILE--
 # test for bug [perl #15395]
 my ( $warn_cat, # warning category we'll try to control