← Index
NYTProf Performance Profile   « block view • line view • sub view »
For bin/hailo
  Run on Thu Oct 21 22:50:37 2010
Reported on Thu Oct 21 22:52:14 2010

Filename/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/site_perl/5.13.5/IO/Interactive.pm
StatementsExecuted 34 statements in 1.16ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1112.10ms4.15msIO::Interactive::::BEGIN@76IO::Interactive::BEGIN@76
111790µs1.25msIO::Interactive::::BEGIN@3IO::Interactive::BEGIN@3
31170µs184µsIO::Interactive::::is_interactiveIO::Interactive::is_interactive
11130µs30µsIO::Interactive::::BEGIN@37IO::Interactive::BEGIN@37
62128µs28µsIO::Interactive::::CORE:ftttyIO::Interactive::CORE:fttty (opcode)
11115µs92µsIO::Interactive::::BEGIN@7IO::Interactive::BEGIN@7
11115µs83µsIO::Interactive::::BEGIN@8IO::Interactive::BEGIN@8
11114µs35µsIO::Interactive::::BEGIN@5IO::Interactive::BEGIN@5
11113µs70µsIO::Interactive::::BEGIN@115IO::Interactive::BEGIN@115
11111µs16µsIO::Interactive::::BEGIN@6IO::Interactive::BEGIN@6
11111µs31µsIO::Interactive::::BEGIN@123IO::Interactive::BEGIN@123
3118µs8µsIO::Interactive::::CORE:selectIO::Interactive::CORE:select (opcode)
0000s0sIO::Interactive::::_input_pending_onIO::Interactive::_input_pending_on
0000s0sIO::Interactive::::busyIO::Interactive::busy
0000s0sIO::Interactive::::importIO::Interactive::import
0000s0sIO::Interactive::::interactiveIO::Interactive::interactive
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package IO::Interactive;
2
33181µs31.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
use version; $VERSION = qv('0.0.6');
# 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
5227µs256µ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
use warnings;
# spent 35µs making 1 call to IO::Interactive::BEGIN@5 # spent 21µs making 1 call to warnings::import
6225µs221µ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
use strict;
# spent 16µs making 1 call to IO::Interactive::BEGIN@6 # spent 5µs making 1 call to strict::import
7239µs2169µ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
use Carp;
# spent 92µs making 1 call to IO::Interactive::BEGIN@7 # spent 77µs making 1 call to Exporter::import
82126µs2151µ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
use Scalar::Util qw( openhandle );
# 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
sub is_interactive {
11325µs38µ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...
14336µs321µ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...
17316µs377µ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 {
31330µs37µs return -t *STDIN;
# spent 7µs making 3 calls to IO::Interactive::CORE:fttty, avg 2µs/call
32 }
33}
34
3513µslocal (*DEV_NULL, *DEV_NULL2);
3611µsmy $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
BEGIN {
38124µs pipe *DEV_NULL, *DEV_NULL2
39 or die "Internal error: can't create null filehandle";
4017µs $dev_null = \*DEV_NULL;
411145µs130µs}
# spent 30µs making 1 call to IO::Interactive::BEGIN@37
42
43sub interactive {
44 my ($out_handle) = (@_, \*STDOUT); # Default to STDOUT
45 return &is_interactive ? $out_handle : $dev_null;
46}
47
48sub _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
58sub 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...
762342µs24.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
use IO::Handle;
# 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
115247µs2128µ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
use Carp;
# spent 70µs making 1 call to IO::Interactive::BEGIN@115 # spent 57µs making 1 call to Exporter::import
116
117sub import {
118 my ($package) = shift;
119 my $caller = caller;
120
121 # Export each sub if it's requested...
122 for my $request ( @_ ) {
123278µs252µ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
no strict 'refs';
# 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
13215µs1; # Magic true value required at end of module
133__END__
 
# spent 28µs within IO::Interactive::CORE:fttty which was called 6 times, avg 5µs/call: # 3 times (21µs+0s) by IO::Interactive::is_interactive at line 14, avg 7µs/call # 3 times (7µs+0s) by IO::Interactive::is_interactive at line 31, avg 2µs/call
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
sub IO::Interactive::CORE:select; # opcode