← Index
NYTProf Performance Profile   « line view »
For script/ponapi
  Run on Wed Feb 10 15:51:26 2016
Reported on Thu Feb 11 09:43:09 2016

Filename/usr/share/perl/5.18/Class/Struct.pm
StatementsExecuted 362 statements in 1.31ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111753µs800µsClass::Struct::::struct Class::Struct::struct
11114µs14µsClass::Struct::::BEGIN@5 Class::Struct::BEGIN@5
11112µs5.36msClass::Struct::::import Class::Struct::import
11111µs19µsClass::Struct::::BEGIN@96 Class::Struct::BEGIN@96
1118µs15µsClass::Struct::::BEGIN@189 Class::Struct::BEGIN@189
1116µs40µsClass::Struct::::BEGIN@11 Class::Struct::BEGIN@11
1116µs73µsClass::Struct::::BEGIN@8 Class::Struct::BEGIN@8
1115µs12µsClass::Struct::::BEGIN@105 Class::Struct::BEGIN@105
1115µs14µsClass::Struct::::BEGIN@7 Class::Struct::BEGIN@7
1113µs3µsClass::Struct::Tie_ISA::::TIEARRAYClass::Struct::Tie_ISA::TIEARRAY
13112µs2µsClass::Struct::::CORE:match Class::Struct::CORE:match (opcode)
0000s0sClass::Struct::Tie_ISA::::DESTROYClass::Struct::Tie_ISA::DESTROY
0000s0sClass::Struct::Tie_ISA::::FETCHClass::Struct::Tie_ISA::FETCH
0000s0sClass::Struct::Tie_ISA::::FETCHSIZEClass::Struct::Tie_ISA::FETCHSIZE
0000s0sClass::Struct::Tie_ISA::::STOREClass::Struct::Tie_ISA::STORE
0000s0sClass::Struct::::_subclass_error Class::Struct::_subclass_error
0000s0sClass::Struct::::_usage_error Class::Struct::_usage_error
0000s0sClass::Struct::::printem Class::Struct::printem
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Class::Struct;
2
3## See POD after __END__
4
5242µs114µs
# spent 14µs within Class::Struct::BEGIN@5 which was called: # once (14µs+0s) by File::stat::BEGIN@184 at line 5
use 5.006_001;
# spent 14µs making 1 call to Class::Struct::BEGIN@5
6
7218µs223µs
# spent 14µs (5+9) within Class::Struct::BEGIN@7 which was called: # once (5µs+9µs) by File::stat::BEGIN@184 at line 7
use strict;
# spent 14µs making 1 call to Class::Struct::BEGIN@7 # spent 9µs making 1 call to strict::import
8233µs2140µs
# spent 73µs (6+67) within Class::Struct::BEGIN@8 which was called: # once (6µs+67µs) by File::stat::BEGIN@184 at line 8
use warnings::register;
# spent 73µs making 1 call to Class::Struct::BEGIN@8 # spent 67µs making 1 call to warnings::register::import
91400nsour(@ISA, @EXPORT, $VERSION);
10
112298µs274µs
# spent 40µs (6+34) within Class::Struct::BEGIN@11 which was called: # once (6µs+34µs) by File::stat::BEGIN@184 at line 11
use Carp;
# spent 40µs making 1 call to Class::Struct::BEGIN@11 # spent 34µs making 1 call to Exporter::import
12
131400nsrequire Exporter;
1415µs@ISA = qw(Exporter);
151400ns@EXPORT = qw(struct);
16
171200ns$VERSION = '0.64';
18
191200nsmy $print = 0;
20sub printem {
21 if (@_) { $print = shift }
22 else { $print++ }
23}
24
25{
261500ns package Class::Struct::Tie_ISA;
27
28
# spent 3µs within Class::Struct::Tie_ISA::TIEARRAY which was called: # once (3µs+0s) by Class::Struct::struct at line 100
sub TIEARRAY {
291400ns my $class = shift;
3015µs return bless [], $class;
31 }
32
33 sub STORE {
34 my ($self, $index, $value) = @_;
35 Class::Struct::_subclass_error();
36 }
37
38 sub FETCH {
39 my ($self, $index) = @_;
40 $self->[$index];
41 }
42
43 sub FETCHSIZE {
44 my $self = shift;
45 return scalar(@$self);
46 }
47
48 sub DESTROY { }
49}
50
51
# spent 5.36ms (12µs+5.35) within Class::Struct::import which was called: # once (12µs+5.35ms) by File::stat::BEGIN@184 at line 184 of File/stat.pm
sub import {
521300ns my $self = shift;
53
5417µs15.27ms if ( @_ == 0 ) {
# spent 5.27ms making 1 call to Exporter::export_to_level
55 $self->export_to_level( 1, $self, @EXPORT );
56 } elsif ( @_ == 1 ) {
57 # This is admittedly a little bit silly:
58 # do we ever export anything else than 'struct'...?
59 $self->export_to_level( 1, $self, @_ );
60 } else {
61 goto &struct;
62 }
63}
64
65
# spent 800µs (753+47) within Class::Struct::struct which was called: # once (753µs+47µs) by Path::Class::Entity::BEGIN@9 at line 186 of File/stat.pm
sub struct {
66
67 # Determine parameter list structure, one of:
68 # struct( class => [ element-list ])
69 # struct( class => { element-list })
70 # struct( element-list )
71 # Latter form assumes current package name as struct name.
72
731100ns my ($class, @decls);
741600ns my $base_type = ref $_[1];
7511µs if ( $base_type eq 'HASH' ) {
76 $class = shift;
77 @decls = %{shift()};
78 _usage_error() if @_;
79 }
80 elsif ( $base_type eq 'ARRAY' ) {
811300ns $class = shift;
8214µs @decls = @{shift()};
831700ns _usage_error() if @_;
84 }
85 else {
86 $base_type = 'ARRAY';
87 $class = (caller())[0];
88 @decls = @_;
89 }
90
911900ns _usage_error() if @decls % 2 == 1;
92
93 # Ensure we are not, and will not be, a subclass.
94
951400ns my $isa = do {
96247µs227µs
# spent 19µs (11+8) within Class::Struct::BEGIN@96 which was called: # once (11µs+8µs) by File::stat::BEGIN@184 at line 96
no strict 'refs';
# spent 19µs making 1 call to Class::Struct::BEGIN@96 # spent 8µs making 1 call to strict::unimport
9712µs \@{$class . '::ISA'};
98 };
991400ns _subclass_error() if @$isa;
10014µs13µs tie @$isa, 'Class::Struct::Tie_ISA';
# spent 3µs making 1 call to Class::Struct::Tie_ISA::TIEARRAY
101
102 # Create constructor.
103
104 croak "function 'new' already defined in package $class"
1054348µs220µs
# spent 12µs (5+7) within Class::Struct::BEGIN@105 which was called: # once (5µs+7µs) by File::stat::BEGIN@184 at line 105
if do { no strict 'refs'; defined &{$class . "::new"} };
# spent 12µs making 1 call to Class::Struct::BEGIN@105 # spent 7µs making 1 call to strict::unimport
106
1071400ns my @methods = ();
1081300ns my %refs = ();
1091100ns my %arrays = ();
1101200ns my %hashes = ();
1111100ns my %classes = ();
1121200ns my $got_class = 0;
1131300ns my $out = '';
114
11511µs $out = "{\n package $class;\n use Carp;\n sub new {\n";
1161300ns $out .= " my (\$class, \%init) = \@_;\n";
1171200ns $out .= " \$class = __PACKAGE__ unless \@_;\n";
118
1191100ns my $cnt = 0;
1201300ns my $idx = 0;
1211100ns my( $cmt, $name, $type, $elem );
122
1231500ns if( $base_type eq 'HASH' ){
124 $out .= " my(\$r) = {};\n";
125 $cmt = '';
126 }
127 elsif( $base_type eq 'ARRAY' ){
128 $out .= " my(\$r) = [];\n";
129 }
130
1311100ns $out .= " bless \$r, \$class;\n\n";
132
1331500ns while( $idx < @decls ){
134132µs $name = $decls[$idx];
135133µs $type = $decls[$idx+1];
136135µs push( @methods, $name );
137133µs if( $base_type eq 'HASH' ){
138 $elem = "{'${class}::$name'}";
139 }
140 elsif( $base_type eq 'ARRAY' ){
141134µs $elem = "[$cnt]";
142131µs ++$cnt;
143133µs $cmt = " # $name";
144 }
1451317µs132µs if( $type =~ /^\*(.)/ ){
# spent 2µs making 13 calls to Class::Struct::CORE:match, avg 123ns/call
146 $refs{$name}++;
147 $type = $1;
148 }
149135µs my $init = "defined(\$init{'$name'}) ? \$init{'$name'} :";
1501313µs if( $type eq '@' ){
151 $out .= " croak 'Initializer for $name must be array reference'\n";
152 $out .= " if defined(\$init{'$name'}) && ref(\$init{'$name'}) ne 'ARRAY';\n";
153 $out .= " \$r->$name( $init [] );$cmt\n";
154 $arrays{$name}++;
155 }
156 elsif( $type eq '%' ){
157 $out .= " croak 'Initializer for $name must be hash reference'\n";
158 $out .= " if defined(\$init{'$name'}) && ref(\$init{'$name'}) ne 'HASH';\n";
159 $out .= " \$r->$name( $init {} );$cmt\n";
160 $hashes{$name}++;
161 }
162 elsif ( $type eq '$') {
163 $out .= " \$r->$name( $init undef );$cmt\n";
164 }
165 elsif( $type =~ /^\w+(?:::\w+)*$/ ){
166 $out .= " if (defined(\$init{'$name'})) {\n";
167 $out .= " if (ref \$init{'$name'} eq 'HASH')\n";
168 $out .= " { \$r->$name( $type->new(\%{\$init{'$name'}}) ) } $cmt\n";
169 $out .= " elsif (UNIVERSAL::isa(\$init{'$name'}, '$type'))\n";
170 $out .= " { \$r->$name( \$init{'$name'} ) } $cmt\n";
171 $out .= " else { croak 'Initializer for $name must be hash or $type reference' }\n";
172 $out .= " }\n";
173 $classes{$name} = $type;
174 $got_class = 1;
175 }
176 else{
177 croak "'$type' is not a valid struct element type";
178 }
179135µs $idx += 2;
180 }
181
1821200ns $out .= "\n \$r;\n}\n";
183
184 # Create accessor methods.
185
1861100ns my( $pre, $pst, $sel );
1871200ns $cnt = 0;
1881400ns foreach $name (@methods){
18928329µs223µs
# spent 15µs (8+8) within Class::Struct::BEGIN@189 which was called: # once (8µs+8µs) by File::stat::BEGIN@184 at line 189
if ( do { no strict 'refs'; defined &{$class . "::$name"} } ) {
# spent 15µs making 1 call to Class::Struct::BEGIN@189 # spent 8µs making 1 call to strict::unimport
190 warnings::warnif("function '$name' already defined, overrides struct accessor method");
191 }
192 else {
193133µs $pre = $pst = $cmt = $sel = '';
194132µs if( defined $refs{$name} ){
195 $pre = "\\(";
196 $pst = ")";
197 $cmt = " # returns ref";
198 }
199136µs $out .= " sub $name {$cmt\n my \$r = shift;\n";
200134µs if( $base_type eq 'ARRAY' ){
201133µs $elem = "[$cnt]";
202132µs ++$cnt;
203 }
204 elsif( $base_type eq 'HASH' ){
205 $elem = "{'${class}::$name'}";
206 }
207132µs if( defined $arrays{$name} ){
208 $out .= " my \$i;\n";
209 $out .= " \@_ ? (\$i = shift) : return \$r->$elem;\n";
210 $out .= " if (ref(\$i) eq 'ARRAY' && !\@_) { \$r->$elem = \$i; return \$r }\n";
211 $sel = "->[\$i]";
212 }
213 elsif( defined $hashes{$name} ){
214 $out .= " my \$i;\n";
215 $out .= " \@_ ? (\$i = shift) : return \$r->$elem;\n";
216 $out .= " if (ref(\$i) eq 'HASH' && !\@_) { \$r->$elem = \$i; return \$r }\n";
217 $sel = "->{\$i}";
218 }
219 elsif( defined $classes{$name} ){
220 $out .= " croak '$name argument is wrong class' if \@_ && ! UNIVERSAL::isa(\$_[0], '$classes{$name}');\n";
221 }
222133µs $out .= " croak 'Too many args to $name' if \@_ > 1;\n";
223138µs $out .= " \@_ ? ($pre\$r->$elem$sel = shift$pst) : $pre\$r->$elem$sel$pst;\n";
224131µs $out .= " }\n";
225 }
226 }
2271100ns $out .= "}\n1;\n";
228
2291100ns print $out if $print;
230149µs my $result = eval $out;
# spent 565µs executing statements in string eval
# includes 10µs spent executing 1 call to 15 subs defined therein.
23117µs carp $@ if $@;
232}
233
234sub _usage_error {
235 confess "struct usage error";
236}
237
238sub _subclass_error {
239 croak 'struct class cannot be a subclass (@ISA not allowed)';
240}
241
24214µs1; # for require
243
244
245__END__
 
# spent 2µs within Class::Struct::CORE:match which was called 13 times, avg 123ns/call: # 13 times (2µs+0s) by Class::Struct::struct at line 145, avg 123ns/call
sub Class::Struct::CORE:match; # opcode