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