| [ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 # -*- buffer-read-only: t -*- 2 # !!!!!!! DO NOT EDIT THIS FILE !!!!!!! 3 # This file was created by warnings.pl 4 # Any changes made here will be lost. 5 # 6 7 package warnings; 8 9 our $VERSION = '1.06'; 10 11 # Verify that we're called correctly so that warnings will work. 12 # see also strict.pm. 13 unless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) { 14 my (undef, $f, $l) = caller; 15 die("Incorrect use of pragma '${\__PACKAGE__}' at $f line $l.\n"); 16 } 17 18 =head1 NAME 19 20 warnings - Perl pragma to control optional warnings 21 22 =head1 SYNOPSIS 23 24 use warnings; 25 no warnings; 26 27 use warnings "all"; 28 no warnings "all"; 29 30 use warnings::register; 31 if (warnings::enabled()) { 32 warnings::warn("some warning"); 33 } 34 35 if (warnings::enabled("void")) { 36 warnings::warn("void", "some warning"); 37 } 38 39 if (warnings::enabled($object)) { 40 warnings::warn($object, "some warning"); 41 } 42 43 warnings::warnif("some warning"); 44 warnings::warnif("void", "some warning"); 45 warnings::warnif($object, "some warning"); 46 47 =head1 DESCRIPTION 48 49 The C<warnings> pragma is a replacement for the command line flag C<-w>, 50 but the pragma is limited to the enclosing block, while the flag is global. 51 See L<perllexwarn> for more information. 52 53 If no import list is supplied, all possible warnings are either enabled 54 or disabled. 55 56 A number of functions are provided to assist module authors. 57 58 =over 4 59 60 =item use warnings::register 61 62 Creates a new warnings category with the same name as the package where 63 the call to the pragma is used. 64 65 =item warnings::enabled() 66 67 Use the warnings category with the same name as the current package. 68 69 Return TRUE if that warnings category is enabled in the calling module. 70 Otherwise returns FALSE. 71 72 =item warnings::enabled($category) 73 74 Return TRUE if the warnings category, C<$category>, is enabled in the 75 calling module. 76 Otherwise returns FALSE. 77 78 =item warnings::enabled($object) 79 80 Use the name of the class for the object reference, C<$object>, as the 81 warnings category. 82 83 Return TRUE if that warnings category is enabled in the first scope 84 where the object is used. 85 Otherwise returns FALSE. 86 87 =item warnings::warn($message) 88 89 Print C<$message> to STDERR. 90 91 Use the warnings category with the same name as the current package. 92 93 If that warnings category has been set to "FATAL" in the calling module 94 then die. Otherwise return. 95 96 =item warnings::warn($category, $message) 97 98 Print C<$message> to STDERR. 99 100 If the warnings category, C<$category>, has been set to "FATAL" in the 101 calling module then die. Otherwise return. 102 103 =item warnings::warn($object, $message) 104 105 Print C<$message> to STDERR. 106 107 Use the name of the class for the object reference, C<$object>, as the 108 warnings category. 109 110 If that warnings category has been set to "FATAL" in the scope where C<$object> 111 is first used then die. Otherwise return. 112 113 114 =item warnings::warnif($message) 115 116 Equivalent to: 117 118 if (warnings::enabled()) 119 { warnings::warn($message) } 120 121 =item warnings::warnif($category, $message) 122 123 Equivalent to: 124 125 if (warnings::enabled($category)) 126 { warnings::warn($category, $message) } 127 128 =item warnings::warnif($object, $message) 129 130 Equivalent to: 131 132 if (warnings::enabled($object)) 133 { warnings::warn($object, $message) } 134 135 =back 136 137 See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>. 138 139 =cut 140 141 our %Offsets = ( 142 143 # Warnings Categories added in Perl 5.008 144 145 'all' => 0, 146 'closure' => 2, 147 'deprecated' => 4, 148 'exiting' => 6, 149 'glob' => 8, 150 'io' => 10, 151 'closed' => 12, 152 'exec' => 14, 153 'layer' => 16, 154 'newline' => 18, 155 'pipe' => 20, 156 'unopened' => 22, 157 'misc' => 24, 158 'numeric' => 26, 159 'once' => 28, 160 'overflow' => 30, 161 'pack' => 32, 162 'portable' => 34, 163 'recursion' => 36, 164 'redefine' => 38, 165 'regexp' => 40, 166 'severe' => 42, 167 'debugging' => 44, 168 'inplace' => 46, 169 'internal' => 48, 170 'malloc' => 50, 171 'signal' => 52, 172 'substr' => 54, 173 'syntax' => 56, 174 'ambiguous' => 58, 175 'bareword' => 60, 176 'digit' => 62, 177 'parenthesis' => 64, 178 'precedence' => 66, 179 'printf' => 68, 180 'prototype' => 70, 181 'qw' => 72, 182 'reserved' => 74, 183 'semicolon' => 76, 184 'taint' => 78, 185 'threads' => 80, 186 'uninitialized' => 82, 187 'unpack' => 84, 188 'untie' => 86, 189 'utf8' => 88, 190 'void' => 90, 191 ); 192 193 our %Bits = ( 194 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x05", # [0..45] 195 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29] 196 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30] 197 'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6] 198 'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1] 199 'debugging' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22] 200 'deprecated' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2] 201 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31] 202 'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7] 203 'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3] 204 'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4] 205 'inplace' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23] 206 'internal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24] 207 'io' => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11] 208 'layer' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8] 209 'malloc' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25] 210 'misc' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12] 211 'newline' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9] 212 'numeric' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13] 213 'once' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14] 214 'overflow' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15] 215 'pack' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16] 216 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32] 217 'pipe' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10] 218 'portable' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17] 219 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33] 220 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34] 221 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35] 222 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36] 223 'recursion' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18] 224 'redefine' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19] 225 'regexp' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20] 226 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37] 227 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38] 228 'severe' => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00", # [21..25] 229 'signal' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26] 230 'substr' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27] 231 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x00", # [28..38] 232 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39] 233 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40] 234 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41] 235 'unopened' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11] 236 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42] 237 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43] 238 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44] 239 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45] 240 ); 241 242 our %DeadBits = ( 243 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x0a", # [0..45] 244 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29] 245 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30] 246 'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6] 247 'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1] 248 'debugging' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22] 249 'deprecated' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2] 250 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31] 251 'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7] 252 'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3] 253 'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4] 254 'inplace' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23] 255 'internal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24] 256 'io' => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11] 257 'layer' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8] 258 'malloc' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25] 259 'misc' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12] 260 'newline' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9] 261 'numeric' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13] 262 'once' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14] 263 'overflow' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15] 264 'pack' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16] 265 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32] 266 'pipe' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10] 267 'portable' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17] 268 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33] 269 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34] 270 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35] 271 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36] 272 'recursion' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18] 273 'redefine' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19] 274 'regexp' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20] 275 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37] 276 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38] 277 'severe' => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00", # [21..25] 278 'signal' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26] 279 'substr' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27] 280 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x00", # [28..38] 281 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39] 282 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40] 283 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41] 284 'unopened' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11] 285 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42] 286 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43] 287 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44] 288 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45] 289 ); 290 291 $NONE = "\0\0\0\0\0\0\0\0\0\0\0\0"; 292 $LAST_BIT = 92 ; 293 $BYTES = 12 ; 294 295 $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ; 296 297 sub Croaker 298 { 299 require Carp::Heavy; # this initializes %CarpInternal 300 local $Carp::CarpInternal{'warnings'}; 301 delete $Carp::CarpInternal{'warnings'}; 302 Carp::croak(@_); 303 } 304 305 sub bits 306 { 307 # called from B::Deparse.pm 308 309 push @_, 'all' unless @_; 310 311 my $mask; 312 my $catmask ; 313 my $fatal = 0 ; 314 my $no_fatal = 0 ; 315 316 foreach my $word ( @_ ) { 317 if ($word eq 'FATAL') { 318 $fatal = 1; 319 $no_fatal = 0; 320 } 321 elsif ($word eq 'NONFATAL') { 322 $fatal = 0; 323 $no_fatal = 1; 324 } 325 elsif ($catmask = $Bits{$word}) { 326 $mask |= $catmask ; 327 $mask |= $DeadBits{$word} if $fatal ; 328 $mask &= ~($DeadBits{$word}|$All) if $no_fatal ; 329 } 330 else 331 { Croaker("Unknown warnings category '$word'")} 332 } 333 334 return $mask ; 335 } 336 337 sub import 338 { 339 shift; 340 341 my $catmask ; 342 my $fatal = 0 ; 343 my $no_fatal = 0 ; 344 345 my $mask = ${^WARNING_BITS} ; 346 347 if (vec($mask, $Offsets{'all'}, 1)) { 348 $mask |= $Bits{'all'} ; 349 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1); 350 } 351 352 push @_, 'all' unless @_; 353 354 foreach my $word ( @_ ) { 355 if ($word eq 'FATAL') { 356 $fatal = 1; 357 $no_fatal = 0; 358 } 359 elsif ($word eq 'NONFATAL') { 360 $fatal = 0; 361 $no_fatal = 1; 362 } 363 elsif ($catmask = $Bits{$word}) { 364 $mask |= $catmask ; 365 $mask |= $DeadBits{$word} if $fatal ; 366 $mask &= ~($DeadBits{$word}|$All) if $no_fatal ; 367 } 368 else 369 { Croaker("Unknown warnings category '$word'")} 370 } 371 372 ${^WARNING_BITS} = $mask ; 373 } 374 375 sub unimport 376 { 377 shift; 378 379 my $catmask ; 380 my $mask = ${^WARNING_BITS} ; 381 382 if (vec($mask, $Offsets{'all'}, 1)) { 383 $mask |= $Bits{'all'} ; 384 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1); 385 } 386 387 push @_, 'all' unless @_; 388 389 foreach my $word ( @_ ) { 390 if ($word eq 'FATAL') { 391 next; 392 } 393 elsif ($catmask = $Bits{$word}) { 394 $mask &= ~($catmask | $DeadBits{$word} | $All); 395 } 396 else 397 { Croaker("Unknown warnings category '$word'")} 398 } 399 400 ${^WARNING_BITS} = $mask ; 401 } 402 403 my %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = (); 404 405 sub __chk 406 { 407 my $category ; 408 my $offset ; 409 my $isobj = 0 ; 410 411 if (@_) { 412 # check the category supplied. 413 $category = shift ; 414 if (my $type = ref $category) { 415 Croaker("not an object") 416 if exists $builtin_type{$type}; 417 $category = $type; 418 $isobj = 1 ; 419 } 420 $offset = $Offsets{$category}; 421 Croaker("Unknown warnings category '$category'") 422 unless defined $offset; 423 } 424 else { 425 $category = (caller(1))[0] ; 426 $offset = $Offsets{$category}; 427 Croaker("package '$category' not registered for warnings") 428 unless defined $offset ; 429 } 430 431 my $this_pkg = (caller(1))[0] ; 432 my $i = 2 ; 433 my $pkg ; 434 435 if ($isobj) { 436 while (do { { package DB; $pkg = (caller($i++))[0] } } ) { 437 last unless @DB::args && $DB::args[0] =~ /^$category=/ ; 438 } 439 $i -= 2 ; 440 } 441 else { 442 $i = _error_loc(); # see where Carp will allocate the error 443 } 444 445 my $callers_bitmask = (caller($i))[9] ; 446 return ($callers_bitmask, $offset, $i) ; 447 } 448 449 sub _error_loc { 450 require Carp::Heavy; 451 goto &Carp::short_error_loc; # don't introduce another stack frame 452 } 453 454 sub enabled 455 { 456 Croaker("Usage: warnings::enabled([category])") 457 unless @_ == 1 || @_ == 0 ; 458 459 my ($callers_bitmask, $offset, $i) = __chk(@_) ; 460 461 return 0 unless defined $callers_bitmask ; 462 return vec($callers_bitmask, $offset, 1) || 463 vec($callers_bitmask, $Offsets{'all'}, 1) ; 464 } 465 466 467 sub warn 468 { 469 Croaker("Usage: warnings::warn([category,] 'message')") 470 unless @_ == 2 || @_ == 1 ; 471 472 my $message = pop ; 473 my ($callers_bitmask, $offset, $i) = __chk(@_) ; 474 require Carp; 475 Carp::croak($message) 476 if vec($callers_bitmask, $offset+1, 1) || 477 vec($callers_bitmask, $Offsets{'all'}+1, 1) ; 478 Carp::carp($message) ; 479 } 480 481 sub warnif 482 { 483 Croaker("Usage: warnings::warnif([category,] 'message')") 484 unless @_ == 2 || @_ == 1 ; 485 486 my $message = pop ; 487 my ($callers_bitmask, $offset, $i) = __chk(@_) ; 488 489 return 490 unless defined $callers_bitmask && 491 (vec($callers_bitmask, $offset, 1) || 492 vec($callers_bitmask, $Offsets{'all'}, 1)) ; 493 494 require Carp; 495 Carp::croak($message) 496 if vec($callers_bitmask, $offset+1, 1) || 497 vec($callers_bitmask, $Offsets{'all'}+1, 1) ; 498 499 Carp::carp($message) ; 500 } 501 502 1; 503 # ex: set ro:
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
| Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |