← Index
NYTProf Performance Profile   « block view • line view • sub view »
For -e
  Run on Wed Nov 17 21:45:08 2010
Reported on Wed Nov 17 22:10:03 2010

Filename/home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/5.10.1/x86_64-linux/IO/Handle.pm
StatementsExecuted 29 statements in 9.15ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1112.39ms2.72msIO::Handle::::BEGIN@264IO::Handle::BEGIN@264
111955µs2.24msIO::Handle::::BEGIN@266IO::Handle::BEGIN@266
111950µs1.47msIO::Handle::::BEGIN@265IO::Handle::BEGIN@265
111107µs107µsIO::Handle::::BEGIN@260IO::Handle::BEGIN@260
11145µs121µsIO::Handle::::BEGIN@613IO::Handle::BEGIN@613
11143µs276µsIO::Handle::::BEGIN@263IO::Handle::BEGIN@263
11139µs56µsIO::Handle::::BEGIN@261IO::Handle::BEGIN@261
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::::getlineIO::Handle::getline
0000s0sIO::Handle::::getlinesIO::Handle::getlines
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
3=head1 NAME
4
- -
2603155µs1107µ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
use 5.006_001;
# spent 107µs making 1 call to IO::Handle::BEGIN@260
2613161µs273µ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
use strict;
# spent 56µs making 1 call to IO::Handle::BEGIN@261 # spent 17µs making 1 call to strict::import
26214µsour($VERSION, @EXPORT_OK, @ISA);
2633115µs2509µ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
use Carp;
# spent 276µs making 1 call to IO::Handle::BEGIN@263 # spent 233µs making 1 call to Exporter::import
2643475µs22.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
use Symbol;
# spent 2.72ms making 1 call to IO::Handle::BEGIN@264 # spent 244µs making 1 call to Exporter::import
2653549µs11.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
use SelectSaver;
# spent 1.47ms making 1 call to IO::Handle::BEGIN@265
26636.93ms12.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
use IO (); # Load the XS module
# spent 2.24ms making 1 call to IO::Handle::BEGIN@266
267
26814µsrequire Exporter;
269132µs@ISA = qw(Exporter);
270
27113µs$VERSION = "1.28";
272177µs$VERSION = eval $VERSION;
# spent 11µs executing statements in string eval
273
274122µ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 print
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
310sub 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
317sub 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#
333sub DESTROY {}
334
335
336################################################
337## Open and close.
338##
339
340sub _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
350sub 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
369sub 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
383sub opened {
384 @_ == 1 or croak 'usage: $io->opened()';
385 defined fileno($_[0]);
386}
387
388sub fileno {
389 @_ == 1 or croak 'usage: $io->fileno()';
390 fileno($_[0]);
391}
392
393sub getc {
394 @_ == 1 or croak 'usage: $io->getc()';
395 getc($_[0]);
396}
397
398sub eof {
399 @_ == 1 or croak 'usage: $io->eof()';
400 eof($_[0]);
401}
402
403sub print {
404 @_ or croak 'usage: $io->print(ARGS)';
405 my $this = shift;
406 print $this @_;
407}
408
409sub printf {
410 @_ >= 2 or croak 'usage: $io->printf(FMT,[ARGS])';
411 my $this = shift;
412 printf $this @_;
413}
414
415sub say {
416 @_ or croak 'usage: $io->say(ARGS)';
417 my $this = shift;
418 local $\ = "\n";
419 print $this @_;
420}
421
422sub getline {
423 @_ == 1 or croak 'usage: $io->getline()';
424 my $this = shift;
425 return scalar <$this>;
426}
427
42816µs*gets = \&getline; # deprecated
429
430sub 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
438sub truncate {
439 @_ == 2 or croak 'usage: $io->truncate(LEN)';
440 truncate($_[0], $_[1]);
441}
442
443sub read {
444 @_ == 3 || @_ == 4 or croak 'usage: $io->read(BUF, LEN [, OFFSET])';
445 read($_[0], $_[1], $_[2], $_[3] || 0);
446}
447
448sub sysread {
449 @_ == 3 || @_ == 4 or croak 'usage: $io->sysread(BUF, LEN [, OFFSET])';
450 sysread($_[0], $_[1], $_[2], $_[3] || 0);
451}
452
453sub 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
460sub 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
469sub stat {
470 @_ == 1 or croak 'usage: $io->stat()';
471 stat($_[0]);
472}
473
474################################################
475## State modification functions.
476##
477
478sub autoflush {
479 my $old = new SelectSaver qualify($_[0], caller);
480 my $prev = $|;
481 $| = @_ > 1 ? $_[1] : 1;
482 $prev;
483}
484
485sub 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
493sub 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
501sub 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
509sub input_line_number {
510 local $.;
511 () = tell qualify($_[0], caller) if ref($_[0]);
512 my $prev = $.;
513 $. = $_[1] if @_ > 1;
514 $prev;
515}
516
517sub 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
525sub 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
533sub 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
541sub 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
549sub 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
557sub 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
565sub 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
573sub formline {
574 my $io = shift;
575 my $picture = shift;
576 local($^A) = $^A;
577 local($\) = "";
578 formline($picture, @_);
579 print $io $^A;
580}
581
582sub 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
594sub fcntl {
595 @_ == 3 || croak 'usage: $io->fcntl( OP, VALUE );';
596 my ($io, $op) = @_;
597 return fcntl($io, $op, $_[2]);
598}
599
600sub 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
612sub constant {
6133586µs2197µ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
no strict 'refs';
# 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
622sub 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
635128µs1;