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