← Index
NYTProf Performance Profile   « block view • line view • sub view »
For reply.pl
  Run on Thu Oct 21 22:40:13 2010
Reported on Thu Oct 21 22:44:41 2010

Filename/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/5.13.5/warnings.pm
StatementsExecuted 641 statements in 1.90ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
411633µs701µswarnings::::register_categorieswarnings::register_categories
503836534µs559µswarnings::::importwarnings::import
11118308µs308µswarnings::::unimportwarnings::unimport
82168µs68µswarnings::::_mkMaskwarnings::_mkMask
22157µs57µswarnings::::_bitswarnings::_bits
11117µs17µswarnings::::CORE:regcompwarnings::CORE:regcomp (opcode)
11111µs44µswarnings::::bitswarnings::bits
1115µs5µswarnings::::CORE:matchwarnings::CORE:match (opcode)
0000s0swarnings::::Croakerwarnings::Croaker
0000s0swarnings::::__chkwarnings::__chk
0000s0swarnings::::_error_locwarnings::_error_loc
0000s0swarnings::::enabledwarnings::enabled
0000s0swarnings::::fatal_enabledwarnings::fatal_enabled
0000s0swarnings::::warnwarnings::warn
0000s0swarnings::::warnifwarnings::warnif
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
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
7package warnings;
8
912µsour $VERSION = '1.11';
10
11# Verify that we're called correctly so that warnings will work.
12# see also strict.pm.
13135µs222µsunless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) {
# spent 17µs making 1 call to warnings::CORE:regcomp # spent 5µs making 1 call to warnings::CORE:match
14 my (undef, $f, $l) = caller;
15 die("Incorrect use of pragma '${\__PACKAGE__}' at $f line $l.\n");
16}
17
18=head1 NAME
19
20warnings - 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
49The C<warnings> pragma is a replacement for the command line flag C<-w>,
50but the pragma is limited to the enclosing block, while the flag is global.
51See L<perllexwarn> for more information.
52
53If no import list is supplied, all possible warnings are either enabled
54or disabled.
55
56A number of functions are provided to assist module authors.
57
58=over 4
59
60=item use warnings::register
61
62Creates a new warnings category with the same name as the package where
63the call to the pragma is used.
64
65=item warnings::enabled()
66
67Use the warnings category with the same name as the current package.
68
69Return TRUE if that warnings category is enabled in the calling module.
70Otherwise returns FALSE.
71
72=item warnings::enabled($category)
73
74Return TRUE if the warnings category, C<$category>, is enabled in the
75calling module.
76Otherwise returns FALSE.
77
78=item warnings::enabled($object)
79
80Use the name of the class for the object reference, C<$object>, as the
81warnings category.
82
83Return TRUE if that warnings category is enabled in the first scope
84where the object is used.
85Otherwise returns FALSE.
86
87=item warnings::fatal_enabled()
88
89Return TRUE if the warnings category with the same name as the current
90package has been set to FATAL in the calling module.
91Otherwise returns FALSE.
92
93=item warnings::fatal_enabled($category)
94
95Return TRUE if the warnings category C<$category> has been set to FATAL in
96the calling module.
97Otherwise returns FALSE.
98
99=item warnings::fatal_enabled($object)
100
101Use the name of the class for the object reference, C<$object>, as the
102warnings category.
103
104Return TRUE if that warnings category has been set to FATAL in the first
105scope where the object is used.
106Otherwise returns FALSE.
107
108=item warnings::warn($message)
109
110Print C<$message> to STDERR.
111
112Use the warnings category with the same name as the current package.
113
114If that warnings category has been set to "FATAL" in the calling module
115then die. Otherwise return.
116
117=item warnings::warn($category, $message)
118
119Print C<$message> to STDERR.
120
121If the warnings category, C<$category>, has been set to "FATAL" in the
122calling module then die. Otherwise return.
123
124=item warnings::warn($object, $message)
125
126Print C<$message> to STDERR.
127
128Use the name of the class for the object reference, C<$object>, as the
129warnings category.
130
131If that warnings category has been set to "FATAL" in the scope where C<$object>
132is first used then die. Otherwise return.
133
134
135=item warnings::warnif($message)
136
137Equivalent to:
138
139 if (warnings::enabled())
140 { warnings::warn($message) }
141
142=item warnings::warnif($category, $message)
143
144Equivalent to:
145
146 if (warnings::enabled($category))
147 { warnings::warn($category, $message) }
148
149=item warnings::warnif($object, $message)
150
151Equivalent to:
152
153 if (warnings::enabled($object))
154 { warnings::warn($object, $message) }
155
156=item warnings::register_categories(@names)
157
158This registers warning categories for the given names and is primarily for
159use by the warnings::register pragma, for which see L<perllexwarn>.
160
161=back
162
163See L<perlmodlib/Pragmatic Modules> and L<perllexwarn>.
164
165=cut
166
167116µsour %Offsets = (
168
169 # Warnings Categories added in Perl 5.008
170
171 'all' => 0,
172 'closure' => 2,
173 'deprecated' => 4,
174 'exiting' => 6,
175 'glob' => 8,
176 'io' => 10,
177 'closed' => 12,
178 'exec' => 14,
179 'layer' => 16,
180 'newline' => 18,
181 'pipe' => 20,
182 'unopened' => 22,
183 'misc' => 24,
184 'numeric' => 26,
185 'once' => 28,
186 'overflow' => 30,
187 'pack' => 32,
188 'portable' => 34,
189 'recursion' => 36,
190 'redefine' => 38,
191 'regexp' => 40,
192 'severe' => 42,
193 'debugging' => 44,
194 'inplace' => 46,
195 'internal' => 48,
196 'malloc' => 50,
197 'signal' => 52,
198 'substr' => 54,
199 'syntax' => 56,
200 'ambiguous' => 58,
201 'bareword' => 60,
202 'digit' => 62,
203 'parenthesis' => 64,
204 'precedence' => 66,
205 'printf' => 68,
206 'prototype' => 70,
207 'qw' => 72,
208 'reserved' => 74,
209 'semicolon' => 76,
210 'taint' => 78,
211 'threads' => 80,
212 'uninitialized' => 82,
213 'unpack' => 84,
214 'untie' => 86,
215 'utf8' => 88,
216 'void' => 90,
217
218 # Warnings Categories added in Perl 5.011
219
220 'imprecision' => 92,
221 'illegalproto' => 94,
222 );
223
224116µsour %Bits = (
225 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..47]
226 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [29]
227 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [30]
228 'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
229 'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
230 'debugging' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [22]
231 'deprecated' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
232 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [31]
233 'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
234 'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
235 'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
236 'illegalproto' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [47]
237 'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [46]
238 'inplace' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [23]
239 'internal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [24]
240 'io' => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
241 'layer' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
242 'malloc' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [25]
243 'misc' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
244 'newline' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
245 'numeric' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
246 'once' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
247 'overflow' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
248 'pack' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [16]
249 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [32]
250 'pipe' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
251 'portable' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [17]
252 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [33]
253 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [34]
254 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [35]
255 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [36]
256 'recursion' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [18]
257 'redefine' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [19]
258 'regexp' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [20]
259 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [37]
260 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [38]
261 'severe' => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00", # [21..25]
262 'signal' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [26]
263 'substr' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [27]
264 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x40", # [28..38,47]
265 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [39]
266 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [40]
267 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [41]
268 'unopened' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
269 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [42]
270 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [43]
271 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [44]
272 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [45]
273 );
274
275111µsour %DeadBits = (
276 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..47]
277 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [29]
278 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [30]
279 'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
280 'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1]
281 'debugging' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [22]
282 'deprecated' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2]
283 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [31]
284 'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
285 'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
286 'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
287 'illegalproto' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [47]
288 'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [46]
289 'inplace' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [23]
290 'internal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [24]
291 'io' => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [5..11]
292 'layer' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8]
293 'malloc' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [25]
294 'misc' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [12]
295 'newline' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9]
296 'numeric' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [13]
297 'once' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [14]
298 'overflow' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [15]
299 'pack' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [16]
300 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [32]
301 'pipe' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10]
302 'portable' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [17]
303 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [33]
304 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [34]
305 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [35]
306 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [36]
307 'recursion' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [18]
308 'redefine' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [19]
309 'regexp' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [20]
310 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [37]
311 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [38]
312 'severe' => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00", # [21..25]
313 'signal' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [26]
314 'substr' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [27]
315 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x80", # [28..38,47]
316 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [39]
317 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [40]
318 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [41]
319 'unopened' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11]
320 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [42]
321 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [43]
322 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [44]
323 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [45]
324 );
325
32611µs$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
32711µs$LAST_BIT = 96 ;
3281800ns$BYTES = 12 ;
329
33029µs$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
331
332sub Croaker
333{
334 require Carp; # this initializes %CarpInternal
335 local $Carp::CarpInternal{'warnings'};
336 delete $Carp::CarpInternal{'warnings'};
337 Carp::croak(@_);
338}
339
340
# spent 57µs within warnings::_bits which was called 2 times, avg 29µs/call: # once (33µs+0s) by warnings::bits at line 371 # once (25µs+0s) by warnings::import at line 386
sub _bits {
34123µs my $mask = shift ;
34222µs my $catmask ;
34322µs my $fatal = 0 ;
34423µs my $no_fatal = 0 ;
345
34626µs foreach my $word ( @_ ) {
347420µs if ($word eq 'FATAL') {
34822µs $fatal = 1;
34922µs $no_fatal = 0;
350 }
351 elsif ($word eq 'NONFATAL') {
352 $fatal = 0;
353 $no_fatal = 1;
354 }
355 elsif ($catmask = $Bits{$word}) {
35623µs $mask |= $catmask ;
35725µs $mask |= $DeadBits{$word} if $fatal ;
35822µs $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
359 }
360 else
361 { Croaker("Unknown warnings category '$word'")}
362 }
363
364213µs return $mask ;
365}
366
367sub bits
368
# spent 44µs (11+33) within warnings::bits which was called: # once (11µs+33µs) by Mouse::Exporter::BEGIN@13 at line 13 of Mouse/Exporter.pm
{
369 # called from B::Deparse.pm
37012µs push @_, 'all' unless @_ ;
37118µs133µs return _bits(undef, @_) ;
# spent 33µs making 1 call to warnings::_bits
372}
373
374sub import
375
# spent 559µs (534+25) within warnings::import which was called 50 times, avg 11µs/call: # 13 times (149µs+0s) by Any::Moose::import at line 51 of Any/Moose.pm, avg 11µs/call # once (14µs+25µs) by Mouse::Util::BEGIN@14 at line 14 of Mouse/Util.pm # once (25µs+0s) by main::BEGIN@4 at line 4 of reply.pl # once (17µs+0s) by Regexp::Common::BEGIN@18 at line 18 of Regexp/Common.pm # once (14µs+0s) by utf8::BEGIN@3 at line 3 of utf8_heavy.pl # once (13µs+0s) by Regexp::Common::URI::BEGIN@17 at line 17 of Regexp/Common/URI.pm # once (12µs+0s) by Mouse::Exporter::BEGIN@3 at line 3 of Mouse/Exporter.pm # once (12µs+0s) by Any::Moose::BEGIN@9 at line 9 of Any/Moose.pm # once (12µs+0s) by Data::OptList::BEGIN@4 at line 4 of Data/OptList.pm # once (11µs+0s) by Package::Stash::BEGIN@6 at line 6 of Package/Stash.pm # once (11µs+0s) by Sub::Install::BEGIN@3 at line 3 of Sub/Install.pm # once (10µs+0s) by Regexp::Common::URI::ftp::BEGIN@9 at line 9 of Regexp/Common/URI/ftp.pm # once (10µs+0s) by mro::BEGIN@11 at line 11 of mro.pm # once (10µs+0s) by Regexp::Common::URI::RFC1808::BEGIN@14 at line 14 of Regexp/Common/URI/RFC1808.pm # once (10µs+0s) by Regexp::Common::URI::BEGIN@6 at line 6 of Regexp/Common/URI.pm # once (10µs+0s) by B::Hooks::EndOfScope::BEGIN@3 at line 3 of Sub/Exporter.pm # once (9µs+0s) by Regexp::Common::URI::prospero::BEGIN@9 at line 9 of Regexp/Common/URI/prospero.pm # once (9µs+0s) by Regexp::Common::URI::file::BEGIN@8 at line 8 of Regexp/Common/URI/file.pm # once (9µs+0s) by Regexp::Common::URI::RFC1035::BEGIN@6 at line 6 of Regexp/Common/URI/RFC1035.pm # once (9µs+0s) by Regexp::Common::URI::RFC2806::BEGIN@7 at line 7 of Regexp/Common/URI/RFC2806.pm # once (9µs+0s) by Regexp::Common::URI::RFC1738::BEGIN@6 at line 6 of Regexp/Common/URI/RFC1738.pm # once (9µs+0s) by autodie::BEGIN@4 at line 4 of autodie.pm # once (9µs+0s) by Regexp::Common::URI::fax::BEGIN@9 at line 9 of Regexp/Common/URI/fax.pm # once (9µs+0s) by Regexp::Common::URI::RFC2384::BEGIN@8 at line 8 of Regexp/Common/URI/RFC2384.pm # once (9µs+0s) by Regexp::Common::URI::telnet::BEGIN@8 at line 8 of Regexp/Common/URI/telnet.pm # once (9µs+0s) by namespace::clean::BEGIN@2.4 at line 2 of B/Hooks/EndOfScope.pm # once (9µs+0s) by namespace::clean::BEGIN@10 at line 10 of namespace/clean.pm # once (9µs+0s) by Regexp::Common::URI::http::BEGIN@8 at line 8 of Regexp/Common/URI/http.pm # once (9µs+0s) by Regexp::Common::URI::RFC2396::BEGIN@6 at line 6 of Regexp/Common/URI/RFC2396.pm # once (9µs+0s) by Variable::Magic::BEGIN@6 at line 6 of Variable/Magic.pm # once (9µs+0s) by Regexp::Common::URI::tel::BEGIN@9 at line 9 of Regexp/Common/URI/tel.pm # once (9µs+0s) by Regexp::Common::URI::gopher::BEGIN@9 at line 9 of Regexp/Common/URI/gopher.pm # once (9µs+0s) by Regexp::Common::URI::wais::BEGIN@9 at line 9 of Regexp/Common/URI/wais.pm # once (9µs+0s) by Fatal::BEGIN@6 at line 6 of Fatal.pm # once (8µs+0s) by Sub::Name::BEGIN@45 at line 45 of Sub/Name.pm # once (8µs+0s) by Regexp::Common::URI::tv::BEGIN@11 at line 11 of Regexp/Common/URI/tv.pm # once (8µs+0s) by Regexp::Common::URI::pop::BEGIN@9 at line 9 of Regexp/Common/URI/pop.pm # once (8µs+0s) by Regexp::Common::URI::news::BEGIN@9 at line 9 of Regexp/Common/URI/news.pm
{
3765053µs shift;
377
37850106µs my $mask = ${^WARNING_BITS} ;
379
3805099µs if (vec($mask, $Offsets{'all'}, 1)) {
38158µs $mask |= $Bits{'all'} ;
38259µs $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
383 }
384
385 # Empty @_ is equivalent to @_ = 'all' ;
38650370µs125µs ${^WARNING_BITS} = @_ ? _bits($mask, @_) : $mask | $Bits{all} ;
# spent 25µs making 1 call to warnings::_bits
387}
388
389sub unimport
390
# spent 308µs within warnings::unimport which was called 11 times, avg 28µs/call: # once (42µs+0s) by Hailo::BEGIN@6 at line 6 of (eval 3)[Fatal.pm:1102] # once (32µs+0s) by Package::Stash::BEGIN@108 at line 108 of Package/Stash.pm # once (31µs+0s) by Hailo::BEGIN@6.3 at line 6 of (eval 5)[Fatal.pm:1102] # once (30µs+0s) by Mouse::Util::BEGIN@13 at line 13 of Mouse/Util.pm # once (27µs+0s) by Hailo::BEGIN@86 at line 86 of (eval 3)[Fatal.pm:1102] # once (27µs+0s) by utf8::BEGIN@383 at line 383 of utf8_heavy.pl # once (26µs+0s) by Hailo::BEGIN@44 at line 44 of (eval 5)[Fatal.pm:1102] # once (26µs+0s) by Hailo::BEGIN@46 at line 46 of (eval 3)[Fatal.pm:1102] # once (26µs+0s) by namespace::clean::BEGIN@159 at line 159 of namespace/clean.pm # once (22µs+0s) by Exporter::Heavy::BEGIN@197 at line 197 of Exporter/Heavy.pm # once (18µs+0s) by Carp::BEGIN@314 at line 314 of Carp.pm
{
3911112µs shift;
392
3931113µs my $catmask ;
3941131µs my $mask = ${^WARNING_BITS} ;
395
3961133µs if (vec($mask, $Offsets{'all'}, 1)) {
397916µs $mask |= $Bits{'all'} ;
398916µs $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
399 }
400
4011115µs push @_, 'all' unless @_;
402
4031131µs foreach my $word ( @_ ) {
4042496µs if ($word eq 'FATAL') {
405 next;
406 }
407 elsif ($catmask = $Bits{$word}) {
408 $mask &= ~($catmask | $DeadBits{$word} | $All);
409 }
410 else
411 { Croaker("Unknown warnings category '$word'")}
412 }
413
4141178µs ${^WARNING_BITS} = $mask ;
415}
416
41726µsmy %builtin_type; @builtin_type{qw(SCALAR ARRAY HASH CODE REF GLOB LVALUE Regexp)} = ();
418
419sub MESSAGE () { 4 };
420sub FATAL () { 2 };
421sub NORMAL () { 1 };
422
423sub __chk
424{
425 my $category ;
426 my $offset ;
427 my $isobj = 0 ;
428 my $wanted = shift;
429 my $has_message = $wanted & MESSAGE;
430
431 unless (@_ == 1 || @_ == ($has_message ? 2 : 0)) {
432 my $sub = (caller 1)[3];
433 my $syntax = $has_message ? "[category,] 'message'" : '[category]';
434 Croaker("Usage: $sub($syntax)");
435 }
436
437 my $message = pop if $has_message;
438
439 if (@_) {
440 # check the category supplied.
441 $category = shift ;
442 if (my $type = ref $category) {
443 Croaker("not an object")
444 if exists $builtin_type{$type};
445 $category = $type;
446 $isobj = 1 ;
447 }
448 $offset = $Offsets{$category};
449 Croaker("Unknown warnings category '$category'")
450 unless defined $offset;
451 }
452 else {
453 $category = (caller(1))[0] ;
454 $offset = $Offsets{$category};
455 Croaker("package '$category' not registered for warnings")
456 unless defined $offset ;
457 }
458
459 my $i;
460
461 if ($isobj) {
462 my $pkg;
463 $i = 2;
464 while (do { { package DB; $pkg = (caller($i++))[0] } } ) {
465 last unless @DB::args && $DB::args[0] =~ /^$category=/ ;
466 }
467 $i -= 2 ;
468 }
469 else {
470 $i = _error_loc(); # see where Carp will allocate the error
471 }
472
473 # Defaulting this to 0 reduces complexity in code paths below.
474 my $callers_bitmask = (caller($i))[9] || 0 ;
475
476 my @results;
477 foreach my $type (FATAL, NORMAL) {
478 next unless $wanted & $type;
479
480 push @results, (vec($callers_bitmask, $offset + $type - 1, 1) ||
481 vec($callers_bitmask, $Offsets{'all'} + $type - 1, 1));
482 }
483
484 # &enabled and &fatal_enabled
485 return $results[0] unless $has_message;
486
487 # &warnif, and the category is neither enabled as warning nor as fatal
488 return if $wanted == (NORMAL | FATAL | MESSAGE)
489 && !($results[0] || $results[1]);
490
491 require Carp;
492 Carp::croak($message) if $results[0];
493 # will always get here for &warn. will only get here for &warnif if the
494 # category is enabled
495 Carp::carp($message);
496}
497
498sub _mkMask
499
# spent 68µs within warnings::_mkMask which was called 8 times, avg 8µs/call: # 4 times (40µs+0s) by warnings::register_categories at line 513, avg 10µs/call # 4 times (28µs+0s) by warnings::register_categories at line 519, avg 7µs/call
{
500810µs my ($bit) = @_;
501810µs my $mask = "";
502
503818µs vec($mask, $bit, 1) = 1;
504840µs return $mask;
505}
506
507sub register_categories
508
# spent 701µs (633+68) within warnings::register_categories which was called 4 times, avg 175µs/call: # 4 times (633µs+68µs) by warnings::register::import at line 43 of warnings/register.pm, avg 175µs/call
{
50947µs my @names = @_;
510
511424µs for my $name (@names) {
512418µs if (! defined $Bits{$name}) {
513422µs440µs $Bits{$name} = _mkMask($LAST_BIT);
# spent 40µs making 4 calls to warnings::_mkMask, avg 10µs/call
51448µs vec($Bits{'all'}, $LAST_BIT, 1) = 1;
51547µs $Offsets{$name} = $LAST_BIT ++;
516452µs foreach my $k (keys %Bits) {
517202462µs vec($Bits{$k}, $LAST_BIT, 1) = 0;
518 }
519417µs428µs $DeadBits{$name} = _mkMask($LAST_BIT);
# spent 28µs making 4 calls to warnings::_mkMask, avg 7µs/call
52049µs vec($DeadBits{'all'}, $LAST_BIT++, 1) = 1;
521 }
522 }
523}
524
525sub _error_loc {
526 require Carp;
527 goto &Carp::short_error_loc; # don't introduce another stack frame
528}
529
530sub enabled
531{
532 return __chk(NORMAL, @_);
533}
534
535sub fatal_enabled
536{
537 return __chk(FATAL, @_);
538}
539
540sub warn
541{
542 return __chk(FATAL | MESSAGE, @_);
543}
544
545sub warnif
546{
547 return __chk(NORMAL | FATAL | MESSAGE, @_);
548}
549
550# These are not part of any public interface, so we can delete them to save
551# space.
55219µsdelete $warnings::{$_} foreach qw(NORMAL FATAL MESSAGE);
553
554130µs1;
555# ex: set ro:
 
# spent 5µs within warnings::CORE:match which was called: # once (5µs+0s) by main::BEGIN@4 at line 13
sub warnings::CORE:match; # opcode
# spent 17µs within warnings::CORE:regcomp which was called: # once (17µs+0s) by main::BEGIN@4 at line 13
sub warnings::CORE:regcomp; # opcode