← Index
NYTProf Performance Profile   « block view • line view • sub view »
For bin/hailo
  Run on Thu Oct 21 22:50:37 2010
Reported on Thu Oct 21 22:52:04 2010

Filename/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/5.13.5/warnings.pm
StatementsExecuted 786 statements in 2.65ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
695351756µs784µswarnings::::importwarnings::import
411607µs670µswarnings::::register_categorieswarnings::register_categories
151512421µs421µswarnings::::unimportwarnings::unimport
82163µs63µswarnings::::_mkMaskwarnings::_mkMask
22158µs58µswarnings::::_bitswarnings::_bits
11151µs195µswarnings::::__chkwarnings::__chk
11142µs42µswarnings::::CORE:regcompwarnings::CORE:regcomp (opcode)
11118µs18µswarnings::::CORE:matchwarnings::CORE:match (opcode)
11111µs41µswarnings::::bitswarnings::bits
1119µs204µswarnings::::enabledwarnings::enabled
1116µs6µswarnings::::_error_locwarnings::_error_loc
0000s0swarnings::::Croakerwarnings::Croaker
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
913µsour $VERSION = '1.11';
10
11# Verify that we're called correctly so that warnings will work.
12# see also strict.pm.
13197µs260µsunless ( __FILE__ =~ /(^|[\/\\])\Q${\__PACKAGE__}\E\.pmc?$/ ) {
# spent 42µs making 1 call to warnings::CORE:regcomp # spent 18µ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
1671104µ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
224143µ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
275148µ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
32612µs$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0";
32711µs$LAST_BIT = 96 ;
32811µs$BYTES = 12 ;
329
330218µ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 58µs within warnings::_bits which was called 2 times, avg 29µs/call: # once (31µs+0s) by warnings::bits at line 371 # once (27µs+0s) by warnings::import at line 386
sub _bits {
3412666µs my $mask = shift ;
342 my $catmask ;
343 my $fatal = 0 ;
344 my $no_fatal = 0 ;
345
346 foreach my $word ( @_ ) {
347 if ($word eq 'FATAL') {
348 $fatal = 1;
349 $no_fatal = 0;
350 }
351 elsif ($word eq 'NONFATAL') {
352 $fatal = 0;
353 $no_fatal = 1;
354 }
355 elsif ($catmask = $Bits{$word}) {
356 $mask |= $catmask ;
357 $mask |= $DeadBits{$word} if $fatal ;
358 $mask &= ~($DeadBits{$word}|$All) if $no_fatal ;
359 }
360 else
361 { Croaker("Unknown warnings category '$word'")}
362 }
363
364 return $mask ;
365}
366
367sub bits
368
# spent 41µs (11+31) within warnings::bits which was called: # once (11µs+31µs) by Mouse::Exporter::BEGIN@13 at line 13 of Mouse/Exporter.pm
{
369 # called from B::Deparse.pm
370210µs push @_, 'all' unless @_ ;
371131µs return _bits(undef, @_) ;
# spent 31µs making 1 call to warnings::_bits
372}
373
374sub import
375
# spent 784µs (756+27) within warnings::import which was called 69 times, avg 11µs/call: # 17 times (187µs+0s) by Any::Moose::import at line 51 of Any/Moose.pm, avg 11µs/call # once (19µs+27µs) by Mouse::Util::BEGIN@14 at line 14 of Mouse/Util.pm # once (29µs+0s) by open::BEGIN@2 at line 2 of open.pm # once (21µs+0s) by IO::Interactive::BEGIN@5 at line 5 of IO/Interactive.pm # once (15µs+0s) by Mouse::Exporter::BEGIN@3 at line 3 of Mouse/Exporter.pm # once (15µs+0s) by mro::BEGIN@11 at line 11 of mro.pm # once (14µs+0s) by utf8::BEGIN@3 at line 3 of utf8_heavy.pl # once (14µs+0s) by Any::Moose::BEGIN@9 at line 9 of Any/Moose.pm # once (14µs+0s) by Term::Sk::BEGIN@4 at line 4 of Term/Sk.pm # once (13µs+0s) by Sub::Install::BEGIN@3 at line 3 of Sub/Install.pm # once (13µs+0s) by Encode::Config::BEGIN@8 at line 8 of Encode/Config.pm # once (13µs+0s) by Regexp::Common::URI::BEGIN@17 at line 17 of Regexp/Common/URI.pm # once (13µs+0s) by Regexp::Common::URI::BEGIN@6 at line 6 of Regexp/Common/URI.pm # once (13µs+0s) by autodie::BEGIN@4 at line 4 of autodie.pm # once (12µs+0s) by Params::Validate::BEGIN@4 at line 4 of Params/ValidateXS.pm # once (12µs+0s) by Encode::Alias::BEGIN@3 at line 3 of Encode/Alias.pm # once (11µs+0s) by Regexp::Common::URI::wais::BEGIN@9 at line 9 of Regexp/Common/URI/wais.pm # once (11µs+0s) by File::CountLines::BEGIN@3 at line 3 of File/CountLines.pm # once (11µs+0s) by Encode::Encoding::BEGIN@5 at line 5 of Encode/Encoding.pm # once (10µs+0s) by Sub::Exporter::Util::BEGIN@3 at line 3 of Sub/Exporter.pm # once (10µs+0s) by namespace::clean::BEGIN@10 at line 10 of namespace/clean.pm # once (10µs+0s) by Getopt::Long::Descriptive::BEGIN@2 at line 2 of Getopt/Long/Descriptive/Opts.pm # once (10µs+0s) by IO::BEGIN@8 at line 8 of IO.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::tv::BEGIN@11 at line 11 of Regexp/Common/URI/tv.pm # once (9µs+0s) by Getopt::Long::Descriptive::BEGIN@2.6 at line 2 of Sub/Exporter/Util.pm # once (9µs+0s) by Package::Stash::BEGIN@6 at line 6 of Package/Stash.pm # once (9µs+0s) by namespace::clean::BEGIN@2.7 at line 2 of B/Hooks/EndOfScope.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 File::Basename::BEGIN@52 at line 52 of File/Basename.pm # once (9µs+0s) by Encode::BEGIN@6 at line 6 of Encode.pm # once (9µs+0s) by Regexp::Common::URI::RFC1808::BEGIN@14 at line 14 of Regexp/Common/URI/RFC1808.pm # once (9µs+0s) by MouseX::Getopt::GLD::BEGIN@2.3 at line 2 of Getopt/Long/Descriptive.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 Sub::Name::BEGIN@45 at line 45 of Sub/Name.pm # once (9µs+0s) by charnames::BEGIN@3 at line 3 of charnames.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::tel::BEGIN@9 at line 9 of Regexp/Common/URI/tel.pm # once (9µs+0s) by Fatal::BEGIN@6 at line 6 of Fatal.pm # once (9µs+0s) by Getopt::Long::Descriptive::Usage::BEGIN@3 at line 3 of Getopt/Long/Descriptive/Usage.pm # once (9µs+0s) by Regexp::Common::BEGIN@18 at line 18 of Regexp/Common.pm # once (9µs+0s) by Data::OptList::BEGIN@4 at line 4 of Data/OptList.pm # once (9µs+0s) by Regexp::Common::URI::news::BEGIN@9 at line 9 of Regexp/Common/URI/news.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::RFC2396::BEGIN@6 at line 6 of Regexp/Common/URI/RFC2396.pm # once (9µs+0s) by Regexp::Common::URI::pop::BEGIN@9 at line 9 of Regexp/Common/URI/pop.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::RFC1035::BEGIN@6 at line 6 of Regexp/Common/URI/RFC1035.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::RFC2806::BEGIN@7 at line 7 of Regexp/Common/URI/RFC2806.pm # once (8µs+0s) by Regexp::Common::URI::ftp::BEGIN@9 at line 9 of Regexp/Common/URI/ftp.pm # once (8µs+0s) by Regexp::Common::URI::RFC2384::BEGIN@8 at line 8 of Regexp/Common/URI/RFC2384.pm # once (8µs+0s) by Regexp::Common::URI::gopher::BEGIN@9 at line 9 of Regexp/Common/URI/gopher.pm
{
376290919µs shift;
377
378 my $mask = ${^WARNING_BITS} ;
379
380 if (vec($mask, $Offsets{'all'}, 1)) {
381 $mask |= $Bits{'all'} ;
382 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
383 }
384
385 # Empty @_ is equivalent to @_ = 'all' ;
386127µs ${^WARNING_BITS} = @_ ? _bits($mask, @_) : $mask | $Bits{all} ;
# spent 27µs making 1 call to warnings::_bits
387}
388
389sub unimport
390
# spent 421µs within warnings::unimport which was called 15 times, avg 28µs/call: # once (35µs+0s) by Encode::BEGIN@240 at line 240 of Encode.pm # once (35µs+0s) by namespace::clean::BEGIN@159 at line 159 of namespace/clean.pm # once (33µs+0s) by Package::Stash::BEGIN@108 at line 108 of Package/Stash.pm # once (33µs+0s) by Hailo::BEGIN@6 at line 6 of (eval 29)[Fatal.pm:1102] # once (30µs+0s) by Mouse::Util::BEGIN@13 at line 13 of Mouse/Util.pm # once (28µs+0s) by Encode::Alias::BEGIN@4 at line 4 of Encode/Alias.pm # once (27µs+0s) by charnames::BEGIN@692 at line 692 of charnames.pm # once (27µs+0s) by Hailo::BEGIN@44 at line 44 of (eval 31)[Fatal.pm:1102] # once (26µs+0s) by Hailo::BEGIN@46 at line 46 of (eval 29)[Fatal.pm:1102] # once (26µs+0s) by Hailo::BEGIN@6.9 at line 6 of (eval 31)[Fatal.pm:1102] # once (26µs+0s) by Hailo::BEGIN@86 at line 86 of (eval 29)[Fatal.pm:1102] # once (25µs+0s) by Carp::BEGIN@314 at line 314 of Carp.pm # once (25µs+0s) by utf8::BEGIN@383 at line 383 of utf8_heavy.pl # once (24µs+0s) by Exporter::Heavy::BEGIN@197 at line 197 of Exporter/Heavy.pm # once (22µs+0s) by Hailo::Command::BEGIN@370 at line 370 of lib/Hailo/Command.pm
{
391159464µs shift;
392
393 my $catmask ;
394 my $mask = ${^WARNING_BITS} ;
395
396 if (vec($mask, $Offsets{'all'}, 1)) {
397 $mask |= $Bits{'all'} ;
398 $mask |= $DeadBits{'all'} if vec($mask, $Offsets{'all'}+1, 1);
399 }
400
401 push @_, 'all' unless @_;
402
403 foreach my $word ( @_ ) {
404 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
414 ${^WARNING_BITS} = $mask ;
415}
416
417211µ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
# spent 195µs (51+144) within warnings::__chk which was called: # once (51µs+144µs) by warnings::enabled at line 532
{
4252246µs 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 {
47016µs $i = _error_loc(); # see where Carp will allocate the error
# spent 6µs making 1 call to warnings::_error_loc
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 63µs within warnings::_mkMask which was called 8 times, avg 8µs/call: # 4 times (36µs+0s) by warnings::register_categories at line 513, avg 9µs/call # 4 times (27µs+0s) by warnings::register_categories at line 519, avg 7µs/call
{
5003277µs my ($bit) = @_;
501 my $mask = "";
502
503 vec($mask, $bit, 1) = 1;
504 return $mask;
505}
506
507sub register_categories
508
# spent 670µs (607+63) within warnings::register_categories which was called 4 times, avg 168µs/call: # 4 times (607µs+63µs) by warnings::register::import at line 43 of warnings/register.pm, avg 168µs/call
{
509238595µs my @names = @_;
510
511 for my $name (@names) {
512 if (! defined $Bits{$name}) {
513436µs $Bits{$name} = _mkMask($LAST_BIT);
# spent 36µs making 4 calls to warnings::_mkMask, avg 9µs/call
514 vec($Bits{'all'}, $LAST_BIT, 1) = 1;
515 $Offsets{$name} = $LAST_BIT ++;
516 foreach my $k (keys %Bits) {
517 vec($Bits{$k}, $LAST_BIT, 1) = 0;
518 }
519427µs $DeadBits{$name} = _mkMask($LAST_BIT);
# spent 27µs making 4 calls to warnings::_mkMask, avg 7µs/call
520 vec($DeadBits{'all'}, $LAST_BIT++, 1) = 1;
521 }
522 }
523}
524
525
# spent 6µs within warnings::_error_loc which was called: # once (6µs+0s) by warnings::__chk at line 470
sub _error_loc {
526211µs require Carp;
5271138µs goto &Carp::short_error_loc; # don't introduce another stack frame
# spent 138µs making 1 call to Carp::short_error_loc
528}
529
530sub enabled
531
# spent 204µs (9+195) within warnings::enabled which was called: # once (9µs+195µs) by charnames::import at line 753 of charnames.pm
{
53218µs1195µs return __chk(NORMAL, @_);
# spent 195µs making 1 call to warnings::__chk
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.
552121µsdelete $warnings::{$_} foreach qw(NORMAL FATAL MESSAGE);
553
554198µs1;
555# ex: set ro:
 
# spent 18µs within warnings::CORE:match which was called: # once (18µs+0s) by open::BEGIN@2 at line 13
sub warnings::CORE:match; # opcode
# spent 42µs within warnings::CORE:regcomp which was called: # once (42µs+0s) by open::BEGIN@2 at line 13
sub warnings::CORE:regcomp; # opcode