| Filename | /home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/5.10.1/x86_64-linux/IO/Handle.pm |
| Statements | Executed 29 statements in 9.15ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 2.39ms | 2.72ms | IO::Handle::BEGIN@264 |
| 1 | 1 | 1 | 955µs | 2.24ms | IO::Handle::BEGIN@266 |
| 1 | 1 | 1 | 950µs | 1.47ms | IO::Handle::BEGIN@265 |
| 1 | 1 | 1 | 107µs | 107µs | IO::Handle::BEGIN@260 |
| 1 | 1 | 1 | 45µs | 121µs | IO::Handle::BEGIN@613 |
| 1 | 1 | 1 | 43µs | 276µs | IO::Handle::BEGIN@263 |
| 1 | 1 | 1 | 39µs | 56µs | IO::Handle::BEGIN@261 |
| 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::eof |
| 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::getline |
| 0 | 0 | 0 | 0s | 0s | IO::Handle::getlines |
| 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 |
| 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 | |||||
| - - | |||||
| 260 | 3 | 155µs | 1 | 107µs | # spent 107µs within IO::Handle::BEGIN@260 which was called:
# once (107µs+0s) by Markdent::Types::Internal::BEGIN@9 at line 260 # spent 107µs making 1 call to IO::Handle::BEGIN@260 |
| 261 | 3 | 161µs | 2 | 73µs | # spent 56µs (39+17) within IO::Handle::BEGIN@261 which was called:
# once (39µs+17µs) by Markdent::Types::Internal::BEGIN@9 at line 261 # spent 56µs making 1 call to IO::Handle::BEGIN@261
# spent 17µs making 1 call to strict::import |
| 262 | 1 | 4µs | our($VERSION, @EXPORT_OK, @ISA); | ||
| 263 | 3 | 115µs | 2 | 509µs | # spent 276µs (43+233) within IO::Handle::BEGIN@263 which was called:
# once (43µs+233µs) by Markdent::Types::Internal::BEGIN@9 at line 263 # spent 276µs making 1 call to IO::Handle::BEGIN@263
# spent 233µs making 1 call to Exporter::import |
| 264 | 3 | 475µs | 2 | 2.97ms | # spent 2.72ms (2.39+338µs) within IO::Handle::BEGIN@264 which was called:
# once (2.39ms+338µs) by Markdent::Types::Internal::BEGIN@9 at line 264 # spent 2.72ms making 1 call to IO::Handle::BEGIN@264
# spent 244µs making 1 call to Exporter::import |
| 265 | 3 | 549µs | 1 | 1.47ms | # spent 1.47ms (950µs+520µs) within IO::Handle::BEGIN@265 which was called:
# once (950µs+520µs) by Markdent::Types::Internal::BEGIN@9 at line 265 # spent 1.47ms making 1 call to IO::Handle::BEGIN@265 |
| 266 | 3 | 6.93ms | 1 | 2.24ms | # spent 2.24ms (955µs+1.29) within IO::Handle::BEGIN@266 which was called:
# once (955µs+1.29ms) by Markdent::Types::Internal::BEGIN@9 at line 266 # spent 2.24ms making 1 call to IO::Handle::BEGIN@266 |
| 267 | |||||
| 268 | 1 | 4µs | require Exporter; | ||
| 269 | 1 | 32µs | @ISA = qw(Exporter); | ||
| 270 | |||||
| 271 | 1 | 3µs | $VERSION = "1.28"; | ||
| 272 | 1 | 77µs | $VERSION = eval $VERSION; # spent 11µs executing statements in string eval | ||
| 273 | |||||
| 274 | 1 | 22µs | @EXPORT_OK = qw( | ||
| 275 | autoflush | ||||
| 276 | output_field_separator | ||||
| 277 | output_record_separator | ||||
| 278 | input_record_separator | ||||
| 279 | input_line_number | ||||
| 280 | format_page_number | ||||
| 281 | format_lines_per_page | ||||
| 282 | format_lines_left | ||||
| 283 | format_name | ||||
| 284 | format_top_name | ||||
| 285 | format_line_break_characters | ||||
| 286 | format_formfeed | ||||
| 287 | format_write | ||||
| 288 | |||||
| 289 | |||||
| 290 | printf | ||||
| 291 | say | ||||
| 292 | getline | ||||
| 293 | getlines | ||||
| 294 | |||||
| 295 | printflush | ||||
| 296 | flush | ||||
| 297 | |||||
| 298 | SEEK_SET | ||||
| 299 | SEEK_CUR | ||||
| 300 | SEEK_END | ||||
| 301 | _IOFBF | ||||
| 302 | _IOLBF | ||||
| 303 | _IONBF | ||||
| 304 | ); | ||||
| 305 | |||||
| 306 | ################################################ | ||||
| 307 | ## Constructors, destructors. | ||||
| 308 | ## | ||||
| 309 | |||||
| 310 | sub new { | ||||
| 311 | my $class = ref($_[0]) || $_[0] || "IO::Handle"; | ||||
| 312 | @_ == 1 or croak "usage: new $class"; | ||||
| 313 | my $io = gensym; | ||||
| 314 | bless $io, $class; | ||||
| 315 | } | ||||
| 316 | |||||
| 317 | sub new_from_fd { | ||||
| 318 | my $class = ref($_[0]) || $_[0] || "IO::Handle"; | ||||
| 319 | @_ == 3 or croak "usage: new_from_fd $class FD, MODE"; | ||||
| 320 | my $io = gensym; | ||||
| 321 | shift; | ||||
| 322 | IO::Handle::fdopen($io, @_) | ||||
| 323 | or return undef; | ||||
| 324 | bless $io, $class; | ||||
| 325 | } | ||||
| 326 | |||||
| 327 | # | ||||
| 328 | # There is no need for DESTROY to do anything, because when the | ||||
| 329 | # last reference to an IO object is gone, Perl automatically | ||||
| 330 | # closes its associated files (if any). However, to avoid any | ||||
| 331 | # attempts to autoload DESTROY, we here define it to do nothing. | ||||
| 332 | # | ||||
| 333 | sub DESTROY {} | ||||
| 334 | |||||
| 335 | |||||
| 336 | ################################################ | ||||
| 337 | ## Open and close. | ||||
| 338 | ## | ||||
| 339 | |||||
| 340 | sub _open_mode_string { | ||||
| 341 | my ($mode) = @_; | ||||
| 342 | $mode =~ /^\+?(<|>>?)$/ | ||||
| 343 | or $mode =~ s/^r(\+?)$/$1</ | ||||
| 344 | or $mode =~ s/^w(\+?)$/$1>/ | ||||
| 345 | or $mode =~ s/^a(\+?)$/$1>>/ | ||||
| 346 | or croak "IO::Handle: bad open mode: $mode"; | ||||
| 347 | $mode; | ||||
| 348 | } | ||||
| 349 | |||||
| 350 | sub fdopen { | ||||
| 351 | @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)'; | ||||
| 352 | my ($io, $fd, $mode) = @_; | ||||
| 353 | local(*GLOB); | ||||
| 354 | |||||
| 355 | if (ref($fd) && "".$fd =~ /GLOB\(/o) { | ||||
| 356 | # It's a glob reference; Alias it as we cannot get name of anon GLOBs | ||||
| 357 | my $n = qualify(*GLOB); | ||||
| 358 | *GLOB = *{*$fd}; | ||||
| 359 | $fd = $n; | ||||
| 360 | } elsif ($fd =~ m#^\d+$#) { | ||||
| 361 | # It's an FD number; prefix with "=". | ||||
| 362 | $fd = "=$fd"; | ||||
| 363 | } | ||||
| 364 | |||||
| 365 | open($io, _open_mode_string($mode) . '&' . $fd) | ||||
| 366 | ? $io : undef; | ||||
| 367 | } | ||||
| 368 | |||||
| 369 | sub close { | ||||
| 370 | @_ == 1 or croak 'usage: $io->close()'; | ||||
| 371 | my($io) = @_; | ||||
| 372 | |||||
| 373 | close($io); | ||||
| 374 | } | ||||
| 375 | |||||
| 376 | ################################################ | ||||
| 377 | ## Normal I/O functions. | ||||
| 378 | ## | ||||
| 379 | |||||
| 380 | # flock | ||||
| 381 | # select | ||||
| 382 | |||||
| 383 | sub opened { | ||||
| 384 | @_ == 1 or croak 'usage: $io->opened()'; | ||||
| 385 | defined fileno($_[0]); | ||||
| 386 | } | ||||
| 387 | |||||
| 388 | sub fileno { | ||||
| 389 | @_ == 1 or croak 'usage: $io->fileno()'; | ||||
| 390 | fileno($_[0]); | ||||
| 391 | } | ||||
| 392 | |||||
| 393 | sub getc { | ||||
| 394 | @_ == 1 or croak 'usage: $io->getc()'; | ||||
| 395 | getc($_[0]); | ||||
| 396 | } | ||||
| 397 | |||||
| 398 | sub eof { | ||||
| 399 | @_ == 1 or croak 'usage: $io->eof()'; | ||||
| 400 | eof($_[0]); | ||||
| 401 | } | ||||
| 402 | |||||
| 403 | sub print { | ||||
| 404 | @_ or croak 'usage: $io->print(ARGS)'; | ||||
| 405 | my $this = shift; | ||||
| 406 | print $this @_; | ||||
| 407 | } | ||||
| 408 | |||||
| 409 | sub printf { | ||||
| 410 | @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])'; | ||||
| 411 | my $this = shift; | ||||
| 412 | printf $this @_; | ||||
| 413 | } | ||||
| 414 | |||||
| 415 | sub say { | ||||
| 416 | @_ or croak 'usage: $io->say(ARGS)'; | ||||
| 417 | my $this = shift; | ||||
| 418 | local $\ = "\n"; | ||||
| 419 | print $this @_; | ||||
| 420 | } | ||||
| 421 | |||||
| 422 | sub getline { | ||||
| 423 | @_ == 1 or croak 'usage: $io->getline()'; | ||||
| 424 | my $this = shift; | ||||
| 425 | return scalar <$this>; | ||||
| 426 | } | ||||
| 427 | |||||
| 428 | 1 | 6µs | *gets = \&getline; # deprecated | ||
| 429 | |||||
| 430 | sub getlines { | ||||
| 431 | @_ == 1 or croak 'usage: $io->getlines()'; | ||||
| 432 | wantarray or | ||||
| 433 | croak 'Can\'t call $io->getlines in a scalar context, use $io->getline'; | ||||
| 434 | my $this = shift; | ||||
| 435 | return <$this>; | ||||
| 436 | } | ||||
| 437 | |||||
| 438 | sub truncate { | ||||
| 439 | @_ == 2 or croak 'usage: $io->truncate(LEN)'; | ||||
| 440 | truncate($_[0], $_[1]); | ||||
| 441 | } | ||||
| 442 | |||||
| 443 | sub read { | ||||
| 444 | @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])'; | ||||
| 445 | read($_[0], $_[1], $_[2], $_[3] || 0); | ||||
| 446 | } | ||||
| 447 | |||||
| 448 | sub sysread { | ||||
| 449 | @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])'; | ||||
| 450 | sysread($_[0], $_[1], $_[2], $_[3] || 0); | ||||
| 451 | } | ||||
| 452 | |||||
| 453 | sub write { | ||||
| 454 | @_ >= 2 && @_ <= 4 or croak 'usage: $io->write(BUF [, LEN [, OFFSET]])'; | ||||
| 455 | local($\) = ""; | ||||
| 456 | $_[2] = length($_[1]) unless defined $_[2]; | ||||
| 457 | print { $_[0] } substr($_[1], $_[3] || 0, $_[2]); | ||||
| 458 | } | ||||
| 459 | |||||
| 460 | sub syswrite { | ||||
| 461 | @_ >= 2 && @_ <= 4 or croak 'usage: $io->syswrite(BUF [, LEN [, OFFSET]])'; | ||||
| 462 | if (defined($_[2])) { | ||||
| 463 | syswrite($_[0], $_[1], $_[2], $_[3] || 0); | ||||
| 464 | } else { | ||||
| 465 | syswrite($_[0], $_[1]); | ||||
| 466 | } | ||||
| 467 | } | ||||
| 468 | |||||
| 469 | sub stat { | ||||
| 470 | @_ == 1 or croak 'usage: $io->stat()'; | ||||
| 471 | stat($_[0]); | ||||
| 472 | } | ||||
| 473 | |||||
| 474 | ################################################ | ||||
| 475 | ## State modification functions. | ||||
| 476 | ## | ||||
| 477 | |||||
| 478 | sub autoflush { | ||||
| 479 | my $old = new SelectSaver qualify($_[0], caller); | ||||
| 480 | my $prev = $|; | ||||
| 481 | $| = @_ > 1 ? $_[1] : 1; | ||||
| 482 | $prev; | ||||
| 483 | } | ||||
| 484 | |||||
| 485 | sub output_field_separator { | ||||
| 486 | carp "output_field_separator is not supported on a per-handle basis" | ||||
| 487 | if ref($_[0]); | ||||
| 488 | my $prev = $,; | ||||
| 489 | $, = $_[1] if @_ > 1; | ||||
| 490 | $prev; | ||||
| 491 | } | ||||
| 492 | |||||
| 493 | sub output_record_separator { | ||||
| 494 | carp "output_record_separator is not supported on a per-handle basis" | ||||
| 495 | if ref($_[0]); | ||||
| 496 | my $prev = $\; | ||||
| 497 | $\ = $_[1] if @_ > 1; | ||||
| 498 | $prev; | ||||
| 499 | } | ||||
| 500 | |||||
| 501 | sub input_record_separator { | ||||
| 502 | carp "input_record_separator is not supported on a per-handle basis" | ||||
| 503 | if ref($_[0]); | ||||
| 504 | my $prev = $/; | ||||
| 505 | $/ = $_[1] if @_ > 1; | ||||
| 506 | $prev; | ||||
| 507 | } | ||||
| 508 | |||||
| 509 | sub input_line_number { | ||||
| 510 | local $.; | ||||
| 511 | () = tell qualify($_[0], caller) if ref($_[0]); | ||||
| 512 | my $prev = $.; | ||||
| 513 | $. = $_[1] if @_ > 1; | ||||
| 514 | $prev; | ||||
| 515 | } | ||||
| 516 | |||||
| 517 | sub format_page_number { | ||||
| 518 | my $old; | ||||
| 519 | $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); | ||||
| 520 | my $prev = $%; | ||||
| 521 | $% = $_[1] if @_ > 1; | ||||
| 522 | $prev; | ||||
| 523 | } | ||||
| 524 | |||||
| 525 | sub format_lines_per_page { | ||||
| 526 | my $old; | ||||
| 527 | $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); | ||||
| 528 | my $prev = $=; | ||||
| 529 | $= = $_[1] if @_ > 1; | ||||
| 530 | $prev; | ||||
| 531 | } | ||||
| 532 | |||||
| 533 | sub format_lines_left { | ||||
| 534 | my $old; | ||||
| 535 | $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); | ||||
| 536 | my $prev = $-; | ||||
| 537 | $- = $_[1] if @_ > 1; | ||||
| 538 | $prev; | ||||
| 539 | } | ||||
| 540 | |||||
| 541 | sub format_name { | ||||
| 542 | my $old; | ||||
| 543 | $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); | ||||
| 544 | my $prev = $~; | ||||
| 545 | $~ = qualify($_[1], caller) if @_ > 1; | ||||
| 546 | $prev; | ||||
| 547 | } | ||||
| 548 | |||||
| 549 | sub format_top_name { | ||||
| 550 | my $old; | ||||
| 551 | $old = new SelectSaver qualify($_[0], caller) if ref($_[0]); | ||||
| 552 | my $prev = $^; | ||||
| 553 | $^ = qualify($_[1], caller) if @_ > 1; | ||||
| 554 | $prev; | ||||
| 555 | } | ||||
| 556 | |||||
| 557 | sub format_line_break_characters { | ||||
| 558 | carp "format_line_break_characters is not supported on a per-handle basis" | ||||
| 559 | if ref($_[0]); | ||||
| 560 | my $prev = $:; | ||||
| 561 | $: = $_[1] if @_ > 1; | ||||
| 562 | $prev; | ||||
| 563 | } | ||||
| 564 | |||||
| 565 | sub format_formfeed { | ||||
| 566 | carp "format_formfeed is not supported on a per-handle basis" | ||||
| 567 | if ref($_[0]); | ||||
| 568 | my $prev = $^L; | ||||
| 569 | $^L = $_[1] if @_ > 1; | ||||
| 570 | $prev; | ||||
| 571 | } | ||||
| 572 | |||||
| 573 | sub formline { | ||||
| 574 | my $io = shift; | ||||
| 575 | my $picture = shift; | ||||
| 576 | local($^A) = $^A; | ||||
| 577 | local($\) = ""; | ||||
| 578 | formline($picture, @_); | ||||
| 579 | print $io $^A; | ||||
| 580 | } | ||||
| 581 | |||||
| 582 | sub format_write { | ||||
| 583 | @_ < 3 || croak 'usage: $io->write( [FORMAT_NAME] )'; | ||||
| 584 | if (@_ == 2) { | ||||
| 585 | my ($io, $fmt) = @_; | ||||
| 586 | my $oldfmt = $io->format_name(qualify($fmt,caller)); | ||||
| 587 | CORE::write($io); | ||||
| 588 | $io->format_name($oldfmt); | ||||
| 589 | } else { | ||||
| 590 | CORE::write($_[0]); | ||||
| 591 | } | ||||
| 592 | } | ||||
| 593 | |||||
| 594 | sub fcntl { | ||||
| 595 | @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );'; | ||||
| 596 | my ($io, $op) = @_; | ||||
| 597 | return fcntl($io, $op, $_[2]); | ||||
| 598 | } | ||||
| 599 | |||||
| 600 | sub ioctl { | ||||
| 601 | @_ == 3 || croak 'usage: $io->ioctl( OP, VALUE );'; | ||||
| 602 | my ($io, $op) = @_; | ||||
| 603 | return ioctl($io, $op, $_[2]); | ||||
| 604 | } | ||||
| 605 | |||||
| 606 | # this sub is for compatability with older releases of IO that used | ||||
| 607 | # a sub called constant to detemine if a constant existed -- GMB | ||||
| 608 | # | ||||
| 609 | # The SEEK_* and _IO?BF constants were the only constants at that time | ||||
| 610 | # any new code should just chech defined(&CONSTANT_NAME) | ||||
| 611 | |||||
| 612 | sub constant { | ||||
| 613 | 3 | 586µs | 2 | 197µs | # spent 121µs (45+76) within IO::Handle::BEGIN@613 which was called:
# once (45µs+76µs) by Markdent::Types::Internal::BEGIN@9 at line 613 # spent 121µs making 1 call to IO::Handle::BEGIN@613
# spent 76µs making 1 call to strict::unimport |
| 614 | my $name = shift; | ||||
| 615 | (($name =~ /^(SEEK_(SET|CUR|END)|_IO[FLN]BF)$/) && defined &{$name}) | ||||
| 616 | ? &{$name}() : undef; | ||||
| 617 | } | ||||
| 618 | |||||
| 619 | |||||
| 620 | # so that flush.pl can be deprecated | ||||
| 621 | |||||
| 622 | sub printflush { | ||||
| 623 | my $io = shift; | ||||
| 624 | my $old; | ||||
| 625 | $old = new SelectSaver qualify($io, caller) if ref($io); | ||||
| 626 | local $| = 1; | ||||
| 627 | if(ref($io)) { | ||||
| 628 | print $io @_; | ||||
| 629 | } | ||||
| 630 | else { | ||||
| 631 | print @_; | ||||
| 632 | } | ||||
| 633 | } | ||||
| 634 | |||||
| 635 | 1 | 28µs | 1; |