← 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:06 2010

Filename/home/hinrik/perl5/perlbrew/perls/perl-5.13.5/lib/5.13.5/open.pm
StatementsExecuted 52 statements in 8.92ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1115.95ms6.04msopen::::BEGIN@2open::BEGIN@2
111754µs12.2msopen::::BEGIN@88open::BEGIN@88
111202µs12.8msopen::::importopen::import
33185µs194µsopen::::CORE:binmodeopen::CORE:binmode (opcode)
95137µs37µsopen::::CORE:matchopen::CORE:match (opcode)
22137µs53µsopen::::_drop_oldencopen::_drop_oldenc
22114µs14µsopen::::CORE:substopen::CORE:subst (opcode)
2118µs8µsopen::::CORE:substcontopen::CORE:substcont (opcode)
0000s0sopen::::_get_encnameopen::_get_encname
0000s0sopen::::croakopen::croak
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package open;
227.67ms26.07ms
# spent 6.04ms (5.95+89µs) within open::BEGIN@2 which was called: # once (5.95ms+89µs) by hailo::BEGIN@4 at line 2
use warnings;
# spent 6.04ms making 1 call to open::BEGIN@2 # spent 29µs making 1 call to warnings::import
3
4122µs112.2msour $VERSION = '1.08';
# spent 12.2ms making 1 call to open::BEGIN@88
5
6154µsrequire 5.008001; # for PerlIO::get_layers()
7
812µsmy $locale_encoding;
9
10sub _get_encname {
11 return ($1, Encode::resolve_alias($1)) if $_[0] =~ /^:?encoding\((.+)\)$/;
12 return;
13}
14
15sub croak {
16 require Carp; goto &Carp::croak;
17}
18
19
# spent 53µs (37+16) within open::_drop_oldenc which was called 2 times, avg 26µs/call: # once (22µs+11µs) by open::import at line 106 # once (15µs+5µs) by open::import at line 107
sub _drop_oldenc {
20 # If by the time we arrive here there already is at the top of the
21 # perlio layer stack an encoding identical to what we would like
22 # to push via this open pragma, we will pop away the old encoding
23 # (+utf8) so that we can push ourselves in place (this is easier
24 # than ignoring pushing ourselves because of the way how ${^OPEN}
25 # works). So we are looking for something like
26 #
27 # stdio encoding(xxx) utf8
28 #
29 # in the existing layer stack, and in the new stack chunk for
30 #
31 # :encoding(xxx)
32 #
33 # If we find a match, we pop the old stack (once, since
34 # the utf8 is just a flag on the encoding layer)
35854µs my ($h, @new) = @_;
3626µs return unless @new >= 1 && $new[-1] =~ /^:encoding\(.+\)$/;
# spent 6µs making 2 calls to open::CORE:match, avg 3µs/call
37210µs my @old = PerlIO::get_layers($h);
# spent 10µs making 2 calls to PerlIO::get_layers, avg 5µs/call
38 return unless @old >= 3 &&
39 $old[-1] eq 'utf8' &&
40 $old[-2] =~ /^encoding\(.+\)$/;
41 require Encode;
42 my ($loname, $lcname) = _get_encname($old[-2]);
43 unless (defined $lcname) { # Should we trust get_layers()?
44 croak("open: Unknown encoding '$loname'");
45 }
46 my ($voname, $vcname) = _get_encname($new[-1]);
47 unless (defined $vcname) {
48 croak("open: Unknown encoding '$voname'");
49 }
50 if ($lcname eq $vcname) {
51 binmode($h, ":pop"); # utf8 is part of the encoding layer
52 }
53}
54
55
# spent 12.8ms (202µs+12.6) within open::import which was called: # once (202µs+12.6ms) by hailo::BEGIN@4 at line 4 of bin/hailo
sub import {
56732µs my ($class,@args) = @_;
57 croak("open: needs explicit list of PerlIO layers") unless @args;
58 my $std;
59 my ($in,$out) = split(/\0/,(${^OPEN} || "\0"), -1);
60 while (@args) {
61959µs my $type = shift(@args);
62 my $dscp;
63412µs215µs if ($type =~ /^:?(utf8|locale|encoding\(.+\))$/) {
# spent 15µs making 2 calls to open::CORE:match, avg 8µs/call
64 $type = 'IO';
65 $dscp = ":$1";
66 } elsif ($type eq ':std') {
67 $std = 1;
68 next;
69 } else {
70 $dscp = shift(@args) || '';
71 }
72 my @val;
73 foreach my $layer (split(/\s+/,$dscp)) {
74437µs16µs $layer =~ s/^://;
# spent 6µs making 1 call to open::CORE:subst
75398µs if ($layer eq 'locale') {
76 require Encode;
77 require encoding;
78 $locale_encoding = encoding::_get_locale_encoding()
79 unless defined $locale_encoding;
80 (warnings::warnif("layer", "Cannot figure out an encoding to use"), last)
81 unless defined $locale_encoding;
82 $layer = "encoding($locale_encoding)";
83 $std = 1;
84 } else {
85 my $target = $layer; # the layer name itself
86317µs $target =~ s/^(\w+)\(.+\)$/$1/; # strip parameters
# spent 8µs making 2 calls to open::CORE:substcont, avg 4µs/call # spent 8µs making 1 call to open::CORE:subst
87
882733µs223.7ms
# spent 12.2ms (754µs+11.4) within open::BEGIN@88 which was called: # once (754µs+11.4ms) by PerlIO::Layer::find at line 4
unless(PerlIO::Layer::->find($target,1)) {
# spent 12.3ms making 1 call to PerlIO::Layer::find # spent 11.4ms making 1 call to PerlIO::import
89 warnings::warnif("layer", "Unknown PerlIO layer '$target'");
90 }
91 }
92 push(@val,":$layer");
9316µs if ($layer =~ /^(crlf|raw)$/) {
# spent 6µs making 1 call to open::CORE:match
94 $^H{"open_$type"} = $layer;
95 }
96 }
97313µs if ($type eq 'IN') {
98 _drop_oldenc(*STDIN, @val);
99 $in = join(' ', @val);
100 }
101 elsif ($type eq 'OUT') {
102 _drop_oldenc(*STDOUT, @val);
103 $out = join(' ', @val);
104 }
105 elsif ($type eq 'IO') {
106133µs _drop_oldenc(*STDIN, @val);
# spent 33µs making 1 call to open::_drop_oldenc
107120µs _drop_oldenc(*STDOUT, @val);
# spent 20µs making 1 call to open::_drop_oldenc
108 $in = $out = join(' ', @val);
109 }
110 else {
111 croak "Unknown PerlIO layer class '$type' (need IN, OUT or IO)";
112 }
113 }
114 ${^OPEN} = join("\0", $in, $out);
11525µs if ($std) {
116140µs if ($in) {
117122µs6139µs if ($in =~ /:utf8\b/) {
# spent 89µs making 1 call to open::CORE:binmode # spent 22µs making 1 call to Encode::find_encoding # spent 19µs making 1 call to Encode::Encoding::renew # spent 6µs making 2 calls to open::CORE:match, avg 3µs/call # spent 3µs making 1 call to Encode::Encoding::needs_lines
118 binmode(STDIN, ":utf8");
119 } elsif ($in =~ /(\w+\(.+\))/) {
120 binmode(STDIN, ":$1");
121 }
122 }
123112µs if ($out) {
124217µs24µs if ($out =~ /:utf8\b/) {
# spent 4µs making 2 calls to open::CORE:match, avg 2µs/call
125 binmode(STDOUT, ":utf8");
126 binmode(STDERR, ":utf8");
127 } elsif ($out =~ /(\w+\(.+\))/) {
128113µs487µs binmode(STDOUT, ":$1");
# spent 54µs making 1 call to open::CORE:binmode # spent 15µs making 1 call to Encode::find_encoding # spent 15µs making 1 call to Encode::Encoding::renew # spent 3µs making 1 call to Encode::Encoding::needs_lines
129112µs482µs binmode(STDERR, ":$1");
# spent 50µs making 1 call to open::CORE:binmode # spent 15µs making 1 call to Encode::Encoding::renew # spent 14µs making 1 call to Encode::find_encoding # spent 3µs making 1 call to Encode::Encoding::needs_lines
130 }
131 }
132 }
133}
134
135110µs1;
136__END__
 
# spent 194µs (85+109) within open::CORE:binmode which was called 3 times, avg 65µs/call: # once (45µs+44µs) by open::import at line 117 # once (21µs+33µs) by open::import at line 128 # once (19µs+31µs) by open::import at line 129
sub open::CORE:binmode; # opcode
# spent 37µs within open::CORE:match which was called 9 times, avg 4µs/call: # 2 times (15µs+0s) by open::import at line 63, avg 8µs/call # 2 times (6µs+0s) by open::_drop_oldenc at line 36, avg 3µs/call # 2 times (6µs+0s) by open::import at line 117, avg 3µs/call # 2 times (4µs+0s) by open::import at line 124, avg 2µs/call # once (6µs+0s) by open::import at line 93
sub open::CORE:match; # opcode
# spent 14µs within open::CORE:subst which was called 2 times, avg 7µs/call: # once (8µs+0s) by open::import at line 86 # once (6µs+0s) by open::import at line 74
sub open::CORE:subst; # opcode
# spent 8µs within open::CORE:substcont which was called 2 times, avg 4µs/call: # 2 times (8µs+0s) by open::import at line 86, avg 4µs/call
sub open::CORE:substcont; # opcode