| Filename | /usr/lib/perl5/5.20.1/x86_64-linux-thread-multi/IO/Handle.pm |
| Statements | Executed 175 statements in 1.28ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 154µs | 314µs | IO::Handle::BEGIN@269 |
| 74 | 2 | 1 | 80µs | 88µs | IO::Handle::eof |
| 1 | 1 | 1 | 50µs | 50µs | IO::Handle::_create_getline_subs (xsub) |
| 1 | 1 | 1 | 11µs | 19µs | IO::Handle::new |
| 1 | 1 | 1 | 8µs | 8µs | IO::Handle::BEGIN@263 |
| 74 | 1 | 1 | 7µs | 7µs | IO::Handle::CORE:eof (opcode) |
| 1 | 1 | 1 | 5µs | 12µs | IO::Handle::BEGIN@631 |
| 1 | 1 | 1 | 4µs | 22µs | IO::Handle::BEGIN@266 |
| 1 | 1 | 1 | 3µs | 19µs | IO::Handle::BEGIN@267 |
| 1 | 1 | 1 | 3µs | 10µs | IO::Handle::BEGIN@264 |
| 1 | 1 | 1 | 2µs | 2µs | IO::Handle::BEGIN@268 |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::DESTROY |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::_open_mode_string |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::autoflush |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::close |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::constant |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::fcntl |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::fdopen |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::fileno |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::format_formfeed |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::format_line_break_characters |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::format_lines_left |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::format_lines_per_page |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::format_name |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::format_page_number |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::format_top_name |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::format_write |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::formline |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::getc |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::input_line_number |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::input_record_separator |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::ioctl |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::new_from_fd |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::opened |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::output_field_separator |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::output_record_separator |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::print |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::printf |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::printflush |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::read |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::say |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::stat |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::sysread |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::syswrite |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::truncate |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::write |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package IO::Handle; | ||||
| 2 | |||||
| 3 | =head1 NAME | ||||
| 4 | |||||
| 5 | IO::Handle - supply object methods for I/O handles | ||||
| 6 | |||||
| 7 | =head1 SYNOPSIS | ||||
| 8 | |||||
| 9 | use IO::Handle; | ||||
| 10 | |||||
| 11 | $io = IO::Handle->new(); | ||||
| 12 | if ($io->fdopen(fileno(STDIN),"r")) { | ||||
| 13 | print $io->getline; | ||||
| 14 | $io->close; | ||||
| 15 | } | ||||
| 16 | |||||
| 17 | $io = IO::Handle->new(); | ||||
| 18 | if ($io->fdopen(fileno(STDOUT),"w")) { | ||||
| 19 | $io->print("Some text\n"); | ||||
| 20 | } | ||||
| 21 | |||||
| 22 | # setvbuf is not available by default on Perls 5.8.0 and later. | ||||
| 23 | use IO::Handle '_IOLBF'; | ||||
| 24 | $io->setvbuf($buffer_var, _IOLBF, 1024); | ||||
| 25 | |||||
| 26 | undef $io; # automatically closes the file if it's open | ||||
| 27 | |||||
| 28 | autoflush STDOUT 1; | ||||
| 29 | |||||
| 30 | =head1 DESCRIPTION | ||||
| 31 | |||||
| 32 | C<IO::Handle> is the base class for all other IO handle classes. It is | ||||
| 33 | not intended that objects of C<IO::Handle> would be created directly, | ||||
| 34 | but instead C<IO::Handle> is inherited from by several other classes | ||||
| 35 | in the IO hierarchy. | ||||
| 36 | |||||
| 37 | If you are reading this documentation, looking for a replacement for | ||||
| 38 | the C<FileHandle> package, then I suggest you read the documentation | ||||
| 39 | for C<IO::File> too. | ||||
| 40 | |||||
| 41 | =head1 CONSTRUCTOR | ||||
| 42 | |||||
| 43 | =over 4 | ||||
| 44 | |||||
| 45 | =item new () | ||||
| 46 | |||||
| 47 | Creates a new C<IO::Handle> object. | ||||
| 48 | |||||
| 49 | =item new_from_fd ( FD, MODE ) | ||||
| 50 | |||||
| 51 | Creates an C<IO::Handle> like C<new> does. | ||||
| 52 | It requires two parameters, which are passed to the method C<fdopen>; | ||||
| 53 | if the fdopen fails, the object is destroyed. Otherwise, it is returned | ||||
| 54 | to the caller. | ||||
| 55 | |||||
| 56 | =back | ||||
| 57 | |||||
| 58 | =head1 METHODS | ||||
| 59 | |||||
| 60 | See L<perlfunc> for complete descriptions of each of the following | ||||
| 61 | supported C<IO::Handle> methods, which are just front ends for the | ||||
| 62 | corresponding built-in functions: | ||||
| 63 | |||||
| 64 | $io->close | ||||
| 65 | $io->eof | ||||
| 66 | $io->fcntl( FUNCTION, SCALAR ) | ||||
| 67 | $io->fileno | ||||
| 68 | $io->format_write( [FORMAT_NAME] ) | ||||
| 69 | $io->getc | ||||
| 70 | $io->ioctl( FUNCTION, SCALAR ) | ||||
| 71 | $io->read ( BUF, LEN, [OFFSET] ) | ||||
| 72 | $io->print ( ARGS ) | ||||
| 73 | $io->printf ( FMT, [ARGS] ) | ||||
| 74 | $io->say ( ARGS ) | ||||
| 75 | $io->stat | ||||
| 76 | $io->sysread ( BUF, LEN, [OFFSET] ) | ||||
| 77 | $io->syswrite ( BUF, [LEN, [OFFSET]] ) | ||||
| 78 | $io->truncate ( LEN ) | ||||
| 79 | |||||
| 80 | See L<perlvar> for complete descriptions of each of the following | ||||
| 81 | supported C<IO::Handle> methods. All of them return the previous | ||||
| 82 | value of the attribute and takes an optional single argument that when | ||||
| 83 | given will set the value. If no argument is given the previous value | ||||
| 84 | is unchanged (except for $io->autoflush will actually turn ON | ||||
| 85 | autoflush by default). | ||||
| 86 | |||||
| 87 | $io->autoflush ( [BOOL] ) $| | ||||
| 88 | $io->format_page_number( [NUM] ) $% | ||||
| 89 | $io->format_lines_per_page( [NUM] ) $= | ||||
| 90 | $io->format_lines_left( [NUM] ) $- | ||||
| 91 | $io->format_name( [STR] ) $~ | ||||
| 92 | $io->format_top_name( [STR] ) $^ | ||||
| 93 | $io->input_line_number( [NUM]) $. | ||||
| 94 | |||||
| 95 | The following methods are not supported on a per-filehandle basis. | ||||
| 96 | |||||
| 97 | IO::Handle->format_line_break_characters( [STR] ) $: | ||||
| 98 | IO::Handle->format_formfeed( [STR]) $^L | ||||
| 99 | IO::Handle->output_field_separator( [STR] ) $, | ||||
| 100 | IO::Handle->output_record_separator( [STR] ) $\ | ||||
| 101 | |||||
| 102 | IO::Handle->input_record_separator( [STR] ) $/ | ||||
| 103 | |||||
| 104 | Furthermore, for doing normal I/O you might need these: | ||||
| 105 | |||||
| 106 | =over 4 | ||||
| 107 | |||||
| 108 | =item $io->fdopen ( FD, MODE ) | ||||
| 109 | |||||
| 110 | C<fdopen> is like an ordinary C<open> except that its first parameter | ||||
| 111 | is not a filename but rather a file handle name, an IO::Handle object, | ||||
| 112 | or a file descriptor number. (For the documentation of the C<open> | ||||
| 113 | method, see L<IO::File>.) | ||||
| 114 | |||||
| 115 | =item $io->opened | ||||
| 116 | |||||
| 117 | Returns true if the object is currently a valid file descriptor, false | ||||
| 118 | otherwise. | ||||
| 119 | |||||
| 120 | =item $io->getline | ||||
| 121 | |||||
| 122 | This works like <$io> described in L<perlop/"I/O Operators"> | ||||
| 123 | except that it's more readable and can be safely called in a | ||||
| 124 | list context but still returns just one line. If used as the conditional | ||||
| 125 | +within a C<while> or C-style C<for> loop, however, you will need to | ||||
| 126 | +emulate the functionality of <$io> with C<< defined($_ = $io->getline) >>. | ||||
| 127 | |||||
| 128 | =item $io->getlines | ||||
| 129 | |||||
| 130 | This works like <$io> when called in a list context to read all | ||||
| 131 | the remaining lines in a file, except that it's more readable. | ||||
| 132 | It will also croak() if accidentally called in a scalar context. | ||||
| 133 | |||||
| 134 | =item $io->ungetc ( ORD ) | ||||
| 135 | |||||
| 136 | Pushes a character with the given ordinal value back onto the given | ||||
| 137 | handle's input stream. Only one character of pushback per handle is | ||||
| 138 | guaranteed. | ||||
| 139 | |||||
| 140 | =item $io->write ( BUF, LEN [, OFFSET ] ) | ||||
| 141 | |||||
| 142 | This C<write> is somewhat like C<write> found in C, in that it is the | ||||
| 143 | opposite of read. The wrapper for the perl C<write> function is | ||||
| 144 | called C<format_write>. However, whilst the C C<write> function returns | ||||
| 145 | the number of bytes written, this C<write> function simply returns true | ||||
| 146 | if successful (like C<print>). A more C-like C<write> is C<syswrite> | ||||
| 147 | (see above). | ||||
| 148 | |||||
| 149 | =item $io->error | ||||
| 150 | |||||
| 151 | Returns a true value if the given handle has experienced any errors | ||||
| 152 | since it was opened or since the last call to C<clearerr>, or if the | ||||
| 153 | handle is invalid. It only returns false for a valid handle with no | ||||
| 154 | outstanding errors. | ||||
| 155 | |||||
| 156 | =item $io->clearerr | ||||
| 157 | |||||
| 158 | Clear the given handle's error indicator. Returns -1 if the handle is | ||||
| 159 | invalid, 0 otherwise. | ||||
| 160 | |||||
| 161 | =item $io->sync | ||||
| 162 | |||||
| 163 | C<sync> synchronizes a file's in-memory state with that on the | ||||
| 164 | physical medium. C<sync> does not operate at the perlio api level, but | ||||
| 165 | operates on the file descriptor (similar to sysread, sysseek and | ||||
| 166 | systell). This means that any data held at the perlio api level will not | ||||
| 167 | be synchronized. To synchronize data that is buffered at the perlio api | ||||
| 168 | level you must use the flush method. C<sync> is not implemented on all | ||||
| 169 | platforms. Returns "0 but true" on success, C<undef> on error, C<undef> | ||||
| 170 | for an invalid handle. See L<fsync(3c)>. | ||||
| 171 | |||||
| 172 | =item $io->flush | ||||
| 173 | |||||
| 174 | C<flush> causes perl to flush any buffered data at the perlio api level. | ||||
| 175 | Any unread data in the buffer will be discarded, and any unwritten data | ||||
| 176 | will be written to the underlying file descriptor. Returns "0 but true" | ||||
| 177 | on success, C<undef> on error. | ||||
| 178 | |||||
| 179 | =item $io->printflush ( ARGS ) | ||||
| 180 | |||||
| 181 | Turns on autoflush, print ARGS and then restores the autoflush status of the | ||||
| 182 | C<IO::Handle> object. Returns the return value from print. | ||||
| 183 | |||||
| 184 | =item $io->blocking ( [ BOOL ] ) | ||||
| 185 | |||||
| 186 | If called with an argument C<blocking> will turn on non-blocking IO if | ||||
| 187 | C<BOOL> is false, and turn it off if C<BOOL> is true. | ||||
| 188 | |||||
| 189 | C<blocking> will return the value of the previous setting, or the | ||||
| 190 | current setting if C<BOOL> is not given. | ||||
| 191 | |||||
| 192 | If an error occurs C<blocking> will return undef and C<$!> will be set. | ||||
| 193 | |||||
| 194 | =back | ||||
| 195 | |||||
| 196 | |||||
| 197 | If the C functions setbuf() and/or setvbuf() are available, then | ||||
| 198 | C<IO::Handle::setbuf> and C<IO::Handle::setvbuf> set the buffering | ||||
| 199 | policy for an IO::Handle. The calling sequences for the Perl functions | ||||
| 200 | are the same as their C counterparts--including the constants C<_IOFBF>, | ||||
| 201 | C<_IOLBF>, and C<_IONBF> for setvbuf()--except that the buffer parameter | ||||
| 202 | specifies a scalar variable to use as a buffer. You should only | ||||
| 203 | change the buffer before any I/O, or immediately after calling flush. | ||||
| 204 | |||||
| 205 | WARNING: The IO::Handle::setvbuf() is not available by default on | ||||
| 206 | Perls 5.8.0 and later because setvbuf() is rather specific to using | ||||
| 207 | the stdio library, while Perl prefers the new perlio subsystem instead. | ||||
| 208 | |||||
| 209 | WARNING: A variable used as a buffer by C<setbuf> or C<setvbuf> B<must not | ||||
| 210 | be modified> in any way until the IO::Handle is closed or C<setbuf> or | ||||
| 211 | C<setvbuf> is called again, or memory corruption may result! Remember that | ||||
| 212 | the order of global destruction is undefined, so even if your buffer | ||||
| 213 | variable remains in scope until program termination, it may be undefined | ||||
| 214 | before the file IO::Handle is closed. Note that you need to import the | ||||
| 215 | constants C<_IOFBF>, C<_IOLBF>, and C<_IONBF> explicitly. Like C, setbuf | ||||
| 216 | returns nothing. setvbuf returns "0 but true", on success, C<undef> on | ||||
| 217 | failure. | ||||
| 218 | |||||
| 219 | Lastly, there is a special method for working under B<-T> and setuid/gid | ||||
| 220 | scripts: | ||||
| 221 | |||||
| 222 | =over 4 | ||||
| 223 | |||||
| 224 | =item $io->untaint | ||||
| 225 | |||||
| 226 | Marks the object as taint-clean, and as such data read from it will also | ||||
| 227 | be considered taint-clean. Note that this is a very trusting action to | ||||
| 228 | take, and appropriate consideration for the data source and potential | ||||
| 229 | vulnerability should be kept in mind. Returns 0 on success, -1 if setting | ||||
| 230 | the taint-clean flag failed. (eg invalid handle) | ||||
| 231 | |||||
| 232 | =back | ||||
| 233 | |||||
| 234 | =head1 NOTE | ||||
| 235 | |||||
| 236 | An C<IO::Handle> object is a reference to a symbol/GLOB reference (see | ||||
| 237 | the C<Symbol> package). Some modules that | ||||
| 238 | inherit from C<IO::Handle> may want to keep object related variables | ||||
| 239 | in the hash table part of the GLOB. In an attempt to prevent modules | ||||
| 240 | trampling on each other I propose the that any such module should prefix | ||||
| 241 | its variables with its own name separated by _'s. For example the IO::Socket | ||||
| 242 | module keeps a C<timeout> variable in 'io_socket_timeout'. | ||||
| 243 | |||||
| 244 | =head1 SEE ALSO | ||||
| 245 | |||||
| 246 | L<perlfunc>, | ||||
| 247 | L<perlop/"I/O Operators">, | ||||
| 248 | L<IO::File> | ||||
| 249 | |||||
| 250 | =head1 BUGS | ||||
| 251 | |||||
| 252 | Due to backwards compatibility, all filehandles resemble objects | ||||
| 253 | of class C<IO::Handle>, or actually classes derived from that class. | ||||
| 254 | They actually aren't. Which means you can't derive your own | ||||
| 255 | class from C<IO::Handle> and inherit those methods. | ||||
| 256 | |||||
| 257 | =head1 HISTORY | ||||
| 258 | |||||
| 259 | Derived from FileHandle.pm by Graham Barr E<lt>F<gbarr@pobox.com>E<gt> | ||||
| 260 | |||||
| 261 | =cut | ||||
| 262 | |||||
| 263 | 2 | 20µs | 1 | 8µs | # spent 8µs within IO::Handle::BEGIN@263 which was called:
# once (8µs+0s) by IO::Seekable::BEGIN@101 at line 263 # spent 8µs making 1 call to IO::Handle::BEGIN@263 |
| 264 | 2 | 20µs | 2 | 17µs | # spent 10µs (3+7) within IO::Handle::BEGIN@264 which was called:
# once (3µs+7µs) by IO::Seekable::BEGIN@101 at line 264 # spent 10µs making 1 call to IO::Handle::BEGIN@264
# spent 7µs making 1 call to strict::import |
| 265 | 1 | 300ns | our($VERSION, @EXPORT_OK, @ISA); | ||
| 266 | 2 | 11µs | 2 | 41µs | # spent 22µs (4+19) within IO::Handle::BEGIN@266 which was called:
# once (4µs+19µs) by IO::Seekable::BEGIN@101 at line 266 # spent 22µs making 1 call to IO::Handle::BEGIN@266
# spent 19µs making 1 call to Exporter::import |
| 267 | 2 | 12µs | 2 | 34µs | # spent 19µs (3+15) within IO::Handle::BEGIN@267 which was called:
# once (3µs+15µs) by IO::Seekable::BEGIN@101 at line 267 # spent 19µs making 1 call to IO::Handle::BEGIN@267
# spent 15µs making 1 call to Exporter::import |
| 268 | 2 | 9µs | 1 | 2µs | # spent 2µs within IO::Handle::BEGIN@268 which was called:
# once (2µs+0s) by IO::Seekable::BEGIN@101 at line 268 # spent 2µs making 1 call to IO::Handle::BEGIN@268 |
| 269 | 2 | 911µs | 1 | 314µs | # spent 314µs (154+161) within IO::Handle::BEGIN@269 which was called:
# once (154µs+161µs) by IO::Seekable::BEGIN@101 at line 269 # spent 314µs making 1 call to IO::Handle::BEGIN@269 |
| 270 | |||||
| 271 | 1 | 400ns | require Exporter; | ||
| 272 | 1 | 8µs | @ISA = qw(Exporter); | ||
| 273 | |||||
| 274 | 1 | 100ns | $VERSION = "1.35"; | ||
| 275 | 1 | 9µs | $VERSION = eval $VERSION; # spent 2µs executing statements in string eval | ||
| 276 | |||||
| 277 | 1 | 1µs | @EXPORT_OK = qw( | ||
| 278 | autoflush | ||||
| 279 | output_field_separator | ||||
| 280 | output_record_separator | ||||
| 281 | input_record_separator | ||||
| 282 | input_line_number | ||||
| 283 | format_page_number | ||||
| 284 | format_lines_per_page | ||||
| 285 | format_lines_left | ||||
| 286 | format_name | ||||
| 287 | format_top_name | ||||
| 288 | format_line_break_characters | ||||
| 289 | format_formfeed | ||||
| 290 | format_write | ||||
| 291 | |||||
| 292 | |||||
| 293 | printf | ||||
| 294 | say | ||||
| 295 | getline | ||||
| 296 | getlines | ||||
| 297 | |||||
| 298 | printflush | ||||
| 299 | flush | ||||
| 300 | |||||
| 301 | SEEK_SET | ||||
| 302 | SEEK_CUR | ||||
| 303 | SEEK_END | ||||
| 304 | _IOFBF | ||||
| 305 | _IOLBF | ||||
| 306 | _IONBF | ||||
| 307 | ); | ||||
| 308 | |||||
| 309 | ################################################ | ||||
| 310 | ## Constructors, destructors. | ||||
| 311 | ## | ||||
| 312 | |||||
| 313 | # spent 19µs (11+8) within IO::Handle::new which was called:
# once (11µs+8µs) by IO::File::new at line 160 of IO/File.pm | ||||
| 314 | 1 | 800ns | my $class = ref($_[0]) || $_[0] || "IO::Handle"; | ||
| 315 | 1 | 500ns | if (@_ != 1) { | ||
| 316 | # Since perl will automatically require IO::File if needed, but | ||||
| 317 | # also initialises IO::File's @ISA as part of the core we must | ||||
| 318 | # ensure IO::File is loaded if IO::Handle is. This avoids effect- | ||||
| 319 | # ively "half-loading" IO::File. | ||||
| 320 | if ($] > 5.013 && $class eq 'IO::File' && !$INC{"IO/File.pm"}) { | ||||
| 321 | require IO::File; | ||||
| 322 | shift; | ||||
| 323 | return IO::File::->new(@_); | ||||
| 324 | } | ||||
| 325 | croak "usage: $class->new()"; | ||||
| 326 | } | ||||
| 327 | 1 | 2µs | 1 | 8µs | my $io = gensym; # spent 8µs making 1 call to Symbol::gensym |
| 328 | 1 | 2µs | bless $io, $class; | ||
| 329 | } | ||||
| 330 | |||||
| 331 | sub new_from_fd { | ||||
| 332 | my $class = ref($_[0]) || $_[0] || "IO::Handle"; | ||||
| 333 | @_ == 3 or croak "usage: $class->new_from_fd(FD, MODE)"; | ||||
| 334 | my $io = gensym; | ||||
| 335 | shift; | ||||
| 336 | IO::Handle::fdopen($io, @_) | ||||
| 337 | or return undef; | ||||
| 338 | bless $io, $class; | ||||
| 339 | } | ||||
| 340 | |||||
| 341 | # | ||||
| 342 | # There is no need for DESTROY to do anything, because when the | ||||
| 343 | # last reference to an IO object is gone, Perl automatically | ||||
| 344 | # closes its associated files (if any). However, to avoid any | ||||
| 345 | # attempts to autoload DESTROY, we here define it to do nothing. | ||||
| 346 | # | ||||
| 347 | sub DESTROY {} | ||||
| 348 | |||||
| 349 | |||||
| 350 | ################################################ | ||||
| 351 | ## Open and close. | ||||
| 352 | ## | ||||
| 353 | |||||
| 354 | sub _open_mode_string { | ||||
| 355 | my ($mode) = @_; | ||||
| 356 | $mode =~ /^\+?(<|>>?)$/ | ||||
| 357 | or $mode =~ s/^r(\+?)$/$1</ | ||||
| 358 | or $mode =~ s/^w(\+?)$/$1>/ | ||||
| 359 | or $mode =~ s/^a(\+?)$/$1>>/ | ||||
| 360 | or croak "IO::Handle: bad open mode: $mode"; | ||||
| 361 | $mode; | ||||
| 362 | } | ||||
| 363 | |||||
| 364 | sub fdopen { | ||||
| 365 | @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)'; | ||||
| 366 | my ($io, $fd, $mode) = @_; | ||||
| 367 | local(*GLOB); | ||||
| 368 | |||||
| 369 | if (ref($fd) && "".$fd =~ /GLOB\(/o) { | ||||
| 370 | # It's a glob reference; Alias it as we cannot get name of anon GLOBs | ||||
| 371 | my $n = qualify(*GLOB); | ||||
| 372 | *GLOB = *{*$fd}; | ||||
| 373 | $fd = $n; | ||||
| 374 | } elsif ($fd =~ m#^\d+$#) { | ||||
| 375 | # It's an FD number; prefix with "=". | ||||
| 376 | $fd = "=$fd"; | ||||
| 377 | } | ||||
| 378 | |||||
| 379 | open($io, _open_mode_string($mode) . '&' . $fd) | ||||
| 380 | ? $io : undef; | ||||
| 381 | } | ||||
| 382 | |||||
| 383 | sub close { | ||||
| 384 | @_ == 1 or croak 'usage: $io->close()'; | ||||
| 385 | my($io) = @_; | ||||
| 386 | |||||
| 387 | close($io); | ||||
| 388 | } | ||||
| 389 | |||||
| 390 | ################################################ | ||||
| 391 | ## Normal I/O functions. | ||||
| 392 | ## | ||||
| 393 | |||||
| 394 | # flock | ||||
| 395 | # select | ||||
| 396 | |||||
| 397 | sub opened { | ||||
| 398 | @_ == 1 or croak 'usage: $io->opened()'; | ||||
| 399 | defined fileno($_[0]); | ||||
| 400 | } | ||||
| 401 | |||||
| 402 | sub fileno { | ||||
| 403 | @_ == 1 or croak 'usage: $io->fileno()'; | ||||
| 404 | fileno($_[0]); | ||||
| 405 | } | ||||
| 406 | |||||
| 407 | sub getc { | ||||
| 408 | @_ == 1 or croak 'usage: $io->getc()'; | ||||
| 409 | getc($_[0]); | ||||
| 410 | } | ||||
| 411 | |||||
| 412 | # spent 88µs (80+7) within IO::Handle::eof which was called 74 times, avg 1µs/call:
# 68 times (70µs+7µs) by Date::Manip::TZ::_get_curr_zone at line 475 of Date/Manip/TZ.pm, avg 1µs/call
# 6 times (11µs+100ns) by Date::Manip::TZ::_get_curr_zone at line 526 of Date/Manip/TZ.pm, avg 2µs/call | ||||
| 413 | 74 | 6µs | @_ == 1 or croak 'usage: $io->eof()'; | ||
| 414 | 74 | 115µs | 74 | 7µs | eof($_[0]); # spent 7µs making 74 calls to IO::Handle::CORE:eof, avg 95ns/call |
| 415 | } | ||||
| 416 | |||||
| 417 | sub print { | ||||
| 418 | @_ or croak 'usage: $io->print(ARGS)'; | ||||
| 419 | my $this = shift; | ||||
| 420 | print $this @_; | ||||
| 421 | } | ||||
| 422 | |||||
| 423 | sub printf { | ||||
| 424 | @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])'; | ||||
| 425 | my $this = shift; | ||||
| 426 | printf $this @_; | ||||
| 427 | } | ||||
| 428 | |||||
| 429 | sub say { | ||||
| 430 | @_ or croak 'usage: $io->say(ARGS)'; | ||||
| 431 | my $this = shift; | ||||
| 432 | local $\ = "\n"; | ||||
| 433 | print $this @_; | ||||
| 434 | } | ||||
| 435 | |||||
| 436 | # Special XS wrapper to make them inherit lexical hints from the caller. | ||||
| 437 | 1 | 52µs | 1 | 50µs | _create_getline_subs( <<'END' ) or die $@; # spent 50µs making 1 call to IO::Handle::_create_getline_subs # spent 1µs executing statements in string eval |
| 438 | sub getline { | ||||
| 439 | @_ == 1 or croak 'usage: $io->getline()'; | ||||
| 440 | my $this = shift; | ||||
| 441 | return scalar <$this>; | ||||
| 442 | } | ||||
| 443 | |||||
| 444 | sub getlines { | ||||
| 445 | @_ == 1 or croak 'usage: $io->getlines()'; | ||||
| 446 | wantarray or | ||||
| 447 | croak 'Can\'t call $io->getlines in a scalar context, use $io->getline'; | ||||
| 448 | my $this = shift; | ||||
| 449 | return <$this>; | ||||
| 450 | } | ||||
| 451 | 1; # return true for error checking | ||||
| 452 | END | ||||
| 453 | |||||
| 454 | 1 | 1µs | *gets = \&getline; # deprecated | ||
| 455 | |||||
| 456 | sub truncate { | ||||
| 457 | @_ == 2 or croak 'usage: $io->truncate(LEN)'; | ||||
| 458 | truncate($_[0], $_[1]); | ||||
| 459 | } | ||||
| 460 | |||||
| 461 | sub read { | ||||
| 462 | @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])'; | ||||
| 463 | read($_[0], $_[1], $_[2], $_[3] || 0); | ||||
| 464 | } | ||||
| 465 | |||||
| 466 | sub sysread { | ||||
| 467 | @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])'; | ||||
| 468 | sysread($_[0], $_[1], $_[2], $_[3] || 0); | ||||
| 469 | } | ||||
| 470 | |||||
| 471 | sub write { | ||||
| 472 | @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])'; | ||||
| 473 | local($\) = ""; | ||||
| 474 | $_[2] = length($_[1]) unless defined $_[2]; | ||||
| 475 | print { $_[0] } substr($_[1], $_[3] || 0, $_[2]); | ||||
| 476 | } | ||||
| 477 | |||||
| 478 | sub syswrite { | ||||
| 479 | @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])'; | ||||
| 480 | if (defined($_[2])) { | ||||
| 481 | syswrite($_[0], $_[1], $_[2], $_[3] || 0); | ||||
| 482 | } else { | ||||
| 483 | syswrite($_[0], $_[1]); | ||||
| 484 | } | ||||
| 485 | } | ||||
| 486 | |||||
| 487 | sub stat { | ||||
| 488 | @_ == 1 or croak 'usage: $io->stat()'; | ||||
| 489 | stat($_[0]); | ||||
| 490 | } | ||||
| 491 | |||||
| 492 | ################################################ | ||||
| 493 | ## State modification functions. | ||||
| 494 | ## | ||||
| 495 | |||||
| 496 | sub autoflush { | ||||
| 497 | my $old = new SelectSaver qualify($_[0], caller); | ||||
| 498 | my $prev = $|; | ||||
| 499 | $| = @_ > 1 ? $_[1] : 1; | ||||
| 500 | $prev; | ||||
| 501 | } | ||||
| 502 | |||||
| 503 | sub output_field_separator { | ||||
| 504 | carp "output_field_separator is not supported on a per-handle basis" | ||||
| 505 | if ref($_[0]); | ||||
| 506 | my $prev = $,; | ||||
| 507 | $, = $_[1] if @_ > 1; | ||||
| 508 | $prev; | ||||
| 509 | } | ||||
| 510 | |||||
| 511 | sub output_record_separator { | ||||
| 512 | carp "output_record_separator is not supported on a per-handle basis" | ||||
| 513 | if ref($_[0]); | ||||
| 514 | my $prev = $\; | ||||
| 515 | $\ = $_[1] if @_ > 1; | ||||
| 516 | $prev; | ||||
| 517 | } | ||||
| 518 | |||||
| 519 | sub input_record_separator { | ||||
| 520 | carp "input_record_separator is not supported on a per-handle basis" | ||||
| 521 | if ref($_[0]); | ||||
| 522 | my $prev = $/; | ||||
| 523 | $/ = $_[1] if @_ > 1; | ||||
| 524 | $prev; | ||||
| 525 | } | ||||
| 526 | |||||
| 527 | sub input_line_number { | ||||
| 528 | local $.; | ||||
| 529 | () = tell qualify($_[0], caller) if ref($_[0]); | ||||
| 530 | my $prev = $.; | ||||
| 531 | $. = $_[1] if @_ > 1; | ||||
| 532 | $prev; | ||||
| 533 | } | ||||
| 534 | |||||
| 535 | sub format_page_number { | ||||
| 536 | my $old; | ||||
| 537 | $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); | ||||
| 538 | my $prev = $%; | ||||
| 539 | $% = $_[1] if @_ > 1; | ||||
| 540 | $prev; | ||||
| 541 | } | ||||
| 542 | |||||
| 543 | sub format_lines_per_page { | ||||
| 544 | my $old; | ||||
| 545 | $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); | ||||
| 546 | my $prev = $=; | ||||
| 547 | $= = $_[1] if @_ > 1; | ||||
| 548 | $prev; | ||||
| 549 | } | ||||
| 550 | |||||
| 551 | sub format_lines_left { | ||||
| 552 | my $old; | ||||
| 553 | $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); | ||||
| 554 | my $prev = $-; | ||||
| 555 | $- = $_[1] if @_ > 1; | ||||
| 556 | $prev; | ||||
| 557 | } | ||||
| 558 | |||||
| 559 | sub format_name { | ||||
| 560 | my $old; | ||||
| 561 | $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); | ||||
| 562 | my $prev = $~; | ||||
| 563 | $~ = qualify($_[1], caller) if @_ > 1; | ||||
| 564 | $prev; | ||||
| 565 | } | ||||
| 566 | |||||
| 567 | sub format_top_name { | ||||
| 568 | my $old; | ||||
| 569 | $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); | ||||
| 570 | my $prev = $^; | ||||
| 571 | $^ = qualify($_[1], caller) if @_ > 1; | ||||
| 572 | $prev; | ||||
| 573 | } | ||||
| 574 | |||||
| 575 | sub format_line_break_characters { | ||||
| 576 | carp "format_line_break_characters is not supported on a per-handle basis" | ||||
| 577 | if ref($_[0]); | ||||
| 578 | my $prev = $:; | ||||
| 579 | $: = $_[1] if @_ > 1; | ||||
| 580 | $prev; | ||||
| 581 | } | ||||
| 582 | |||||
| 583 | sub format_formfeed { | ||||
| 584 | carp "format_formfeed is not supported on a per-handle basis" | ||||
| 585 | if ref($_[0]); | ||||
| 586 | my $prev = $^L; | ||||
| 587 | $^L = $_[1] if @_ > 1; | ||||
| 588 | $prev; | ||||
| 589 | } | ||||
| 590 | |||||
| 591 | sub formline { | ||||
| 592 | my $io = shift; | ||||
| 593 | my $picture = shift; | ||||
| 594 | local($^A) = $^A; | ||||
| 595 | local($\) = ""; | ||||
| 596 | formline($picture, @_); | ||||
| 597 | print $io $^A; | ||||
| 598 | } | ||||
| 599 | |||||
| 600 | sub format_write { | ||||
| 601 | @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )'; | ||||
| 602 | if (@_ == 2) { | ||||
| 603 | my ($io, $fmt) = @_; | ||||
| 604 | my $oldfmt = $io->format_name(qualify($fmt,caller)); | ||||
| 605 | CORE::write($io); | ||||
| 606 | $io->format_name($oldfmt); | ||||
| 607 | } else { | ||||
| 608 | CORE::write($_[0]); | ||||
| 609 | } | ||||
| 610 | } | ||||
| 611 | |||||
| 612 | sub fcntl { | ||||
| 613 | @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );'; | ||||
| 614 | my ($io, $op) = @_; | ||||
| 615 | return fcntl($io, $op, $_[2]); | ||||
| 616 | } | ||||
| 617 | |||||
| 618 | sub ioctl { | ||||
| 619 | @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );'; | ||||
| 620 | my ($io, $op) = @_; | ||||
| 621 | return ioctl($io, $op, $_[2]); | ||||
| 622 | } | ||||
| 623 | |||||
| 624 | # this sub is for compatibility with older releases of IO that used | ||||
| 625 | # a sub called constant to determine if a constant existed -- GMB | ||||
| 626 | # | ||||
| 627 | # The SEEK_* and _IO?BF constants were the only constants at that time | ||||
| 628 | # any new code should just check defined(&CONSTANT_NAME) | ||||
| 629 | |||||
| 630 | sub constant { | ||||
| 631 | 2 | 92µs | 2 | 19µs | # spent 12µs (5+7) within IO::Handle::BEGIN@631 which was called:
# once (5µs+7µs) by IO::Seekable::BEGIN@101 at line 631 # spent 12µs making 1 call to IO::Handle::BEGIN@631
# spent 7µs making 1 call to strict::unimport |
| 632 | my $name = shift; | ||||
| 633 | (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name}) | ||||
| 634 | ? &{$name}() : undef; | ||||
| 635 | } | ||||
| 636 | |||||
| 637 | |||||
| 638 | # so that flush.pl can be deprecated | ||||
| 639 | |||||
| 640 | sub printflush { | ||||
| 641 | my $io = shift; | ||||
| 642 | my $old; | ||||
| 643 | $old = new SelectSaver qualify($io, caller) if ref($io); | ||||
| 644 | local $| = 1; | ||||
| 645 | if(ref($io)) { | ||||
| 646 | print $io @_; | ||||
| 647 | } | ||||
| 648 | else { | ||||
| 649 | print @_; | ||||
| 650 | } | ||||
| 651 | } | ||||
| 652 | |||||
| 653 | 1 | 4µs | 1; | ||
# spent 7µs within IO::Handle::CORE:eof which was called 74 times, avg 95ns/call:
# 74 times (7µs+0s) by IO::Handle::eof at line 414, avg 95ns/call | |||||
# spent 50µs within IO::Handle::_create_getline_subs which was called:
# once (50µs+0s) by IO::Seekable::BEGIN@101 at line 437 |