Filename | /usr/lib/perl/5.18/IO/Handle.pm |
Statements | Executed 39 statements in 3.08ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 2.96ms | 3.23ms | BEGIN@6 | IO::Handle::
1 | 1 | 1 | 699µs | 761µs | BEGIN@7 | IO::Handle::
1 | 1 | 1 | 300µs | 565µs | BEGIN@9 | IO::Handle::
1 | 1 | 1 | 264µs | 364µs | BEGIN@8 | IO::Handle::
1 | 1 | 1 | 99µs | 99µs | _create_getline_subs (xsub) | IO::Handle::
2 | 1 | 1 | 38µs | 112µs | autoflush | IO::Handle::
2 | 1 | 1 | 18µs | 36µs | new | IO::Handle::
1 | 1 | 1 | 17µs | 17µs | BEGIN@3 | IO::Handle::
2 | 1 | 1 | 10µs | 10µs | blocking (xsub) | IO::Handle::
1 | 1 | 1 | 9µs | 22µs | BEGIN@370 | IO::Handle::
1 | 1 | 1 | 8µs | 21µs | BEGIN@4 | 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 | close | IO::Handle::
0 | 0 | 0 | 0s | 0s | constant | IO::Handle::
0 | 0 | 0 | 0s | 0s | eof | 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 | read | 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 | 55µs | 1 | 17µs | # spent 17µs within IO::Handle::BEGIN@3 which was called:
# once (17µs+0s) by IO::Socket::BEGIN@11 at line 3 # spent 17µs making 1 call to IO::Handle::BEGIN@3 |
4 | 2 | 49µs | 2 | 34µs | # spent 21µs (8+14) within IO::Handle::BEGIN@4 which was called:
# once (8µs+14µs) by IO::Socket::BEGIN@11 at line 4 # spent 21µs making 1 call to IO::Handle::BEGIN@4
# spent 14µs making 1 call to strict::import |
5 | 1 | 500ns | our($VERSION, @EXPORT_OK, @ISA); | ||
6 | 2 | 125µs | 2 | 3.28ms | # spent 3.23ms (2.96+264µs) within IO::Handle::BEGIN@6 which was called:
# once (2.96ms+264µs) by IO::Socket::BEGIN@11 at line 6 # spent 3.23ms making 1 call to IO::Handle::BEGIN@6
# spent 55µs making 1 call to Exporter::import |
7 | 2 | 121µs | 2 | 806µs | # spent 761µs (699+62) within IO::Handle::BEGIN@7 which was called:
# once (699µs+62µs) by IO::Socket::BEGIN@11 at line 7 # spent 761µs making 1 call to IO::Handle::BEGIN@7
# spent 45µs making 1 call to Exporter::import |
8 | 2 | 139µs | 1 | 364µs | # spent 364µs (264+100) within IO::Handle::BEGIN@8 which was called:
# once (264µs+100µs) by IO::Socket::BEGIN@11 at line 8 # spent 364µs making 1 call to IO::Handle::BEGIN@8 |
9 | 2 | 2.17ms | 1 | 565µs | # spent 565µs (300+264) within IO::Handle::BEGIN@9 which was called:
# once (300µs+264µs) by IO::Socket::BEGIN@11 at line 9 # spent 565µs making 1 call to IO::Handle::BEGIN@9 |
10 | |||||
11 | 1 | 600ns | require Exporter; | ||
12 | 1 | 12µs | @ISA = qw(Exporter); | ||
13 | |||||
14 | 1 | 400ns | $VERSION = "1.34"; | ||
15 | 1 | 15µs | $VERSION = eval $VERSION; # spent 2µs executing statements in string eval | ||
16 | |||||
17 | 1 | 5µ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 36µs (18+18) within IO::Handle::new which was called 2 times, avg 18µs/call:
# 2 times (18µs+18µs) by IO::Socket::new at line 42 of IO/Socket.pm, avg 18µs/call | ||||
54 | 2 | 2µs | my $class = ref($_[0]) || $_[0] || "IO::Handle"; | ||
55 | 2 | 2µ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 | 18µs | my $io = gensym; # spent 18µs making 2 calls to Symbol::gensym, avg 9µ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 | sub eof { | ||||
152 | @_ == 1 or croak 'usage: $io->eof()'; | ||||
153 | eof($_[0]); | ||||
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 | 110µs | 1 | 99µs | _create_getline_subs( <<'END' ) or die $@; # spent 99µs making 1 call to IO::Handle::_create_getline_subs # spent 2µ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 | sub read { | ||||
201 | @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])'; | ||||
202 | read($_[0], $_[1], $_[2], $_[3] || 0); | ||||
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 | # spent 112µs (38+75) within IO::Handle::autoflush which was called 2 times, avg 56µs/call:
# 2 times (38µs+75µs) by IO::Socket::new at line 44 of IO/Socket.pm, avg 56µs/call | ||||
236 | 2 | 13µs | 4 | 62µs | my $old = new SelectSaver qualify($_[0], caller); # spent 56µs making 2 calls to SelectSaver::new, avg 28µs/call
# spent 6µs making 2 calls to Symbol::qualify, avg 3µs/call |
237 | 2 | 3µs | my $prev = $|; | ||
238 | 2 | 3µs | $| = @_ > 1 ? $_[1] : 1; | ||
239 | 2 | 7µs | $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 chech defined(&CONSTANT_NAME) | ||||
368 | |||||
369 | sub constant { | ||||
370 | 2 | 226µs | 2 | 35µs | # spent 22µs (9+13) within IO::Handle::BEGIN@370 which was called:
# once (9µs+13µs) by IO::Socket::BEGIN@11 at line 370 # spent 22µs making 1 call to IO::Handle::BEGIN@370
# spent 13µ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 | 8µs | 1; | ||
# spent 99µs within IO::Handle::_create_getline_subs which was called:
# once (99µs+0s) by IO::Socket::BEGIN@11 at line 176 | |||||
# spent 10µs within IO::Handle::blocking which was called 2 times, avg 5µs/call:
# 2 times (10µs+0s) by IO::Socket::blocking at line 168 of IO/Socket.pm, avg 5µs/call |