← Index
NYTProf Performance Profile   « block view • line view • sub view »
For C:/lo/libo-master/solenv/bin/make_installer.pl
  Run on Mon Sep 24 00:52:54 2012
Reported on Mon Sep 24 07:34:50 2012

Filename/usr/lib/perl5/5.14/Class/Struct.pm
StatementsExecuted 362 statements in 3.57ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1111.66ms1.77msClass::Struct::::struct Class::Struct::struct
111308µs308µsClass::Struct::::BEGIN@5 Class::Struct::BEGIN@5
11123µs248µsClass::Struct::::import Class::Struct::import
11115µs20µsClass::Struct::::BEGIN@7 Class::Struct::BEGIN@7
11115µs83µsClass::Struct::::BEGIN@11 Class::Struct::BEGIN@11
11114µs32µsClass::Struct::::BEGIN@99 Class::Struct::BEGIN@99
11113µs31µsClass::Struct::::BEGIN@188 Class::Struct::BEGIN@188
11112µs200µsClass::Struct::::BEGIN@8 Class::Struct::BEGIN@8
11112µs28µsClass::Struct::::BEGIN@108 Class::Struct::BEGIN@108
11111µs11µsClass::Struct::Tie_ISA::::TIEARRAYClass::Struct::Tie_ISA::TIEARRAY
13115µs5µ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
52235µs1308µs
# spent 308µs within Class::Struct::BEGIN@5 which was called: # once (308µs+0s) by File::stat::BEGIN@173 at line 5
use 5.006_001;
# spent 308µs making 1 call to Class::Struct::BEGIN@5
6
7252µs225µs
# spent 20µs (15+5) within Class::Struct::BEGIN@7 which was called: # once (15µs+5µs) by File::stat::BEGIN@173 at line 7
use strict;
# spent 20µs making 1 call to Class::Struct::BEGIN@7 # spent 5µs making 1 call to strict::import
8285µs2387µs
# spent 200µs (12+187) within Class::Struct::BEGIN@8 which was called: # once (12µs+187µs) by File::stat::BEGIN@173 at line 8
use warnings::register;
# spent 200µs making 1 call to Class::Struct::BEGIN@8 # spent 187µs making 1 call to warnings::register::import
912µsour(@ISA, @EXPORT, $VERSION);
10
112697µs2152µs
# spent 83µs (15+68) within Class::Struct::BEGIN@11 which was called: # once (15µs+68µs) by File::stat::BEGIN@173 at line 11
use Carp;
# spent 83µs making 1 call to Class::Struct::BEGIN@11 # spent 68µs making 1 call to Exporter::import
12
1312µsrequire Exporter;
14115µs@ISA = qw(Exporter);
1512µs@EXPORT = qw(struct);
16
1711µs$VERSION = '0.63';
18
19## Tested on 5.002 and 5.003 without class membership tests:
2014µsmy $CHECK_CLASS_MEMBERSHIP = ($] >= 5.003_95);
21
221500nsmy $print = 0;
23sub printem {
24 if (@_) { $print = shift }
25 else { $print++ }
26}
27
28{
2912µs package Class::Struct::Tie_ISA;
30
31
# spent 11µs within Class::Struct::Tie_ISA::TIEARRAY which was called: # once (11µs+0s) by Class::Struct::struct at line 103
sub TIEARRAY {
3211µs my $class = shift;
33115µs return bless [], $class;
34 }
35
36 sub STORE {
37 my ($self, $index, $value) = @_;
38 Class::Struct::_subclass_error();
39 }
40
41 sub FETCH {
42 my ($self, $index) = @_;
43 $self->[$index];
44 }
45
46 sub FETCHSIZE {
47 my $self = shift;
48 return scalar(@$self);
49 }
50
51 sub DESTROY { }
52}
53
54
# spent 248µs (23+225) within Class::Struct::import which was called: # once (23µs+225µs) by File::stat::BEGIN@173 at line 173 of File/stat.pm
sub import {
5512µs my $self = shift;
56
57115µs151µs if ( @_ == 0 ) {
# spent 51µs making 1 call to Exporter::export_to_level
58 $self->export_to_level( 1, $self, @EXPORT );
59 } elsif ( @_ == 1 ) {
60 # This is admittedly a little bit silly:
61 # do we ever export anything else than 'struct'...?
62 $self->export_to_level( 1, $self, @_ );
63 } else {
64 goto &struct;
65 }
66}
67
68
# spent 1.77ms (1.66+106µs) within Class::Struct::struct which was called: # once (1.66ms+106µs) by installer::worker::BEGIN@32 at line 175 of File/stat.pm
sub struct {
69
70 # Determine parameter list structure, one of:
71 # struct( class => [ element-list ])
72 # struct( class => { element-list })
73 # struct( element-list )
74 # Latter form assumes current package name as struct name.
75
7611µs my ($class, @decls);
7712µs my $base_type = ref $_[1];
7812µs if ( $base_type eq 'HASH' ) {
79 $class = shift;
80 @decls = %{shift()};
81 _usage_error() if @_;
82 }
83 elsif ( $base_type eq 'ARRAY' ) {
8411µs $class = shift;
85113µs @decls = @{shift()};
861500ns _usage_error() if @_;
87 }
88 else {
89 $base_type = 'ARRAY';
90 $class = (caller())[0];
91 @decls = @_;
92 }
93
9412µs _usage_error() if @decls % 2 == 1;
95
96 # Ensure we are not, and will not be, a subclass.
97
9811µs my $isa = do {
992124µs250µs
# spent 32µs (14+18) within Class::Struct::BEGIN@99 which was called: # once (14µs+18µs) by File::stat::BEGIN@173 at line 99
no strict 'refs';
# spent 32µs making 1 call to Class::Struct::BEGIN@99 # spent 18µs making 1 call to strict::unimport
10016µs \@{$class . '::ISA'};
101 };
10211µs _subclass_error() if @$isa;
10317µs111µs tie @$isa, 'Class::Struct::Tie_ISA';
# spent 11µs making 1 call to Class::Struct::Tie_ISA::TIEARRAY
104
105 # Create constructor.
106
107 croak "function 'new' already defined in package $class"
1084916µs244µs
# spent 28µs (12+16) within Class::Struct::BEGIN@108 which was called: # once (12µs+16µs) by File::stat::BEGIN@173 at line 108
if do { no strict 'refs'; defined &{$class . "::new"} };
# spent 28µs making 1 call to Class::Struct::BEGIN@108 # spent 16µs making 1 call to strict::unimport
109
1101600ns my @methods = ();
1111500ns my %refs = ();
1121500ns my %arrays = ();
11310s my %hashes = ();
1141500ns my %classes = ();
1151500ns my $got_class = 0;
11611µs my $out = '';
117
11812µs $out = "{\n package $class;\n use Carp;\n sub new {\n";
1191500ns $out .= " my (\$class, \%init) = \@_;\n";
12011µs $out .= " \$class = __PACKAGE__ unless \@_;\n";
121
1221600ns my $cnt = 0;
1231500ns my $idx = 0;
1241500ns my( $cmt, $name, $type, $elem );
125
12611µs if( $base_type eq 'HASH' ){
127 $out .= " my(\$r) = {};\n";
128 $cmt = '';
129 }
130 elsif( $base_type eq 'ARRAY' ){
131 $out .= " my(\$r) = [];\n";
132 }
13312µs while( $idx < @decls ){
134138µs $name = $decls[$idx];
135138µs $type = $decls[$idx+1];
1361316µs push( @methods, $name );
1371311µs if( $base_type eq 'HASH' ){
138 $elem = "{'${class}::$name'}";
139 }
140 elsif( $base_type eq 'ARRAY' ){
1411312µs $elem = "[$cnt]";
142136µs ++$cnt;
143137µs $cmt = " # $name";
144 }
1451345µs135µs if( $type =~ /^\*(.)/ ){
# spent 5µs making 13 calls to Class::Struct::CORE:match, avg 362ns/call
146 $refs{$name}++;
147 $type = $1;
148 }
1491315µs my $init = "defined(\$init{'$name'}) ? \$init{'$name'} :";
1501326µ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->$elem = $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->$elem = $init {};$cmt\n";
160 $hashes{$name}++;
161 }
162 elsif ( $type eq '$') {
163 $out .= " \$r->$elem = $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->$elem = $type->new(\%{\$init{'$name'}}) } $cmt\n";
169 $out .= " elsif (UNIVERSAL::isa(\$init{'$name'}, '$type'))\n";
170 $out .= " { \$r->$elem = \$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 }
1791314µs $idx += 2;
180 }
1811500ns $out .= " bless \$r, \$class;\n }\n";
182
183 # Create accessor methods.
184
1851500ns my( $pre, $pst, $sel );
1861500ns $cnt = 0;
18712µs foreach $name (@methods){
18828896µs248µs
# spent 31µs (13+18) within Class::Struct::BEGIN@188 which was called: # once (13µs+18µs) by File::stat::BEGIN@173 at line 188
if ( do { no strict 'refs'; defined &{$class . "::$name"} } ) {
# spent 31µs making 1 call to Class::Struct::BEGIN@188 # spent 18µs making 1 call to strict::unimport
189 warnings::warnif("function '$name' already defined, overrides struct accessor method");
190 }
191 else {
192139µs $pre = $pst = $cmt = $sel = '';
193136µs if( defined $refs{$name} ){
194 $pre = "\\(";
195 $pst = ")";
196 $cmt = " # returns ref";
197 }
1981314µs $out .= " sub $name {$cmt\n my \$r = shift;\n";
1991312µs if( $base_type eq 'ARRAY' ){
2001310µs $elem = "[$cnt]";
201135µs ++$cnt;
202 }
203 elsif( $base_type eq 'HASH' ){
204 $elem = "{'${class}::$name'}";
205 }
206137µs if( defined $arrays{$name} ){
207 $out .= " my \$i;\n";
208 $out .= " \@_ ? (\$i = shift) : return \$r->$elem;\n";
209 $out .= " if (ref(\$i) eq 'ARRAY' && !\@_) { \$r->$elem = \$i; return \$r }\n";
210 $sel = "->[\$i]";
211 }
212 elsif( defined $hashes{$name} ){
213 $out .= " my \$i;\n";
214 $out .= " \@_ ? (\$i = shift) : return \$r->$elem;\n";
215 $out .= " if (ref(\$i) eq 'HASH' && !\@_) { \$r->$elem = \$i; return \$r }\n";
216 $sel = "->{\$i}";
217 }
218 elsif( defined $classes{$name} ){
219 if ( $CHECK_CLASS_MEMBERSHIP ) {
220 $out .= " croak '$name argument is wrong class' if \@_ && ! UNIVERSAL::isa(\$_[0], '$classes{$name}');\n";
221 }
222 }
2231312µs $out .= " croak 'Too many args to $name' if \@_ > 1;\n";
2241324µs $out .= " \@_ ? ($pre\$r->$elem$sel = shift$pst) : $pre\$r->$elem$sel$pst;\n";
225136µs $out .= " }\n";
226 }
227 }
2281500ns $out .= "}\n1;\n";
229
2301500ns print $out if $print;
2311131µs my $result = eval $out;
# spent 1.15ms executing statements in string eval
# includes 23µs spent executing 1 call to 15 subs defined therein.
232120µs carp $@ if $@;
233}
234
235sub _usage_error {
236 confess "struct usage error";
237}
238
239sub _subclass_error {
240 croak 'struct class cannot be a subclass (@ISA not allowed)';
241}
242
243128µs1; # for require
244
245
246__END__
 
# spent 5µs within Class::Struct::CORE:match which was called 13 times, avg 362ns/call: # 13 times (5µs+0s) by Class::Struct::struct at line 145, avg 362ns/call
sub Class::Struct::CORE:match; # opcode
Report produced by the NYTProf 4.09 Perl profiler, developed by Tim Bunce and Adam Kaplan.