← Index
NYTProf Performance Profile   « line view »
For rbm/rbm
  Run on Wed Feb 12 20:36:06 2020
Reported on Wed Feb 12 21:42:25 2020

Filename/usr/lib/x86_64-linux-gnu/perl/5.28/IO/Handle.pm
StatementsExecuted 21 statements in 2.56ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
111744µs786µsIO::Handle::::BEGIN@6IO::Handle::BEGIN@6
111274µs337µsIO::Handle::::BEGIN@7IO::Handle::BEGIN@7
111262µs553µsIO::Handle::::BEGIN@8IO::Handle::BEGIN@8
11184µs84µsIO::Handle::::_create_getline_subsIO::Handle::_create_getline_subs (xsub)
11115µs15µsIO::Handle::::BEGIN@3IO::Handle::BEGIN@3
11110µs44µsIO::Handle::::BEGIN@5IO::Handle::BEGIN@5
1118µs29µsIO::Handle::::BEGIN@368IO::Handle::BEGIN@368
1117µs10µsIO::Handle::::BEGIN@4IO::Handle::BEGIN@4
1111µs1µsIO::Handle::::__ANON__IO::Handle::__ANON__ (xsub)
0000s0sIO::Handle::::DESTROYIO::Handle::DESTROY
0000s0sIO::Handle::::_open_mode_stringIO::Handle::_open_mode_string
0000s0sIO::Handle::::autoflushIO::Handle::autoflush
0000s0sIO::Handle::::closeIO::Handle::close
0000s0sIO::Handle::::constantIO::Handle::constant
0000s0sIO::Handle::::eofIO::Handle::eof
0000s0sIO::Handle::::fcntlIO::Handle::fcntl
0000s0sIO::Handle::::fdopenIO::Handle::fdopen
0000s0sIO::Handle::::filenoIO::Handle::fileno
0000s0sIO::Handle::::format_formfeedIO::Handle::format_formfeed
0000s0sIO::Handle::::format_line_break_charactersIO::Handle::format_line_break_characters
0000s0sIO::Handle::::format_lines_leftIO::Handle::format_lines_left
0000s0sIO::Handle::::format_lines_per_pageIO::Handle::format_lines_per_page
0000s0sIO::Handle::::format_nameIO::Handle::format_name
0000s0sIO::Handle::::format_page_numberIO::Handle::format_page_number
0000s0sIO::Handle::::format_top_nameIO::Handle::format_top_name
0000s0sIO::Handle::::format_writeIO::Handle::format_write
0000s0sIO::Handle::::formlineIO::Handle::formline
0000s0sIO::Handle::::getcIO::Handle::getc
0000s0sIO::Handle::::input_line_numberIO::Handle::input_line_number
0000s0sIO::Handle::::input_record_separatorIO::Handle::input_record_separator
0000s0sIO::Handle::::ioctlIO::Handle::ioctl
0000s0sIO::Handle::::newIO::Handle::new
0000s0sIO::Handle::::new_from_fdIO::Handle::new_from_fd
0000s0sIO::Handle::::openedIO::Handle::opened
0000s0sIO::Handle::::output_field_separatorIO::Handle::output_field_separator
0000s0sIO::Handle::::output_record_separatorIO::Handle::output_record_separator
0000s0sIO::Handle::::printIO::Handle::print
0000s0sIO::Handle::::printfIO::Handle::printf
0000s0sIO::Handle::::printflushIO::Handle::printflush
0000s0sIO::Handle::::readIO::Handle::read
0000s0sIO::Handle::::sayIO::Handle::say
0000s0sIO::Handle::::statIO::Handle::stat
0000s0sIO::Handle::::sysreadIO::Handle::sysread
0000s0sIO::Handle::::syswriteIO::Handle::syswrite
0000s0sIO::Handle::::truncateIO::Handle::truncate
0000s0sIO::Handle::::writeIO::Handle::write
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package IO::Handle;
2
3241µs115µs
# spent 15µs within IO::Handle::BEGIN@3 which was called: # once (15µs+0s) by RBM::BEGIN@11 at line 3
use 5.008_001;
# spent 15µs making 1 call to IO::Handle::BEGIN@3
4222µs213µs
# spent 10µs (7+3) within IO::Handle::BEGIN@4 which was called: # once (7µs+3µs) by RBM::BEGIN@11 at line 4
use strict;
# spent 10µs making 1 call to IO::Handle::BEGIN@4 # spent 3µs making 1 call to strict::import
5227µs279µs
# spent 44µs (10+34) within IO::Handle::BEGIN@5 which was called: # once (10µs+34µs) by RBM::BEGIN@11 at line 5
use Carp;
# spent 44µs making 1 call to IO::Handle::BEGIN@5 # spent 34µs making 1 call to Exporter::import
62231µs2817µs
# spent 786µs (744+42) within IO::Handle::BEGIN@6 which was called: # once (744µs+42µs) by RBM::BEGIN@11 at line 6
use Symbol;
# spent 786µs making 1 call to IO::Handle::BEGIN@6 # spent 31µs making 1 call to Exporter::import
72112µs2338µs
# spent 337µs (274+64) within IO::Handle::BEGIN@7 which was called: # once (274µs+64µs) by RBM::BEGIN@11 at line 7
use SelectSaver;
# spent 337µs making 1 call to IO::Handle::BEGIN@7 # spent 1µs making 1 call to IO::Handle::__ANON__
821.83ms1553µs
# spent 553µs (262+291) within IO::Handle::BEGIN@8 which was called: # once (262µs+291µs) by RBM::BEGIN@11 at line 8
use IO (); # Load the XS module
# spent 553µs making 1 call to IO::Handle::BEGIN@8
9
1011µsrequire Exporter;
11115µsour @ISA = qw(Exporter);
12
131200nsour $VERSION = "1.39";
14
1512µsour @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 print
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
51sub 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
69sub 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#
85sub DESTROY {}
86
87################################################
88## Open and close.
89##
90
91sub _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
101sub 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
120sub 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
134sub opened {
135 @_ == 1 or croak 'usage: $io->opened()';
136 defined fileno($_[0]);
137}
138
139sub fileno {
140 @_ == 1 or croak 'usage: $io->fileno()';
141 fileno($_[0]);
142}
143
144sub getc {
145 @_ == 1 or croak 'usage: $io->getc()';
146 getc($_[0]);
147}
148
149sub eof {
150 @_ == 1 or croak 'usage: $io->eof()';
151 eof($_[0]);
152}
153
154sub print {
155 @_ or croak 'usage: $io->print(ARGS)';
156 my $this = shift;
157 print $this @_;
158}
159
160sub printf {
161 @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])';
162 my $this = shift;
163 printf $this @_;
164}
165
166sub 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.
174188µs184µs_create_getline_subs( <<'END' ) or die $@;
# spent 84µs making 1 call to IO::Handle::_create_getline_subs
# spent 2µs executing statements in string eval
175sub getline {
176 @_ == 1 or croak 'usage: $io->getline()';
177 my $this = shift;
178 return scalar <$this>;
179}
180
181sub 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}
1881; # return true for error checking
189END
190
19112µs*gets = \&getline; # deprecated
192
193sub truncate {
194 @_ == 2 or croak 'usage: $io->truncate(LEN)';
195 truncate($_[0], $_[1]);
196}
197
198sub read {
199 @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])';
200 read($_[0], $_[1], $_[2], $_[3] || 0);
201}
202
203sub sysread {
204 @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])';
205 sysread($_[0], $_[1], $_[2], $_[3] || 0);
206}
207
208sub 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
215sub 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
224sub stat {
225 @_ == 1 or croak 'usage: $io->stat()';
226 stat($_[0]);
227}
228
229################################################
230## State modification functions.
231##
232
233sub autoflush {
234 my $old = SelectSaver->new(qualify($_[0], caller));
235 my $prev = $|;
236 $| = @_ > 1 ? $_[1] : 1;
237 $prev;
238}
239
240sub 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
248sub 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
256sub 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
264sub input_line_number {
265 local $.;
266 () = tell qualify($_[0], caller) if ref($_[0]);
267 my $prev = $.;
268 $. = $_[1] if @_ > 1;
269 $prev;
270}
271
272sub 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
280sub 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
288sub 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
296sub 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
304sub 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
312sub 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
320sub 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
328sub formline {
329 my $io = shift;
330 my $picture = shift;
331 local($^A) = $^A;
332 local($\) = "";
333 formline($picture, @_);
334 print $io $^A;
335}
336
337sub 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
349sub fcntl {
350 @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );';
351 my ($io, $op) = @_;
352 return fcntl($io, $op, $_[2]);
353}
354
355sub 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
367sub constant {
3682178µs249µs
# spent 29µs (8+20) within IO::Handle::BEGIN@368 which was called: # once (8µs+20µs) by RBM::BEGIN@11 at line 368
no strict 'refs';
# spent 29µs making 1 call to IO::Handle::BEGIN@368 # spent 20µ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
376sub 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
38918µs1;
 
# spent 1µs within IO::Handle::__ANON__ which was called: # once (1µs+0s) by IO::Handle::BEGIN@7 at line 7
sub IO::Handle::__ANON__; # xsub
# spent 84µs within IO::Handle::_create_getline_subs which was called: # once (84µs+0s) by RBM::BEGIN@11 at line 174
sub IO::Handle::_create_getline_subs; # xsub
Report produced by the NYTProf 6.06 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.