Profile of Class/Struct.pm

← 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
Statements | Executed 362 statements in 1.31ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 753µs | 800µs | Class::Struct::::struct Class::Struct::struct
1 | 1 | 1 | 14µs | 14µs | Class::Struct::::BEGIN@5 Class::Struct::BEGIN@5
1 | 1 | 1 | 12µs | 5.36ms | Class::Struct::::import Class::Struct::import
1 | 1 | 1 | 11µs | 19µs | Class::Struct::::BEGIN@96 Class::Struct::BEGIN@96
1 | 1 | 1 | 8µs | 15µs | Class::Struct::::BEGIN@189 Class::Struct::BEGIN@189
1 | 1 | 1 | 6µs | 40µs | Class::Struct::::BEGIN@11 Class::Struct::BEGIN@11
1 | 1 | 1 | 6µs | 73µs | Class::Struct::::BEGIN@8 Class::Struct::BEGIN@8
1 | 1 | 1 | 5µs | 12µs | Class::Struct::::BEGIN@105 Class::Struct::BEGIN@105
1 | 1 | 1 | 5µs | 14µs | Class::Struct::::BEGIN@7 Class::Struct::BEGIN@7
1 | 1 | 1 | 3µs | 3µs | Class::Struct::Tie_ISA::::TIEARRAYClass::Struct::Tie_ISA::TIEARRAY
13 | 1 | 1 | 2µs | 2µs | Class::Struct::::CORE:match Class::Struct::CORE:match (opcode)
0 | 0 | 0 | 0s | 0s | Class::Struct::Tie_ISA::::DESTROYClass::Struct::Tie_ISA::DESTROY
0 | 0 | 0 | 0s | 0s | Class::Struct::Tie_ISA::::FETCHClass::Struct::Tie_ISA::FETCH
0 | 0 | 0 | 0s | 0s | Class::Struct::Tie_ISA::::FETCHSIZEClass::Struct::Tie_ISA::FETCHSIZE
0 | 0 | 0 | 0s | 0s | Class::Struct::Tie_ISA::::STOREClass::Struct::Tie_ISA::STORE
0 | 0 | 0 | 0s | 0s | Class::Struct::::_subclass_error Class::Struct::_subclass_error
0 | 0 | 0 | 0s | 0s | Class::Struct::::_usage_error Class::Struct::_usage_error
0 | 0 | 0 | 0s | 0s | Class::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
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package Class::Struct;
2 |  |  |  |  |
3 |  |  |  |  | ## See POD after __END__
4 |  |  |  |  |
5 | 2 | 42µs | 1 | 14µ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 |  |  |  |  |
7 | 2 | 18µs | 2 | 23µ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
8 | 2 | 33µs | 2 | 140µ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
9 | 1 | 400ns |  |  | our(@ISA, @EXPORT, $VERSION);
10 |  |  |  |  |
11 | 2 | 298µs | 2 | 74µ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 |  |  |  |  |
13 | 1 | 400ns |  |  | require Exporter;
14 | 1 | 5µs |  |  | @ISA = qw(Exporter);
15 | 1 | 400ns |  |  | @EXPORT = qw(struct);
16 |  |  |  |  |
17 | 1 | 200ns |  |  | $VERSION = '0.64';
18 |  |  |  |  |
19 | 1 | 200ns |  |  | my $print = 0;
20 |  |  |  |  | sub printem {
21 |  |  |  |  | if (@_) { $print = shift }
22 |  |  |  |  | else { $print++ }
23 |  |  |  |  | }
24 |  |  |  |  |
25 |  |  |  |  | {
26 | 1 | 500ns |  |  | 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 {
29 | 1 | 400ns |  |  | my $class = shift;
30 | 1 | 5µ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 {
52 | 1 | 300ns |  |  | my $self = shift;
53 |  |  |  |  |
54 | 1 | 7µs | 1 | 5.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 |  |  |  |  |
73 | 1 | 100ns |  |  | my ($class, @decls);
74 | 1 | 600ns |  |  | my $base_type = ref $_[1];
75 | 1 | 1µs |  |  | if ( $base_type eq 'HASH' ) {
76 |  |  |  |  | $class = shift;
77 |  |  |  |  | @decls = %{shift()};
78 |  |  |  |  | _usage_error() if @_;
79 |  |  |  |  | }
80 |  |  |  |  | elsif ( $base_type eq 'ARRAY' ) {
81 | 1 | 300ns |  |  | $class = shift;
82 | 1 | 4µs |  |  | @decls = @{shift()};
83 | 1 | 700ns |  |  | _usage_error() if @_;
84 |  |  |  |  | }
85 |  |  |  |  | else {
86 |  |  |  |  | $base_type = 'ARRAY';
87 |  |  |  |  | $class = (caller())[0];
88 |  |  |  |  | @decls = @_;
89 |  |  |  |  | }
90 |  |  |  |  |
91 | 1 | 900ns |  |  | _usage_error() if @decls % 2 == 1;
92 |  |  |  |  |
93 |  |  |  |  | # Ensure we are not, and will not be, a subclass.
94 |  |  |  |  |
95 | 1 | 400ns |  |  | my $isa = do {
96 | 2 | 47µs | 2 | 27µ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
97 | 1 | 2µs |  |  | \@{$class . '::ISA'};
98 |  |  |  |  | };
99 | 1 | 400ns |  |  | _subclass_error() if @$isa;
100 | 1 | 4µs | 1 | 3µ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"
105 | 4 | 348µs | 2 | 20µ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 |  |  |  |  |
107 | 1 | 400ns |  |  | my @methods = ();
108 | 1 | 300ns |  |  | my %refs = ();
109 | 1 | 100ns |  |  | my %arrays = ();
110 | 1 | 200ns |  |  | my %hashes = ();
111 | 1 | 100ns |  |  | my %classes = ();
112 | 1 | 200ns |  |  | my $got_class = 0;
113 | 1 | 300ns |  |  | my $out = '';
114 |  |  |  |  |
115 | 1 | 1µs |  |  | $out = "{\n package $class;\n use Carp;\n sub new {\n";
116 | 1 | 300ns |  |  | $out .= " my (\$class, \%init) = \@_;\n";
117 | 1 | 200ns |  |  | $out .= " \$class = __PACKAGE__ unless \@_;\n";
118 |  |  |  |  |
119 | 1 | 100ns |  |  | my $cnt = 0;
120 | 1 | 300ns |  |  | my $idx = 0;
121 | 1 | 100ns |  |  | my( $cmt, $name, $type, $elem );
122 |  |  |  |  |
123 | 1 | 500ns |  |  | 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 |  |  |  |  |
131 | 1 | 100ns |  |  | $out .= " bless \$r, \$class;\n\n";
132 |  |  |  |  |
133 | 1 | 500ns |  |  | while( $idx < @decls ){
134 | 13 | 2µs |  |  | $name = $decls[$idx];
135 | 13 | 3µs |  |  | $type = $decls[$idx+1];
136 | 13 | 5µs |  |  | push( @methods, $name );
137 | 13 | 3µs |  |  | if( $base_type eq 'HASH' ){
138 |  |  |  |  | $elem = "{'${class}::$name'}";
139 |  |  |  |  | }
140 |  |  |  |  | elsif( $base_type eq 'ARRAY' ){
141 | 13 | 4µs |  |  | $elem = "[$cnt]";
142 | 13 | 1µs |  |  | ++$cnt;
143 | 13 | 3µs |  |  | $cmt = " # $name";
144 |  |  |  |  | }
145 | 13 | 17µs | 13 | 2µs | if( $type =~ /^\*(.)/ ){ # spent 2µs making 13 calls to Class::Struct::CORE:match, avg 123ns/call
146 |  |  |  |  | $refs{$name}++;
147 |  |  |  |  | $type = $1;
148 |  |  |  |  | }
149 | 13 | 5µs |  |  | my $init = "defined(\$init{'$name'}) ? \$init{'$name'} :";
150 | 13 | 13µ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 |  |  |  |  | }
179 | 13 | 5µs |  |  | $idx += 2;
180 |  |  |  |  | }
181 |  |  |  |  |
182 | 1 | 200ns |  |  | $out .= "\n \$r;\n}\n";
183 |  |  |  |  |
184 |  |  |  |  | # Create accessor methods.
185 |  |  |  |  |
186 | 1 | 100ns |  |  | my( $pre, $pst, $sel );
187 | 1 | 200ns |  |  | $cnt = 0;
188 | 1 | 400ns |  |  | foreach $name (@methods){
189 | 28 | 329µs | 2 | 23µ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 {
193 | 13 | 3µs |  |  | $pre = $pst = $cmt = $sel = '';
194 | 13 | 2µs |  |  | if( defined $refs{$name} ){
195 |  |  |  |  | $pre = "\\(";
196 |  |  |  |  | $pst = ")";
197 |  |  |  |  | $cmt = " # returns ref";
198 |  |  |  |  | }
199 | 13 | 6µs |  |  | $out .= " sub $name {$cmt\n my \$r = shift;\n";
200 | 13 | 4µs |  |  | if( $base_type eq 'ARRAY' ){
201 | 13 | 3µs |  |  | $elem = "[$cnt]";
202 | 13 | 2µs |  |  | ++$cnt;
203 |  |  |  |  | }
204 |  |  |  |  | elsif( $base_type eq 'HASH' ){
205 |  |  |  |  | $elem = "{'${class}::$name'}";
206 |  |  |  |  | }
207 | 13 | 2µ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 |  |  |  |  | }
222 | 13 | 3µs |  |  | $out .= " croak 'Too many args to $name' if \@_ > 1;\n";
223 | 13 | 8µs |  |  | $out .= " \@_ ? ($pre\$r->$elem$sel = shift$pst) : $pre\$r->$elem$sel$pst;\n";
224 | 13 | 1µs |  |  | $out .= " }\n";
225 |  |  |  |  | }
226 |  |  |  |  | }
227 | 1 | 100ns |  |  | $out .= "}\n1;\n";
228 |  |  |  |  |
229 | 1 | 100ns |  |  | print $out if $print;
230 | 1 | 49µ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.
231 | 1 | 7µs |  |  | carp $@ if $@;
232 |  |  |  |  | }
233 |  |  |  |  |
234 |  |  |  |  | sub _usage_error {
235 |  |  |  |  | confess "struct usage error";
236 |  |  |  |  | }
237 |  |  |  |  |
238 |  |  |  |  | sub _subclass_error {
239 |  |  |  |  | croak 'struct class cannot be a subclass (@ISA not allowed)';
240 |  |  |  |  | }
241 |  |  |  |  |
242 | 1 | 4µs |  |  | 1; # 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