Filename | /usr/lib/x86_64-linux-gnu/perl/5.20/IO/Handle.pm |
Statements | Executed 47 statements in 4.82ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 1.44ms | 1.80ms | BEGIN@9 | IO::Handle::
1 | 1 | 1 | 116µs | 116µs | _create_getline_subs (xsub) | IO::Handle::
4 | 1 | 1 | 31µs | 57µs | read | IO::Handle::
4 | 1 | 1 | 26µs | 26µs | CORE:read (opcode) | IO::Handle::
1 | 1 | 1 | 24µs | 24µs | BEGIN@3 | IO::Handle::
4 | 1 | 1 | 21µs | 21µs | CORE:eof (opcode) | IO::Handle::
1 | 1 | 1 | 17µs | 34µs | BEGIN@370 | IO::Handle::
4 | 2 | 1 | 15µs | 36µs | eof | IO::Handle::
2 | 1 | 1 | 14µs | 29µs | new | IO::Handle::
1 | 1 | 1 | 10µs | 60µs | BEGIN@6 | IO::Handle::
1 | 1 | 1 | 9µs | 50µs | BEGIN@7 | IO::Handle::
1 | 1 | 1 | 8µs | 24µs | BEGIN@4 | IO::Handle::
1 | 1 | 1 | 5µs | 5µs | BEGIN@8 | IO::Handle::
0 | 0 | 0 | 0s | 0s | DESTROY | IO::Handle::
0 | 0 | 0 | 0s | 0s | _open_mode_string | IO::Handle::
0 | 0 | 0 | 0s | 0s | autoflush | IO::Handle::
0 | 0 | 0 | 0s | 0s | close | IO::Handle::
0 | 0 | 0 | 0s | 0s | constant | IO::Handle::
0 | 0 | 0 | 0s | 0s | fcntl | IO::Handle::
0 | 0 | 0 | 0s | 0s | fdopen | IO::Handle::
0 | 0 | 0 | 0s | 0s | fileno | IO::Handle::
0 | 0 | 0 | 0s | 0s | format_formfeed | IO::Handle::
0 | 0 | 0 | 0s | 0s | format_line_break_characters | IO::Handle::
0 | 0 | 0 | 0s | 0s | format_lines_left | IO::Handle::
0 | 0 | 0 | 0s | 0s | format_lines_per_page | IO::Handle::
0 | 0 | 0 | 0s | 0s | format_name | IO::Handle::
0 | 0 | 0 | 0s | 0s | format_page_number | IO::Handle::
0 | 0 | 0 | 0s | 0s | format_top_name | IO::Handle::
0 | 0 | 0 | 0s | 0s | format_write | IO::Handle::
0 | 0 | 0 | 0s | 0s | formline | IO::Handle::
0 | 0 | 0 | 0s | 0s | getc | IO::Handle::
0 | 0 | 0 | 0s | 0s | input_line_number | IO::Handle::
0 | 0 | 0 | 0s | 0s | input_record_separator | IO::Handle::
0 | 0 | 0 | 0s | 0s | ioctl | IO::Handle::
0 | 0 | 0 | 0s | 0s | new_from_fd | IO::Handle::
0 | 0 | 0 | 0s | 0s | opened | IO::Handle::
0 | 0 | 0 | 0s | 0s | output_field_separator | IO::Handle::
0 | 0 | 0 | 0s | 0s | output_record_separator | IO::Handle::
0 | 0 | 0 | 0s | 0s | |
0 | 0 | 0 | 0s | 0s | printf | IO::Handle::
0 | 0 | 0 | 0s | 0s | printflush | IO::Handle::
0 | 0 | 0 | 0s | 0s | say | IO::Handle::
0 | 0 | 0 | 0s | 0s | stat | IO::Handle::
0 | 0 | 0 | 0s | 0s | sysread | IO::Handle::
0 | 0 | 0 | 0s | 0s | syswrite | IO::Handle::
0 | 0 | 0 | 0s | 0s | truncate | IO::Handle::
0 | 0 | 0 | 0s | 0s | write | IO::Handle::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package IO::Handle; | ||||
2 | |||||
3 | 2 | 60µs | 1 | 24µs | # spent 24µs within IO::Handle::BEGIN@3 which was called:
# once (24µs+0s) by IO::Seekable::BEGIN@9 at line 3 # spent 24µs making 1 call to IO::Handle::BEGIN@3 |
4 | 2 | 64µs | 2 | 40µs | # spent 24µs (8+16) within IO::Handle::BEGIN@4 which was called:
# once (8µs+16µs) by IO::Seekable::BEGIN@9 at line 4 # spent 24µs making 1 call to IO::Handle::BEGIN@4
# spent 16µs making 1 call to strict::import |
5 | 1 | 600ns | our($VERSION, @EXPORT_OK, @ISA); | ||
6 | 2 | 34µs | 2 | 111µs | # spent 60µs (10+50) within IO::Handle::BEGIN@6 which was called:
# once (10µs+50µs) by IO::Seekable::BEGIN@9 at line 6 # spent 60µs making 1 call to IO::Handle::BEGIN@6
# spent 50µs making 1 call to Exporter::import |
7 | 2 | 32µs | 2 | 92µs | # spent 50µs (9+42) within IO::Handle::BEGIN@7 which was called:
# once (9µs+42µs) by IO::Seekable::BEGIN@9 at line 7 # spent 50µs making 1 call to IO::Handle::BEGIN@7
# spent 42µs making 1 call to Exporter::import |
8 | 2 | 34µs | 1 | 5µs | # spent 5µs within IO::Handle::BEGIN@8 which was called:
# once (5µs+0s) by IO::Seekable::BEGIN@9 at line 8 # spent 5µs making 1 call to IO::Handle::BEGIN@8 |
9 | 2 | 4.07ms | 1 | 1.80ms | # spent 1.80ms (1.44+355µs) within IO::Handle::BEGIN@9 which was called:
# once (1.44ms+355µs) by IO::Seekable::BEGIN@9 at line 9 # spent 1.80ms making 1 call to IO::Handle::BEGIN@9 |
10 | |||||
11 | 1 | 900ns | require Exporter; | ||
12 | 1 | 16µs | @ISA = qw(Exporter); | ||
13 | |||||
14 | 1 | 400ns | $VERSION = "1.35"; | ||
15 | 1 | 20µs | $VERSION = eval $VERSION; # spent 3µs executing statements in string eval | ||
16 | |||||
17 | 1 | 3µs | @EXPORT_OK = qw( | ||
18 | autoflush | ||||
19 | output_field_separator | ||||
20 | output_record_separator | ||||
21 | input_record_separator | ||||
22 | input_line_number | ||||
23 | format_page_number | ||||
24 | format_lines_per_page | ||||
25 | format_lines_left | ||||
26 | format_name | ||||
27 | format_top_name | ||||
28 | format_line_break_characters | ||||
29 | format_formfeed | ||||
30 | format_write | ||||
31 | |||||
32 | |||||
33 | printf | ||||
34 | say | ||||
35 | getline | ||||
36 | getlines | ||||
37 | |||||
38 | printflush | ||||
39 | flush | ||||
40 | |||||
41 | SEEK_SET | ||||
42 | SEEK_CUR | ||||
43 | SEEK_END | ||||
44 | _IOFBF | ||||
45 | _IOLBF | ||||
46 | _IONBF | ||||
47 | ); | ||||
48 | |||||
49 | ################################################ | ||||
50 | ## Constructors, destructors. | ||||
51 | ## | ||||
52 | |||||
53 | # spent 29µs (14+16) within IO::Handle::new which was called 2 times, avg 15µs/call:
# 2 times (14µs+16µs) by IO::File::new at line 38 of IO/File.pm, avg 15µs/call | ||||
54 | 2 | 2µs | my $class = ref($_[0]) || $_[0] || "IO::Handle"; | ||
55 | 2 | 1µs | if (@_ != 1) { | ||
56 | # Since perl will automatically require IO::File if needed, but | ||||
57 | # also initialises IO::File's @ISA as part of the core we must | ||||
58 | # ensure IO::File is loaded if IO::Handle is. This avoids effect- | ||||
59 | # ively "half-loading" IO::File. | ||||
60 | if ($] > 5.013 && $class eq 'IO::File' && !$INC{"IO/File.pm"}) { | ||||
61 | require IO::File; | ||||
62 | shift; | ||||
63 | return IO::File::->new(@_); | ||||
64 | } | ||||
65 | croak "usage: $class->new()"; | ||||
66 | } | ||||
67 | 2 | 5µs | 2 | 16µs | my $io = gensym; # spent 16µs making 2 calls to Symbol::gensym, avg 8µs/call |
68 | 2 | 8µs | bless $io, $class; | ||
69 | } | ||||
70 | |||||
71 | sub new_from_fd { | ||||
72 | my $class = ref($_[0]) || $_[0] || "IO::Handle"; | ||||
73 | @_ == 3 or croak "usage: $class->new_from_fd(FD, MODE)"; | ||||
74 | my $io = gensym; | ||||
75 | shift; | ||||
76 | IO::Handle::fdopen($io, @_) | ||||
77 | or return undef; | ||||
78 | bless $io, $class; | ||||
79 | } | ||||
80 | |||||
81 | # | ||||
82 | # There is no need for DESTROY to do anything, because when the | ||||
83 | # last reference to an IO object is gone, Perl automatically | ||||
84 | # closes its associated files (if any). However, to avoid any | ||||
85 | # attempts to autoload DESTROY, we here define it to do nothing. | ||||
86 | # | ||||
87 | sub DESTROY {} | ||||
88 | |||||
89 | ################################################ | ||||
90 | ## Open and close. | ||||
91 | ## | ||||
92 | |||||
93 | sub _open_mode_string { | ||||
94 | my ($mode) = @_; | ||||
95 | $mode =~ /^\+?(<|>>?)$/ | ||||
96 | or $mode =~ s/^r(\+?)$/$1</ | ||||
97 | or $mode =~ s/^w(\+?)$/$1>/ | ||||
98 | or $mode =~ s/^a(\+?)$/$1>>/ | ||||
99 | or croak "IO::Handle: bad open mode: $mode"; | ||||
100 | $mode; | ||||
101 | } | ||||
102 | |||||
103 | sub fdopen { | ||||
104 | @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)'; | ||||
105 | my ($io, $fd, $mode) = @_; | ||||
106 | local(*GLOB); | ||||
107 | |||||
108 | if (ref($fd) && "".$fd =~ /GLOB\(/o) { | ||||
109 | # It's a glob reference; Alias it as we cannot get name of anon GLOBs | ||||
110 | my $n = qualify(*GLOB); | ||||
111 | *GLOB = *{*$fd}; | ||||
112 | $fd = $n; | ||||
113 | } elsif ($fd =~ m#^\d+$#) { | ||||
114 | # It's an FD number; prefix with "=". | ||||
115 | $fd = "=$fd"; | ||||
116 | } | ||||
117 | |||||
118 | open($io, _open_mode_string($mode) . '&' . $fd) | ||||
119 | ? $io : undef; | ||||
120 | } | ||||
121 | |||||
122 | sub close { | ||||
123 | @_ == 1 or croak 'usage: $io->close()'; | ||||
124 | my($io) = @_; | ||||
125 | |||||
126 | close($io); | ||||
127 | } | ||||
128 | |||||
129 | ################################################ | ||||
130 | ## Normal I/O functions. | ||||
131 | ## | ||||
132 | |||||
133 | # flock | ||||
134 | # select | ||||
135 | |||||
136 | sub opened { | ||||
137 | @_ == 1 or croak 'usage: $io->opened()'; | ||||
138 | defined fileno($_[0]); | ||||
139 | } | ||||
140 | |||||
141 | sub fileno { | ||||
142 | @_ == 1 or croak 'usage: $io->fileno()'; | ||||
143 | fileno($_[0]); | ||||
144 | } | ||||
145 | |||||
146 | sub getc { | ||||
147 | @_ == 1 or croak 'usage: $io->getc()'; | ||||
148 | getc($_[0]); | ||||
149 | } | ||||
150 | |||||
151 | # spent 36µs (15+21) within IO::Handle::eof which was called 4 times, avg 9µs/call:
# 2 times (10µs+17µs) by Date::Manip::TZ::_get_curr_zone at line 475 of Date/Manip/TZ.pm, avg 14µs/call
# 2 times (5µs+4µs) by Date::Manip::TZ::_get_curr_zone at line 526 of Date/Manip/TZ.pm, avg 4µs/call | ||||
152 | 4 | 1µs | @_ == 1 or croak 'usage: $io->eof()'; | ||
153 | 4 | 37µs | 4 | 21µs | eof($_[0]); # spent 21µs making 4 calls to IO::Handle::CORE:eof, avg 5µs/call |
154 | } | ||||
155 | |||||
156 | sub print { | ||||
157 | @_ or croak 'usage: $io->print(ARGS)'; | ||||
158 | my $this = shift; | ||||
159 | print $this @_; | ||||
160 | } | ||||
161 | |||||
162 | sub printf { | ||||
163 | @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])'; | ||||
164 | my $this = shift; | ||||
165 | printf $this @_; | ||||
166 | } | ||||
167 | |||||
168 | sub say { | ||||
169 | @_ or croak 'usage: $io->say(ARGS)'; | ||||
170 | my $this = shift; | ||||
171 | local $\ = "\n"; | ||||
172 | print $this @_; | ||||
173 | } | ||||
174 | |||||
175 | # Special XS wrapper to make them inherit lexical hints from the caller. | ||||
176 | 1 | 121µs | 1 | 116µs | _create_getline_subs( <<'END' ) or die $@; # spent 116µs making 1 call to IO::Handle::_create_getline_subs # spent 3µs executing statements in string eval |
177 | sub getline { | ||||
178 | @_ == 1 or croak 'usage: $io->getline()'; | ||||
179 | my $this = shift; | ||||
180 | return scalar <$this>; | ||||
181 | } | ||||
182 | |||||
183 | sub getlines { | ||||
184 | @_ == 1 or croak 'usage: $io->getlines()'; | ||||
185 | wantarray or | ||||
186 | croak 'Can\'t call $io->getlines in a scalar context, use $io->getline'; | ||||
187 | my $this = shift; | ||||
188 | return <$this>; | ||||
189 | } | ||||
190 | 1; # return true for error checking | ||||
191 | END | ||||
192 | |||||
193 | 1 | 2µs | *gets = \&getline; # deprecated | ||
194 | |||||
195 | sub truncate { | ||||
196 | @_ == 2 or croak 'usage: $io->truncate(LEN)'; | ||||
197 | truncate($_[0], $_[1]); | ||||
198 | } | ||||
199 | |||||
200 | # spent 57µs (31+26) within IO::Handle::read which was called 4 times, avg 14µs/call:
# 4 times (31µs+26µs) by XML::Parser::Expat::ParseStream at line 470 of XML/Parser/Expat.pm, avg 14µs/call | ||||
201 | 4 | 2µs | @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])'; | ||
202 | 4 | 55µs | 4 | 26µs | read($_[0], $_[1], $_[2], $_[3] || 0); # spent 26µs making 4 calls to IO::Handle::CORE:read, avg 6µs/call |
203 | } | ||||
204 | |||||
205 | sub sysread { | ||||
206 | @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])'; | ||||
207 | sysread($_[0], $_[1], $_[2], $_[3] || 0); | ||||
208 | } | ||||
209 | |||||
210 | sub write { | ||||
211 | @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])'; | ||||
212 | local($\) = ""; | ||||
213 | $_[2] = length($_[1]) unless defined $_[2]; | ||||
214 | print { $_[0] } substr($_[1], $_[3] || 0, $_[2]); | ||||
215 | } | ||||
216 | |||||
217 | sub syswrite { | ||||
218 | @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])'; | ||||
219 | if (defined($_[2])) { | ||||
220 | syswrite($_[0], $_[1], $_[2], $_[3] || 0); | ||||
221 | } else { | ||||
222 | syswrite($_[0], $_[1]); | ||||
223 | } | ||||
224 | } | ||||
225 | |||||
226 | sub stat { | ||||
227 | @_ == 1 or croak 'usage: $io->stat()'; | ||||
228 | stat($_[0]); | ||||
229 | } | ||||
230 | |||||
231 | ################################################ | ||||
232 | ## State modification functions. | ||||
233 | ## | ||||
234 | |||||
235 | sub autoflush { | ||||
236 | my $old = new SelectSaver qualify($_[0], caller); | ||||
237 | my $prev = $|; | ||||
238 | $| = @_ > 1 ? $_[1] : 1; | ||||
239 | $prev; | ||||
240 | } | ||||
241 | |||||
242 | sub output_field_separator { | ||||
243 | carp "output_field_separator is not supported on a per-handle basis" | ||||
244 | if ref($_[0]); | ||||
245 | my $prev = $,; | ||||
246 | $, = $_[1] if @_ > 1; | ||||
247 | $prev; | ||||
248 | } | ||||
249 | |||||
250 | sub output_record_separator { | ||||
251 | carp "output_record_separator is not supported on a per-handle basis" | ||||
252 | if ref($_[0]); | ||||
253 | my $prev = $\; | ||||
254 | $\ = $_[1] if @_ > 1; | ||||
255 | $prev; | ||||
256 | } | ||||
257 | |||||
258 | sub input_record_separator { | ||||
259 | carp "input_record_separator is not supported on a per-handle basis" | ||||
260 | if ref($_[0]); | ||||
261 | my $prev = $/; | ||||
262 | $/ = $_[1] if @_ > 1; | ||||
263 | $prev; | ||||
264 | } | ||||
265 | |||||
266 | sub input_line_number { | ||||
267 | local $.; | ||||
268 | () = tell qualify($_[0], caller) if ref($_[0]); | ||||
269 | my $prev = $.; | ||||
270 | $. = $_[1] if @_ > 1; | ||||
271 | $prev; | ||||
272 | } | ||||
273 | |||||
274 | sub format_page_number { | ||||
275 | my $old; | ||||
276 | $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); | ||||
277 | my $prev = $%; | ||||
278 | $% = $_[1] if @_ > 1; | ||||
279 | $prev; | ||||
280 | } | ||||
281 | |||||
282 | sub format_lines_per_page { | ||||
283 | my $old; | ||||
284 | $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); | ||||
285 | my $prev = $=; | ||||
286 | $= = $_[1] if @_ > 1; | ||||
287 | $prev; | ||||
288 | } | ||||
289 | |||||
290 | sub format_lines_left { | ||||
291 | my $old; | ||||
292 | $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); | ||||
293 | my $prev = $-; | ||||
294 | $- = $_[1] if @_ > 1; | ||||
295 | $prev; | ||||
296 | } | ||||
297 | |||||
298 | sub format_name { | ||||
299 | my $old; | ||||
300 | $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); | ||||
301 | my $prev = $~; | ||||
302 | $~ = qualify($_[1], caller) if @_ > 1; | ||||
303 | $prev; | ||||
304 | } | ||||
305 | |||||
306 | sub format_top_name { | ||||
307 | my $old; | ||||
308 | $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); | ||||
309 | my $prev = $^; | ||||
310 | $^ = qualify($_[1], caller) if @_ > 1; | ||||
311 | $prev; | ||||
312 | } | ||||
313 | |||||
314 | sub format_line_break_characters { | ||||
315 | carp "format_line_break_characters is not supported on a per-handle basis" | ||||
316 | if ref($_[0]); | ||||
317 | my $prev = $:; | ||||
318 | $: = $_[1] if @_ > 1; | ||||
319 | $prev; | ||||
320 | } | ||||
321 | |||||
322 | sub format_formfeed { | ||||
323 | carp "format_formfeed is not supported on a per-handle basis" | ||||
324 | if ref($_[0]); | ||||
325 | my $prev = $^L; | ||||
326 | $^L = $_[1] if @_ > 1; | ||||
327 | $prev; | ||||
328 | } | ||||
329 | |||||
330 | sub formline { | ||||
331 | my $io = shift; | ||||
332 | my $picture = shift; | ||||
333 | local($^A) = $^A; | ||||
334 | local($\) = ""; | ||||
335 | formline($picture, @_); | ||||
336 | print $io $^A; | ||||
337 | } | ||||
338 | |||||
339 | sub format_write { | ||||
340 | @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )'; | ||||
341 | if (@_ == 2) { | ||||
342 | my ($io, $fmt) = @_; | ||||
343 | my $oldfmt = $io->format_name(qualify($fmt,caller)); | ||||
344 | CORE::write($io); | ||||
345 | $io->format_name($oldfmt); | ||||
346 | } else { | ||||
347 | CORE::write($_[0]); | ||||
348 | } | ||||
349 | } | ||||
350 | |||||
351 | sub fcntl { | ||||
352 | @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );'; | ||||
353 | my ($io, $op) = @_; | ||||
354 | return fcntl($io, $op, $_[2]); | ||||
355 | } | ||||
356 | |||||
357 | sub ioctl { | ||||
358 | @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );'; | ||||
359 | my ($io, $op) = @_; | ||||
360 | return ioctl($io, $op, $_[2]); | ||||
361 | } | ||||
362 | |||||
363 | # this sub is for compatibility with older releases of IO that used | ||||
364 | # a sub called constant to determine if a constant existed -- GMB | ||||
365 | # | ||||
366 | # The SEEK_* and _IO?BF constants were the only constants at that time | ||||
367 | # any new code should just check defined(&CONSTANT_NAME) | ||||
368 | |||||
369 | sub constant { | ||||
370 | 2 | 245µs | 2 | 51µs | # spent 34µs (17+17) within IO::Handle::BEGIN@370 which was called:
# once (17µs+17µs) by IO::Seekable::BEGIN@9 at line 370 # spent 34µs making 1 call to IO::Handle::BEGIN@370
# spent 17µs making 1 call to strict::unimport |
371 | my $name = shift; | ||||
372 | (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name}) | ||||
373 | ? &{$name}() : undef; | ||||
374 | } | ||||
375 | |||||
376 | # so that flush.pl can be deprecated | ||||
377 | |||||
378 | sub printflush { | ||||
379 | my $io = shift; | ||||
380 | my $old; | ||||
381 | $old = new SelectSaver qualify($io, caller) if ref($io); | ||||
382 | local $| = 1; | ||||
383 | if(ref($io)) { | ||||
384 | print $io @_; | ||||
385 | } | ||||
386 | else { | ||||
387 | print @_; | ||||
388 | } | ||||
389 | } | ||||
390 | |||||
391 | 1 | 9µs | 1; | ||
# spent 21µs within IO::Handle::CORE:eof which was called 4 times, avg 5µs/call:
# 4 times (21µs+0s) by IO::Handle::eof at line 153, avg 5µs/call | |||||
# spent 26µs within IO::Handle::CORE:read which was called 4 times, avg 6µs/call:
# 4 times (26µs+0s) by IO::Handle::read at line 202, avg 6µs/call | |||||
# spent 116µs within IO::Handle::_create_getline_subs which was called:
# once (116µs+0s) by IO::Seekable::BEGIN@9 at line 176 |