| Filename | /home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/IO/Interactive.pm |
| Statements | Executed 34 statements in 1.16ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 2.10ms | 4.15ms | IO::Interactive::BEGIN@76 |
| 1 | 1 | 1 | 790µs | 1.25ms | IO::Interactive::BEGIN@3 |
| 3 | 1 | 1 | 70µs | 184µs | IO::Interactive::is_interactive |
| 1 | 1 | 1 | 30µs | 30µs | IO::Interactive::BEGIN@37 |
| 6 | 2 | 1 | 28µs | 28µs | IO::Interactive::CORE:fttty (opcode) |
| 1 | 1 | 1 | 15µs | 92µs | IO::Interactive::BEGIN@7 |
| 1 | 1 | 1 | 15µs | 83µs | IO::Interactive::BEGIN@8 |
| 1 | 1 | 1 | 14µs | 35µs | IO::Interactive::BEGIN@5 |
| 1 | 1 | 1 | 13µs | 70µs | IO::Interactive::BEGIN@115 |
| 1 | 1 | 1 | 11µs | 16µs | IO::Interactive::BEGIN@6 |
| 1 | 1 | 1 | 11µs | 31µs | IO::Interactive::BEGIN@123 |
| 3 | 1 | 1 | 8µs | 8µs | IO::Interactive::CORE:select (opcode) |
| 0 | 0 | 0 | 0s | 0s | IO::Interactive::_input_pending_on |
| 0 | 0 | 0 | 0s | 0s | IO::Interactive::busy |
| 0 | 0 | 0 | 0s | 0s | IO::Interactive::import |
| 0 | 0 | 0 | 0s | 0s | IO::Interactive::interactive |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package IO::Interactive; | ||||
| 2 | |||||
| 3 | 3 | 181µs | 3 | 1.29ms | # spent 1.25ms (790µs+460µs) within IO::Interactive::BEGIN@3 which was called:
# once (790µs+460µs) by Hailo::_is_interactive at line 3 # spent 1.25ms making 1 call to IO::Interactive::BEGIN@3
# spent 23µs making 1 call to version::import
# spent 17µs making 1 call to version::__ANON__[version.pm:151] |
| 4 | |||||
| 5 | 2 | 27µs | 2 | 56µs | # spent 35µs (14+21) within IO::Interactive::BEGIN@5 which was called:
# once (14µs+21µs) by Hailo::_is_interactive at line 5 # spent 35µs making 1 call to IO::Interactive::BEGIN@5
# spent 21µs making 1 call to warnings::import |
| 6 | 2 | 25µs | 2 | 21µs | # spent 16µs (11+5) within IO::Interactive::BEGIN@6 which was called:
# once (11µs+5µs) by Hailo::_is_interactive at line 6 # spent 16µs making 1 call to IO::Interactive::BEGIN@6
# spent 5µs making 1 call to strict::import |
| 7 | 2 | 39µs | 2 | 169µs | # spent 92µs (15+77) within IO::Interactive::BEGIN@7 which was called:
# once (15µs+77µs) by Hailo::_is_interactive at line 7 # spent 92µs making 1 call to IO::Interactive::BEGIN@7
# spent 77µs making 1 call to Exporter::import |
| 8 | 2 | 126µs | 2 | 151µs | # spent 83µs (15+68) within IO::Interactive::BEGIN@8 which was called:
# once (15µs+68µs) by Hailo::_is_interactive at line 8 # spent 83µs making 1 call to IO::Interactive::BEGIN@8
# spent 68µs making 1 call to Exporter::import |
| 9 | |||||
| 10 | # spent 184µs (70+113) within IO::Interactive::is_interactive which was called 3 times, avg 61µs/call:
# 3 times (70µs+113µs) by Hailo::_is_interactive at line 340 of lib/Hailo.pm, avg 61µs/call | ||||
| 11 | 9 | 78µs | 3 | 8µs | my ($out_handle) = (@_, select); # Default to default output handle # spent 8µs making 3 calls to IO::Interactive::CORE:select, avg 3µs/call |
| 12 | |||||
| 13 | # Not interactive if output is not to terminal... | ||||
| 14 | 3 | 21µs | return 0 if not -t $out_handle; # spent 21µs making 3 calls to IO::Interactive::CORE:fttty, avg 7µs/call | ||
| 15 | |||||
| 16 | # If *ARGV is opened, we're interactive if... | ||||
| 17 | 3 | 30µs | 3 | 77µs | if (openhandle *ARGV) { # spent 77µs making 3 calls to Scalar::Util::openhandle, avg 26µs/call |
| 18 | # ...it's currently opened to the magic '-' file | ||||
| 19 | return -t *STDIN if defined $ARGV && $ARGV eq '-'; | ||||
| 20 | |||||
| 21 | # ...it's at end-of-file and the next file is the magic '-' file | ||||
| 22 | return @ARGV>0 && $ARGV[0] eq '-' && -t *STDIN if eof *ARGV; | ||||
| 23 | |||||
| 24 | # ...it's directly attached to the terminal | ||||
| 25 | return -t *ARGV; | ||||
| 26 | } | ||||
| 27 | |||||
| 28 | # If *ARGV isn't opened, it will be interactive if *STDIN is attached | ||||
| 29 | # to a terminal. | ||||
| 30 | else { | ||||
| 31 | 3 | 7µs | return -t *STDIN; # spent 7µs making 3 calls to IO::Interactive::CORE:fttty, avg 2µs/call | ||
| 32 | } | ||||
| 33 | } | ||||
| 34 | |||||
| 35 | 1 | 3µs | local (*DEV_NULL, *DEV_NULL2); | ||
| 36 | 1 | 1µs | my $dev_null; | ||
| 37 | # spent 30µs within IO::Interactive::BEGIN@37 which was called:
# once (30µs+0s) by Hailo::_is_interactive at line 41 | ||||
| 38 | 2 | 31µs | pipe *DEV_NULL, *DEV_NULL2 | ||
| 39 | or die "Internal error: can't create null filehandle"; | ||||
| 40 | $dev_null = \*DEV_NULL; | ||||
| 41 | 1 | 145µs | 1 | 30µs | } # spent 30µs making 1 call to IO::Interactive::BEGIN@37 |
| 42 | |||||
| 43 | sub interactive { | ||||
| 44 | my ($out_handle) = (@_, \*STDOUT); # Default to STDOUT | ||||
| 45 | return &is_interactive ? $out_handle : $dev_null; | ||||
| 46 | } | ||||
| 47 | |||||
| 48 | sub _input_pending_on { | ||||
| 49 | my ($fh) = @_; | ||||
| 50 | my $read_bits = ""; | ||||
| 51 | my $bit = fileno($fh); | ||||
| 52 | return if $bit < 0; | ||||
| 53 | vec($read_bits, fileno($fh), 1) = 1; | ||||
| 54 | select $read_bits, undef, undef, 0.1; | ||||
| 55 | return $read_bits; | ||||
| 56 | } | ||||
| 57 | |||||
| 58 | sub busy (&) { | ||||
| 59 | my ($block_ref) = @_; | ||||
| 60 | |||||
| 61 | # Non-interactive busy-ness is easy...just do it | ||||
| 62 | if (!is_interactive()) { | ||||
| 63 | $block_ref->(); | ||||
| 64 | open my $fh, '<', \""; | ||||
| 65 | return $fh; | ||||
| 66 | } | ||||
| 67 | |||||
| 68 | # Otherwise fork off an interceptor process... | ||||
| 69 | my ($read, $write); | ||||
| 70 | pipe $read, $write; | ||||
| 71 | my $child = fork; | ||||
| 72 | |||||
| 73 | # Within that interceptor process... | ||||
| 74 | if (!$child) { | ||||
| 75 | # Prepare to send back any intercepted input... | ||||
| 76 | 2 | 342µs | 2 | 4.18ms | # spent 4.15ms (2.10+2.04) within IO::Interactive::BEGIN@76 which was called:
# once (2.10ms+2.04ms) by Hailo::_is_interactive at line 76 # spent 4.15ms making 1 call to IO::Interactive::BEGIN@76
# spent 36µs making 1 call to Exporter::import |
| 77 | close $read; | ||||
| 78 | $write->autoflush(1); | ||||
| 79 | |||||
| 80 | # Intercept that input... | ||||
| 81 | while (1) { | ||||
| 82 | if (_input_pending_on(\*ARGV)) { | ||||
| 83 | # Read it... | ||||
| 84 | my $res = <ARGV>; | ||||
| 85 | |||||
| 86 | # Send it back to the parent... | ||||
| 87 | print {$write} $res; | ||||
| 88 | |||||
| 89 | # Admonish them for not waiting... | ||||
| 90 | print {*STDERR} "That input was ignored. ", | ||||
| 91 | "Please don't press any keys yet.\n"; | ||||
| 92 | } | ||||
| 93 | } | ||||
| 94 | exit; | ||||
| 95 | } | ||||
| 96 | |||||
| 97 | # Meanwhile, back in the parent... | ||||
| 98 | close $write; | ||||
| 99 | |||||
| 100 | # Temporarily close the input... | ||||
| 101 | local *ARGV; | ||||
| 102 | open *ARGV, '<', \""; | ||||
| 103 | |||||
| 104 | # Do the job... | ||||
| 105 | $block_ref->(); | ||||
| 106 | |||||
| 107 | # Take down the interceptor... | ||||
| 108 | kill 9, $child; | ||||
| 109 | wait; | ||||
| 110 | |||||
| 111 | # Return whatever the interceptor caught... | ||||
| 112 | return $read; | ||||
| 113 | } | ||||
| 114 | |||||
| 115 | 2 | 47µs | 2 | 128µs | # spent 70µs (13+57) within IO::Interactive::BEGIN@115 which was called:
# once (13µs+57µs) by Hailo::_is_interactive at line 115 # spent 70µs making 1 call to IO::Interactive::BEGIN@115
# spent 57µs making 1 call to Exporter::import |
| 116 | |||||
| 117 | sub import { | ||||
| 118 | my ($package) = shift; | ||||
| 119 | my $caller = caller; | ||||
| 120 | |||||
| 121 | # Export each sub if it's requested... | ||||
| 122 | for my $request ( @_ ) { | ||||
| 123 | 2 | 78µs | 2 | 52µs | # spent 31µs (11+21) within IO::Interactive::BEGIN@123 which was called:
# once (11µs+21µs) by Hailo::_is_interactive at line 123 # spent 31µs making 1 call to IO::Interactive::BEGIN@123
# spent 21µs making 1 call to strict::unimport |
| 124 | my $impl = *{$package.'::'.$request}{CODE}; | ||||
| 125 | croak "Unknown subroutine ($request()) requested" | ||||
| 126 | if !$impl || $request =~ m/\A _/xms; | ||||
| 127 | *{$caller.'::'.$request} = $impl; | ||||
| 128 | } | ||||
| 129 | } | ||||
| 130 | |||||
| 131 | |||||
| 132 | 1 | 5µs | 1; # Magic true value required at end of module | ||
| 133 | __END__ | ||||
sub IO::Interactive::CORE:fttty; # opcode | |||||
# spent 8µs within IO::Interactive::CORE:select which was called 3 times, avg 3µs/call:
# 3 times (8µs+0s) by IO::Interactive::is_interactive at line 11, avg 3µs/call |