Profile of IO/Handle.pm

← Index
NYTProf Performance Profile «line view»
For script/ponapi
Run on Wed Feb 10 15:51:26 2016
Reported on Thu Feb 11 09:43:09 2016

Filename | /usr/lib/perl/5.18/IO/Handle.pm
Statements | Executed 2000073 statements in 29.4s

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
100001 | 1 | 1 | 7.54s | 7.54s | IO::Handle::::CORE:sysreadIO::Handle::CORE:sysread (opcode)
200002 | 1 | 1 | 6.69s | 6.69s | IO::Handle::::CORE:syswriteIO::Handle::CORE:syswrite (opcode)
100003 | 1 | 1 | 3.13s | 8.20s | IO::Handle::::autoflushIO::Handle::autoflush
100001 | 1 | 1 | 2.90s | 2.90s | IO::Handle::::CORE:closeIO::Handle::CORE:close (opcode)
100001 | 1 | 1 | 2.87s | 2.87s | IO::Handle::::CORE:printIO::Handle::CORE:print (opcode)
200002 | 1 | 1 | 1.88s | 8.58s | IO::Handle::::syswriteIO::Handle::syswrite
100005 | 2 | 2 | 1.63s | 3.09s | IO::Handle::::newIO::Handle::new
100001 | 1 | 1 | 1.02s | 3.92s | IO::Handle::::closeIO::Handle::close
100001 | 1 | 1 | 1.01s | 8.55s | IO::Handle::::sysreadIO::Handle::sysread
100001 | 1 | 1 | 944ms | 3.81s | IO::Handle::::printIO::Handle::print
1 | 1 | 1 | 198µs | 428µs | IO::Handle::::BEGIN@9IO::Handle::BEGIN@9
1 | 1 | 1 | 70µs | 70µs | IO::Handle::::_create_getline_subsIO::Handle::_create_getline_subs (xsub)
2 | 1 | 1 | 26µs | 33µs | IO::Handle::::_open_mode_stringIO::Handle::_open_mode_string
1 | 1 | 1 | 15µs | 49µs | IO::Handle::::BEGIN@7IO::Handle::BEGIN@7
1 | 1 | 1 | 11µs | 11µs | IO::Handle::::BEGIN@3IO::Handle::BEGIN@3
1 | 1 | 1 | 7µs | 17µs | IO::Handle::::BEGIN@370IO::Handle::BEGIN@370
1 | 1 | 1 | 7µs | 15µs | IO::Handle::::BEGIN@4IO::Handle::BEGIN@4
1 | 1 | 1 | 6µs | 31µs | IO::Handle::::BEGIN@6IO::Handle::BEGIN@6
1 | 1 | 1 | 4µs | 4µs | IO::Handle::::BEGIN@8IO::Handle::BEGIN@8
3 | 1 | 1 | 4µs | 4µs | IO::Handle::::CORE:substIO::Handle::CORE:subst (opcode)
2 | 1 | 1 | 2µs | 2µs | IO::Handle::::CORE:matchIO::Handle::CORE:match (opcode)
4 | 1 | 1 | 2µs | 2µs | IO::Handle::::CORE:substcontIO::Handle::CORE:substcont (opcode)
0 | 0 | 0 | 0s | 0s | IO::Handle::::DESTROYIO::Handle::DESTROY
0 | 0 | 0 | 0s | 0s | IO::Handle::::constantIO::Handle::constant
0 | 0 | 0 | 0s | 0s | IO::Handle::::eofIO::Handle::eof
0 | 0 | 0 | 0s | 0s | IO::Handle::::fcntlIO::Handle::fcntl
0 | 0 | 0 | 0s | 0s | IO::Handle::::fdopenIO::Handle::fdopen
0 | 0 | 0 | 0s | 0s | IO::Handle::::filenoIO::Handle::fileno
0 | 0 | 0 | 0s | 0s | IO::Handle::::format_formfeedIO::Handle::format_formfeed
0 | 0 | 0 | 0s | 0s | IO::Handle::::format_line_break_charactersIO::Handle::format_line_break_characters
0 | 0 | 0 | 0s | 0s | IO::Handle::::format_lines_leftIO::Handle::format_lines_left
0 | 0 | 0 | 0s | 0s | IO::Handle::::format_lines_per_pageIO::Handle::format_lines_per_page
0 | 0 | 0 | 0s | 0s | IO::Handle::::format_nameIO::Handle::format_name
0 | 0 | 0 | 0s | 0s | IO::Handle::::format_page_numberIO::Handle::format_page_number
0 | 0 | 0 | 0s | 0s | IO::Handle::::format_top_nameIO::Handle::format_top_name
0 | 0 | 0 | 0s | 0s | IO::Handle::::format_writeIO::Handle::format_write
0 | 0 | 0 | 0s | 0s | IO::Handle::::formlineIO::Handle::formline
0 | 0 | 0 | 0s | 0s | IO::Handle::::getcIO::Handle::getc
0 | 0 | 0 | 0s | 0s | IO::Handle::::input_line_numberIO::Handle::input_line_number
0 | 0 | 0 | 0s | 0s | IO::Handle::::input_record_separatorIO::Handle::input_record_separator
0 | 0 | 0 | 0s | 0s | IO::Handle::::ioctlIO::Handle::ioctl
0 | 0 | 0 | 0s | 0s | IO::Handle::::new_from_fdIO::Handle::new_from_fd
0 | 0 | 0 | 0s | 0s | IO::Handle::::openedIO::Handle::opened
0 | 0 | 0 | 0s | 0s | IO::Handle::::output_field_separatorIO::Handle::output_field_separator
0 | 0 | 0 | 0s | 0s | IO::Handle::::output_record_separatorIO::Handle::output_record_separator
0 | 0 | 0 | 0s | 0s | IO::Handle::::printfIO::Handle::printf
0 | 0 | 0 | 0s | 0s | IO::Handle::::printflushIO::Handle::printflush
0 | 0 | 0 | 0s | 0s | IO::Handle::::readIO::Handle::read
0 | 0 | 0 | 0s | 0s | IO::Handle::::sayIO::Handle::say
0 | 0 | 0 | 0s | 0s | IO::Handle::::statIO::Handle::stat
0 | 0 | 0 | 0s | 0s | IO::Handle::::truncateIO::Handle::truncate
0 | 0 | 0 | 0s | 0s | IO::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
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package IO::Handle;
2 |  |  |  |  |
3 | 2 | 38µs | 1 | 11µs | # spent 11µs within IO::Handle::BEGIN@3 which was called: # once (11µs+0s) by IO::Seekable::BEGIN@9 at line 3 use 5.006_001; # spent 11µs making 1 call to IO::Handle::BEGIN@3
4 | 2 | 30µs | 2 | 24µs | # spent 15µs (7+8) within IO::Handle::BEGIN@4 which was called: # once (7µs+8µs) by IO::Seekable::BEGIN@9 at line 4 use strict; # spent 15µs making 1 call to IO::Handle::BEGIN@4 # spent 8µs making 1 call to strict::import
5 | 1 | 400ns |  |  | our($VERSION, @EXPORT_OK, @ISA);
6 | 2 | 42µs | 2 | 56µs | # spent 31µs (6+25) within IO::Handle::BEGIN@6 which was called: # once (6µs+25µs) by IO::Seekable::BEGIN@9 at line 6 use Carp; # spent 31µs making 1 call to IO::Handle::BEGIN@6 # spent 25µs making 1 call to Exporter::import
7 | 2 | 19µs | 2 | 83µs | # spent 49µs (15+34) within IO::Handle::BEGIN@7 which was called: # once (15µs+34µs) by IO::Seekable::BEGIN@9 at line 7 use Symbol; # spent 49µs making 1 call to IO::Handle::BEGIN@7 # spent 34µs making 1 call to Exporter::import
8 | 2 | 16µs | 1 | 4µs | # spent 4µs within IO::Handle::BEGIN@8 which was called: # once (4µs+0s) by IO::Seekable::BEGIN@9 at line 8 use SelectSaver; # spent 4µs making 1 call to IO::Handle::BEGIN@8
9 | 2 | 1.48ms | 1 | 428µs | # spent 428µs (198+230) within IO::Handle::BEGIN@9 which was called: # once (198µs+230µs) by IO::Seekable::BEGIN@9 at line 9 use IO (); # Load the XS module # spent 428µs making 1 call to IO::Handle::BEGIN@9
10 |  |  |  |  |
11 | 1 | 400ns |  |  | require Exporter;
12 | 1 | 14µs |  |  | @ISA = qw(Exporter);
13 |  |  |  |  |
14 | 1 | 200ns |  |  | $VERSION = "1.34";
15 | 1 | 12µs |  |  | $VERSION = eval $VERSION; # spent 2µ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 |  |  |  |  | print
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 3.09s (1.63+1.46) within IO::Handle::new which was called 100005 times, avg 31µs/call: # 100003 times (1.63s+1.46s) by IO::Socket::new at line 42 of IO/Socket.pm, avg 31µs/call # 2 times (12µs+12µs) by IO::File::new at line 38 of IO/File.pm, avg 12µs/call sub new {
54 | 100005 | 187ms |  |  | my $class = ref($_[0]) || $_[0] || "IO::Handle";
55 | 100005 | 118ms |  |  | 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 | 100005 | 352ms | 100005 | 1.46s | my $io = gensym; # spent 1.46s making 100005 calls to Symbol::gensym, avg 15µs/call
68 | 100005 | 812ms |  |  | 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 |  |  |  |  | # spent 33µs (26+7) within IO::Handle::_open_mode_string which was called 2 times, avg 16µs/call: # 2 times (26µs+7µs) by IO::File::open at line 62 of IO/File.pm, avg 16µs/call sub _open_mode_string {
94 | 2 | 1µs |  |  | my ($mode) = @_;
95 | 2 | 28µs | 9 | 7µs | $mode =~ /^\+?(<|>>?)$/ # spent 4µs making 3 calls to IO::Handle::CORE:subst, avg 1µs/call # spent 2µs making 2 calls to IO::Handle::CORE:match, avg 1µs/call # spent 2µs making 4 calls to IO::Handle::CORE:substcont, avg 400ns/call
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 | 2 | 5µs |  |  | $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 |  |  |  |  | # spent 3.92s (1.02+2.90) within IO::Handle::close which was called 100001 times, avg 39µs/call: # 100001 times (1.02s+2.90s) by IO::Socket::close at line 205 of IO/Socket.pm, avg 39µs/call sub close {
123 | 100001 | 74.7ms |  |  | @_ == 1 or croak 'usage: $io->close()';
124 | 100001 | 71.6ms |  |  | my($io) = @_;
125 |  |  |  |  |
126 | 100001 | 3.99s | 100001 | 2.90s | close($io); # spent 2.90s making 100001 calls to IO::Handle::CORE:close, avg 29µs/call
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 |  |  |  |  | # spent 3.81s (944ms+2.87) within IO::Handle::print which was called 100001 times, avg 38µs/call: # 100001 times (944ms+2.87s) by Plack::Middleware::AccessLog::call at line 33 of Plack/Middleware/AccessLog.pm, avg 38µs/call sub print {
157 | 100001 | 44.7ms |  |  | @_ or croak 'usage: $io->print(ARGS)';
158 | 100001 | 38.7ms |  |  | my $this = shift;
159 | 100001 | 3.90s | 100001 | 2.87s | print $this @_; # spent 2.87s making 100001 calls to IO::Handle::CORE:print, avg 29µs/call
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 | 74µs | 1 | 70µs | _create_getline_subs( <<'END' ) or die $@; # spent 70µ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 |  |  |  |  | # spent 8.55s (1.01+7.54) within IO::Handle::sysread which was called 100001 times, avg 85µs/call: # 100001 times (1.01s+7.54s) by HTTP::Server::PSGI::__ANON__[/usr/local/share/perl/5.18.2/HTTP/Server/PSGI.pm:270] at line 270 of HTTP/Server/PSGI.pm, avg 85µs/call sub sysread {
206 | 100001 | 129ms |  |  | @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])';
207 | 100001 | 8.67s | 100001 | 7.54s | sysread($_[0], $_[1], $_[2], $_[3] || 0); # spent 7.54s making 100001 calls to IO::Handle::CORE:sysread, avg 75µs/call
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 |  |  |  |  | # spent 8.58s (1.88+6.69) within IO::Handle::syswrite which was called 200002 times, avg 43µs/call: # 200002 times (1.88s+6.69s) by HTTP::Server::PSGI::__ANON__[/usr/local/share/perl/5.18.2/HTTP/Server/PSGI.pm:276] at line 276 of HTTP/Server/PSGI.pm, avg 43µs/call sub syswrite {
218 | 200002 | 192ms |  |  | @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])';
219 | 200002 | 8.97s | 200002 | 6.69s | if (defined($_[2])) { # spent 6.69s making 200002 calls to IO::Handle::CORE:syswrite, avg 33µs/call
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 8.20s (3.13+5.07) within IO::Handle::autoflush which was called 100003 times, avg 82µs/call: # 100003 times (3.13s+5.07s) by IO::Socket::new at line 44 of IO/Socket.pm, avg 82µs/call sub autoflush {
236 | 100003 | 1.13s | 200006 | 4.14s | my $old = new SelectSaver qualify($_[0], caller); # spent 3.65s making 100003 calls to SelectSaver::new, avg 37µs/call # spent 490ms making 100003 calls to Symbol::qualify, avg 5µs/call
237 | 100003 | 181ms |  |  | my $prev = $|;
238 | 100003 | 153ms |  |  | $| = @_ > 1 ? $_[1] : 1;
239 | 100003 | 362ms |  |  | $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 | 126µs | 2 | 27µs | # spent 17µs (7+10) within IO::Handle::BEGIN@370 which was called: # once (7µs+10µs) by IO::Seekable::BEGIN@9 at line 370 no strict 'refs'; # spent 17µs making 1 call to IO::Handle::BEGIN@370 # spent 10µ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 | 6µs |  |  | 1;
|  |  |  |  | # spent 2.90s within IO::Handle::CORE:close which was called 100001 times, avg 29µs/call: # 100001 times (2.90s+0s) by IO::Handle::close at line 126, avg 29µs/call sub IO::Handle::CORE:close; # opcode
|  |  |  |  | # spent 2µs within IO::Handle::CORE:match which was called 2 times, avg 1µs/call: # 2 times (2µs+0s) by IO::Handle::_open_mode_string at line 95, avg 1µs/call sub IO::Handle::CORE:match; # opcode
|  |  |  |  | # spent 2.87s within IO::Handle::CORE:print which was called 100001 times, avg 29µs/call: # 100001 times (2.87s+0s) by IO::Handle::print at line 159, avg 29µs/call sub IO::Handle::CORE:print; # opcode
|  |  |  |  | # spent 4µs within IO::Handle::CORE:subst which was called 3 times, avg 1µs/call: # 3 times (4µs+0s) by IO::Handle::_open_mode_string at line 95, avg 1µs/call sub IO::Handle::CORE:subst; # opcode
|  |  |  |  | # spent 2µs within IO::Handle::CORE:substcont which was called 4 times, avg 400ns/call: # 4 times (2µs+0s) by IO::Handle::_open_mode_string at line 95, avg 400ns/call sub IO::Handle::CORE:substcont; # opcode
|  |  |  |  | # spent 7.54s within IO::Handle::CORE:sysread which was called 100001 times, avg 75µs/call: # 100001 times (7.54s+0s) by IO::Handle::sysread at line 207, avg 75µs/call sub IO::Handle::CORE:sysread; # opcode
|  |  |  |  | # spent 6.69s within IO::Handle::CORE:syswrite which was called 200002 times, avg 33µs/call: # 200002 times (6.69s+0s) by IO::Handle::syswrite at line 219, avg 33µs/call sub IO::Handle::CORE:syswrite; # opcode
|  |  |  |  | # spent 70µs within IO::Handle::_create_getline_subs which was called: # once (70µs+0s) by IO::Seekable::BEGIN@9 at line 176 sub IO::Handle::_create_getline_subs; # xsub