summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Class/Struct.pm5
-rw-r--r--lib/I18N/Collate.pm5
-rw-r--r--lib/Tie/Handle.pm5
-rw-r--r--lib/Tie/Hash.pm5
-rw-r--r--lib/Tie/Scalar.pm5
-rw-r--r--lib/constant.pm12
-rw-r--r--lib/syslog.pl6
-rw-r--r--lib/vars.pm6
-rw-r--r--lib/warnings.pm351
-rw-r--r--lib/warnings/register.pm30
10 files changed, 284 insertions, 146 deletions
diff --git a/lib/Class/Struct.pm b/lib/Class/Struct.pm
index b4f2117557..63eddac739 100644
--- a/lib/Class/Struct.pm
+++ b/lib/Class/Struct.pm
@@ -5,6 +5,7 @@ package Class::Struct;
use 5.005_64;
use strict;
+use warnings::register;
our(@ISA, @EXPORT, $VERSION);
use Carp;
@@ -167,8 +168,8 @@ sub struct {
$cnt = 0;
foreach $name (@methods){
if ( do { no strict 'refs'; defined &{$class . "::$name"} } ) {
- carp "function '$name' already defined, overrides struct accessor method"
- if $^W;
+ warnings::warn "function '$name' already defined, overrides struct accessor method"
+ if warnings::enabled();
}
else {
$pre = $pst = $cmt = $sel = '';
diff --git a/lib/I18N/Collate.pm b/lib/I18N/Collate.pm
index 580ca39785..64a03a284b 100644
--- a/lib/I18N/Collate.pm
+++ b/lib/I18N/Collate.pm
@@ -108,6 +108,7 @@ European character set.
# ---
use POSIX qw(strxfrm LC_COLLATE);
+use warnings::register;
require Exporter;
@@ -123,9 +124,9 @@ cmp collate_cmp
sub new {
my $new = $_[1];
- if ($^W && $] >= 5.003_06) {
+ if (warnings::enabled() && $] >= 5.003_06) {
unless ($please_use_I18N_Collate_even_if_deprecated) {
- warn <<___EOD___;
+ warnings::warn <<___EOD___;
***
WARNING: starting from the Perl version 5.003_06
diff --git a/lib/Tie/Handle.pm b/lib/Tie/Handle.pm
index cbac73535d..588ecead89 100644
--- a/lib/Tie/Handle.pm
+++ b/lib/Tie/Handle.pm
@@ -108,6 +108,7 @@ The L<perltie> section contains an example of tying handles.
=cut
use Carp;
+use warnings::register;
sub new {
my $pkg = shift;
@@ -119,8 +120,8 @@ sub new {
sub TIEHANDLE {
my $pkg = shift;
if (defined &{"{$pkg}::new"}) {
- carp "WARNING: calling ${pkg}->new since ${pkg}->TIEHANDLE is missing"
- if $^W;
+ warnings::warn "WARNING: calling ${pkg}->new since ${pkg}->TIEHANDLE is missing"
+ if warnings::enabled();
$pkg->new(@_);
}
else {
diff --git a/lib/Tie/Hash.pm b/lib/Tie/Hash.pm
index 928b798e45..c6ec3d4f5c 100644
--- a/lib/Tie/Hash.pm
+++ b/lib/Tie/Hash.pm
@@ -102,6 +102,7 @@ good working examples.
=cut
use Carp;
+use warnings::register;
sub new {
my $pkg = shift;
@@ -113,8 +114,8 @@ sub new {
sub TIEHASH {
my $pkg = shift;
if (defined &{"${pkg}::new"}) {
- carp "WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing"
- if $^W;
+ warnings::warn "WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing"
+ if warnings::enabled();
$pkg->new(@_);
}
else {
diff --git a/lib/Tie/Scalar.pm b/lib/Tie/Scalar.pm
index 1e2caee379..0c6759006f 100644
--- a/lib/Tie/Scalar.pm
+++ b/lib/Tie/Scalar.pm
@@ -79,6 +79,7 @@ process IDs with priority.
=cut
use Carp;
+use warnings::register;
sub new {
my $pkg = shift;
@@ -90,8 +91,8 @@ sub new {
sub TIESCALAR {
my $pkg = shift;
if (defined &{"{$pkg}::new"}) {
- carp "WARNING: calling ${pkg}->new since ${pkg}->TIESCALAR is missing"
- if $^W;
+ warnings::warn "WARNING: calling ${pkg}->new since ${pkg}->TIESCALAR is missing"
+ if warnings::enabled();
$pkg->new(@_);
}
else {
diff --git a/lib/constant.pm b/lib/constant.pm
index b4fcd421ac..72ad793653 100644
--- a/lib/constant.pm
+++ b/lib/constant.pm
@@ -2,9 +2,10 @@ package constant;
use strict;
use 5.005_64;
+use warnings::register;
our($VERSION, %declared);
-$VERSION = '1.01';
+$VERSION = '1.02';
#=======================================================================
@@ -51,18 +52,17 @@ sub import {
# Maybe the name is tolerable
} elsif ($name =~ /^[A-Za-z_]\w*\z/) {
# Then we'll warn only if you've asked for warnings
- if ($^W) {
- require Carp;
+ if (warnings::enabled()) {
if ($keywords{$name}) {
- Carp::carp("Constant name '$name' is a Perl keyword");
+ warnings::warn("Constant name '$name' is a Perl keyword");
} elsif ($forced_into_main{$name}) {
- Carp::carp("Constant name '$name' is " .
+ warnings::warn("Constant name '$name' is " .
"forced into package main::");
} else {
# Catch-all - what did I miss? If you get this error,
# please let me know what your constant's name was.
# Write to <rootbeer@redcat.com>. Thanks!
- Carp::carp("Constant name '$name' has unknown problems");
+ warnings::warn("Constant name '$name' has unknown problems");
}
}
diff --git a/lib/syslog.pl b/lib/syslog.pl
index 9e03399e4d..70c439b9ae 100644
--- a/lib/syslog.pl
+++ b/lib/syslog.pl
@@ -29,10 +29,12 @@
package syslog;
+use warnings::register;
+
$host = 'localhost' unless $host; # set $syslog'host to change
-if ($] >= 5) {
- warn "You should 'use Sys::Syslog' instead; continuing" # if $^W
+if ($] >= 5 && warnings::enabled()) {
+ warnings::warn "You should 'use Sys::Syslog' instead; continuing";
}
require 'syslog.ph';
diff --git a/lib/vars.pm b/lib/vars.pm
index 6ae5373f89..bde0b2a0e8 100644
--- a/lib/vars.pm
+++ b/lib/vars.pm
@@ -8,6 +8,7 @@ require 5.002;
# if Carp hasn't been loaded in earlier compile time. :-(
# We'll let those bugs get found on the development track.
require Carp if $] < 5.00450;
+use warnings::register();
sub import {
my $callpack = caller;
@@ -22,9 +23,8 @@ sub import {
} elsif ($sym =~ /^\w+[[{].*[]}]$/) {
require Carp;
Carp::croak("Can't declare individual elements of hash or array");
- } elsif ($^W and length($sym) == 1 and $sym !~ tr/a-zA-Z//) {
- require Carp;
- Carp::carp("No need to declare built-in vars");
+ } elsif (warnings::enabled() and length($sym) == 1 and $sym !~ tr/a-zA-Z//) {
+ warnings::warn("No need to declare built-in vars");
}
}
*{"${callpack}::$sym"} =
diff --git a/lib/warnings.pm b/lib/warnings.pm
index 11fd5b0718..11558d50d4 100644
--- a/lib/warnings.pm
+++ b/lib/warnings.pm
@@ -17,7 +17,12 @@ warnings - Perl pragma to control optional warnings
use warnings "all";
no warnings "all";
- if (warnings::enabled("void") {
+ use warnings::register;
+ if (warnings::enabled()) {
+ warnings::warn("some warning");
+ }
+
+ if (warnings::enabled("void")) {
warnings::warn("void", "some warning");
}
@@ -26,23 +31,33 @@ warnings - Perl pragma to control optional warnings
If no import list is supplied, all possible warnings are either enabled
or disabled.
-Two functions are provided to assist module authors.
+A number of functions are provided to assist module authors.
=over 4
-=item warnings::enabled($category)
+=item use warnings::register
+
+Creates a new warnings category which has the same name as the module
+where the call to the pragma is used.
-Returns TRUE if the warnings category in C<$category> is enabled in the
-calling module. Otherwise returns FALSE.
+=item warnings::enabled([$category])
+Returns TRUE if the warnings category C<$category> is enabled in the
+calling module. Otherwise returns FALSE.
-=item warnings::warn($category, $message)
+If the parameter, C<$category>, isn't supplied, the current package name
+will be used.
+
+=item warnings::warn([$category,] $message)
If the calling module has I<not> set C<$category> to "FATAL", print
C<$message> to STDERR.
If the calling module has set C<$category> to "FATAL", print C<$message>
STDERR then die.
+If the parameter, C<$category>, isn't supplied, the current package name
+will be used.
+
=back
See L<perlmod/Pragmatic Modules> and L<perllexwarn>.
@@ -51,107 +66,161 @@ See L<perlmod/Pragmatic Modules> and L<perllexwarn>.
use Carp ;
+%Offsets = (
+ 'all' => 0,
+ 'chmod' => 2,
+ 'closure' => 4,
+ 'exiting' => 6,
+ 'glob' => 8,
+ 'io' => 10,
+ 'closed' => 12,
+ 'exec' => 14,
+ 'newline' => 16,
+ 'pipe' => 18,
+ 'unopened' => 20,
+ 'misc' => 22,
+ 'numeric' => 24,
+ 'once' => 26,
+ 'overflow' => 28,
+ 'pack' => 30,
+ 'portable' => 32,
+ 'recursion' => 34,
+ 'redefine' => 36,
+ 'regexp' => 38,
+ 'severe' => 40,
+ 'debugging' => 42,
+ 'inplace' => 44,
+ 'internal' => 46,
+ 'malloc' => 48,
+ 'signal' => 50,
+ 'substr' => 52,
+ 'syntax' => 54,
+ 'ambiguous' => 56,
+ 'bareword' => 58,
+ 'deprecated' => 60,
+ 'digit' => 62,
+ 'parenthesis' => 64,
+ 'precedence' => 66,
+ 'printf' => 68,
+ 'prototype' => 70,
+ 'qw' => 72,
+ 'reserved' => 74,
+ 'semicolon' => 76,
+ 'taint' => 78,
+ 'umask' => 80,
+ 'uninitialized' => 82,
+ 'unpack' => 84,
+ 'untie' => 86,
+ 'utf8' => 88,
+ 'void' => 90,
+ 'y2k' => 92,
+ );
+
%Bits = (
- 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..47]
- 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
- 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [28]
- 'chmod' => "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [0]
- 'closed' => "\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5]
- 'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
- 'debugging' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20]
- 'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
- 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
- 'exec' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
- 'exiting' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
- 'glob' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
- 'inplace' => "\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [21]
- 'internal' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
- 'io' => "\x00\x55\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4..9]
- 'malloc' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
- 'misc' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
- 'newline' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
- 'numeric' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
- 'once' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
- 'overflow' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
- 'pack' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
- 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
- 'pipe' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
- 'portable' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
- 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
- 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
- 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
- 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
- 'recursion' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
- 'redefine' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
- 'regexp' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
- 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
- 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
- 'severe' => "\x00\x00\x00\x00\x40\x55\x00\x00\x00\x00\x00\x00", # [19..23]
- 'signal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
- 'substr' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
- 'syntax' => "\x00\x00\x00\x00\x00\x00\x50\x55\x55\x05\x00\x00", # [26..37]
- 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
- 'umask' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
- 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
- 'unopened' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
- 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
- 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
- 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
- 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
- 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
+ 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..46]
+ 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [28]
+ 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
+ 'chmod' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
+ 'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
+ 'closure' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
+ 'debugging' => "\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [21]
+ 'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
+ 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
+ 'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
+ 'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
+ 'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
+ 'inplace' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
+ 'internal' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
+ 'io' => "\x00\x54\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..10]
+ 'malloc' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
+ 'misc' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
+ 'newline' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
+ 'numeric' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
+ 'once' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
+ 'overflow' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
+ 'pack' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
+ 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
+ 'pipe' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
+ 'portable' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
+ 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
+ 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
+ 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
+ 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
+ 'recursion' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
+ 'redefine' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
+ 'regexp' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19]
+ 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
+ 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
+ 'severe' => "\x00\x00\x00\x00\x00\x55\x01\x00\x00\x00\x00\x00", # [20..24]
+ 'signal' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
+ 'substr' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26]
+ 'syntax' => "\x00\x00\x00\x00\x00\x00\x40\x55\x55\x15\x00\x00", # [27..38]
+ 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
+ 'umask' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
+ 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
+ 'unopened' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
+ 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
+ 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
+ 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
+ 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
+ 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46]
);
%DeadBits = (
- 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..47]
- 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
- 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [28]
- 'chmod' => "\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [0]
- 'closed' => "\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5]
- 'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
- 'debugging' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20]
- 'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
- 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
- 'exec' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
- 'exiting' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
- 'glob' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
- 'inplace' => "\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [21]
- 'internal' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
- 'io' => "\x00\xaa\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4..9]
- 'malloc' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
- 'misc' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
- 'newline' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
- 'numeric' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
- 'once' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
- 'overflow' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
- 'pack' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
- 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
- 'pipe' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
- 'portable' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
- 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
- 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
- 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
- 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
- 'recursion' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
- 'redefine' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
- 'regexp' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
- 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
- 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
- 'severe' => "\x00\x00\x00\x00\x80\xaa\x00\x00\x00\x00\x00\x00", # [19..23]
- 'signal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
- 'substr' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
- 'syntax' => "\x00\x00\x00\x00\x00\x00\xa0\xaa\xaa\x0a\x00\x00", # [26..37]
- 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
- 'umask' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
- 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
- 'unopened' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
- 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
- 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
- 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
- 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
- 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
+ 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..46]
+ 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [28]
+ 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
+ 'chmod' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
+ 'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
+ 'closure' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
+ 'debugging' => "\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [21]
+ 'deprecated' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
+ 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
+ 'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
+ 'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
+ 'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
+ 'inplace' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
+ 'internal' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
+ 'io' => "\x00\xa8\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..10]
+ 'malloc' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
+ 'misc' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
+ 'newline' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
+ 'numeric' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
+ 'once' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
+ 'overflow' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
+ 'pack' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
+ 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
+ 'pipe' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
+ 'portable' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
+ 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
+ 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
+ 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
+ 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
+ 'recursion' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
+ 'redefine' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
+ 'regexp' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19]
+ 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
+ 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
+ 'severe' => "\x00\x00\x00\x00\x00\xaa\x02\x00\x00\x00\x00\x00", # [20..24]
+ 'signal' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
+ 'substr' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26]
+ 'syntax' => "\x00\x00\x00\x00\x00\x00\x80\xaa\xaa\x2a\x00\x00", # [27..38]
+ 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
+ 'umask' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
+ 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
+ 'unopened' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
+ 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
+ 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
+ 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
+ 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
+ 'y2k' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [46]
);
-$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
+$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
+$LAST_BIT = 94 ;
+$BYTES = 12 ;
+
+$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
sub bits {
my $mask ;
@@ -161,12 +230,12 @@ sub bits {
if ($word eq 'FATAL') {
$fatal = 1;
}
- else {
- if ($catmask = $Bits{$word}) {
- $mask |= $catmask ;
- $mask |= $DeadBits{$word} if $fatal ;
- }
+ elsif ($catmask = $Bits{$word}) {
+ $mask |= $catmask ;
+ $mask |= $DeadBits{$word} if $fatal ;
}
+ else
+ { croak("unknown warnings category '$word'")}
}
return $mask ;
@@ -179,38 +248,70 @@ sub import {
sub unimport {
shift;
- ${^WARNING_BITS} &= ~ bits(@_ ? @_ : 'all') ;
+ my $mask = ${^WARNING_BITS} ;
+ if (vec($mask, $Offsets{'all'}, 1)) {
+ $mask = $Bits{'all'} ;
+ $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
+ }
+ ${^WARNING_BITS} = $mask & ~ (bits(@_ ? @_ : 'all') | $All) ;
}
sub enabled
{
- # If no parameters, check for any lexical warnings enabled
- # in the users scope.
+ croak("Usage: warnings::enabled([category])")
+ unless @_ == 1 || @_ == 0 ;
+ local $Carp::CarpLevel = 1 ;
+ my $category ;
+ my $offset ;
my $callers_bitmask = (caller(1))[9] ;
- return ($callers_bitmask ne $NONE) if @_ == 0 ;
-
- # otherwise check for the category supplied.
- my $category = shift ;
- return 0
- unless $Bits{$category} ;
return 0 unless defined $callers_bitmask ;
- return 1
- if ($callers_bitmask & $Bits{$category}) ne $NONE ;
-
- return 0 ;
+
+
+ if (@_) {
+ # check the category supplied.
+ $category = shift ;
+ $offset = $Offsets{$category};
+ croak("unknown warnings category '$category'")
+ unless defined $offset;
+ }
+ else {
+ $category = (caller(0))[0] ;
+ $offset = $Offsets{$category};
+ croak("package '$category' not registered for warnings")
+ unless defined $offset ;
+ }
+
+ return vec($callers_bitmask, $offset, 1) ||
+ vec($callers_bitmask, $Offsets{'all'}, 1) ;
}
+
sub warn
{
- croak "Usage: warnings::warn('category', 'message')"
- unless @_ == 2 ;
- my $category = shift ;
- my $message = shift ;
+ croak("Usage: warnings::warn([category,] 'message')")
+ unless @_ == 2 || @_ == 1 ;
local $Carp::CarpLevel = 1 ;
+ my $category ;
+ my $offset ;
my $callers_bitmask = (caller(1))[9] ;
+
+ if (@_ == 2) {
+ $category = shift ;
+ $offset = $Offsets{$category};
+ croak("unknown warnings category '$category'")
+ unless defined $offset ;
+ }
+ else {
+ $category = (caller(0))[0] ;
+ $offset = $Offsets{$category};
+ croak("package '$category' not registered for warnings")
+ unless defined $offset ;
+ }
+
+ my $message = shift ;
croak($message)
- if defined $callers_bitmask &&
- ($callers_bitmask & $DeadBits{$category}) ne $NONE ;
+ if vec($callers_bitmask, $offset+1, 1) ||
+ vec($callers_bitmask, $Offsets{'all'}+1, 1) ;
carp($message) ;
}
diff --git a/lib/warnings/register.pm b/lib/warnings/register.pm
new file mode 100644
index 0000000000..da6be97952
--- /dev/null
+++ b/lib/warnings/register.pm
@@ -0,0 +1,30 @@
+package warnings::register ;
+
+require warnings ;
+
+sub mkMask
+{
+ my ($bit) = @_ ;
+ my $mask = "" ;
+
+ vec($mask, $bit, 1) = 1 ;
+ return $mask ;
+}
+
+sub import
+{
+ shift ;
+ 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 ;
+ }
+}
+
+1 ;
View Lorry Controller Status