← Index
Performance Profile   « block view • line view • sub view »
For /wise/base/deliv/dev/bin/getfix
  Run on Thu May 20 15:30:03 2010
Reported on Thu May 20 16:25:28 2010

File/wise/base/static/lib/perl5/site_perl/5.10.0/Class/C3/Componentised.pm
Statements Executed352
Total Time0.024255 seconds

Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
30440.036690.07654Class::C3::Componentised::ensure_class_loaded
9210.000320.04324Class::C3::Componentised::_load_components
8880.000280.04344Class::C3::Componentised::load_components
1115.3e-50.01514Class::C3::Componentised::load_own_components
1111.5e-50.00034Class::C3::Componentised::ensure_class_found
00000Class::C3::Componentised::BEGIN
00000Class::C3::Componentised::_load_optional_class
00000Class::C3::Componentised::inject_base
00000Class::C3::Componentised::load_optional_components

LineStmts.Exclusive
Time		Avg.Code
1package Class::C3::Componentised;
2
3=head1 NAME
4
5Class::C3::Componentised
6
7=head1 DESCRIPTION
8
9Load mix-ins or components to your C3-based class.
10
11=head1 SYNOPSIS
12
13 package MyModule;
14
15 use strict;
16 use warnings;
17
18 use base 'Class::C3::Componentised';
19
20 sub component_base_class { "MyModule::Component" }
21
22 package main;
23
24 MyModule->load_components( qw/Foo Bar/ );
25 # Will load MyModule::Component::Foo an MyModule::Component::Bar
26
27=head1 DESCRIPTION
28
29This will inject base classes to your module using the L<Class::C3> method
30resolution order.
31
32Please note: these are not plugins that can take precedence over methods
33declared in MyModule. If you want something like that, consider
34L<MooseX::Object::Pluggable>.
35
36=head1 METHODS
37
38=cut
39
4033.8e-51.3e-5use strict;
# spent 19µs making 1 call to strict::import
4132.5e-58.3e-6use warnings;
# spent 22µs making 1 call to warnings::import
42
4330.000740.00025use Class::C3;
# spent 30µs making 1 call to Class::C3::import
4430.000720.00024use Class::Inspector;
# spent 4µs making 1 call to import
4530.000590.00020use Carp;
# spent 83µs making 1 call to Exporter::import
46
4711.0e-61.0e-6our $VERSION = 1.0001;
48
49=head2 load_components( @comps )
50
51Loads the given components into the current module. If a module begins with a
52C<+> character, it is taken to be a fully qualified class name, otherwise
53C<< $class->component_base_class >> is prepended to it.
54
55Calling this will call C<Class::C3::reinitialize>.
56
57=cut
58
59
# spent 43.4ms (279µs+43.2) within Class::C3::Componentised::load_components which was called 8 times, avg 5.43ms/call: # once (34µs+41.7ms) at line 9 of /wise/base/deliv/dev/lib/perl/WISE/DB/FrameIndex/Scan.pm # once (31µs+490µs) at line 9 of /wise/base/deliv/dev/lib/perl/WISE/DB/FrameIndex/MissionPlan.pm # once (41µs+405µs) at line 10 of /wise/base/deliv/dev/lib/perl/WISE/DB/FrameIndex/HouseKeeping.pm # once (32µs+347µs) at line 9 of /wise/base/deliv/dev/lib/perl/WISE/DB/FrameIndex/Frame.pm # once (28µs+337µs) at line 9 of /wise/base/deliv/dev/lib/perl/WISE/DB/FrameIndex/Tile.pm # once (38µs+-38000ns) at line 9 of /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/Relationship/Helpers.pm # once (44µs+-44000ns) at line 9 of /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/Core.pm # once (31µs+-31000ns) at line 9 of /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/ResultSource/Table.pm
sub load_components {
60680.000294.2e-6 my $class = shift;
61 my $base = $class->component_base_class;
# spent 43µs making 8 calls to DBIx::Class::component_base_class, avg 5µs/call
62 my @comp = map { /^\+(.*)$/ ? $1 : "${base}::$_" } grep { $_ !~ /^#/ } @_;
63 $class->_load_components(@comp);
# spent 96.1ms making 8 calls to Class::C3::Componentised::_load_components, avg 5.41ms/call, max recursion depth 1
64}
65
66=head2 load_own_components( @comps )
67
68Simialr to L<load_components>, but assumes every class is C<"$class::$comp">.
69
70=cut
71
72
# spent 15.1ms (53µs+15.1) within Class::C3::Componentised::load_own_components which was called # once (53µs+15.1ms) at line 8 of /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/Relationship.pm
sub load_own_components {
7384.2e-55.3e-6 my $class = shift;
74 my @comp = map { "${class}::$_" } grep { $_ !~ /^#/ } @_;
75 $class->_load_components(@comp);
# spent 15.1ms making 1 call to Class::C3::Componentised::_load_components, max recursion depth 2
76}
77
78
# spent 43.2ms (317µs+42.9) within Class::C3::Componentised::_load_components which was called 9 times, avg 4.80ms/call: # 8 times (273µs+43.0ms) by Class::C3::Componentised::load_components at line 63, avg 5.41ms/call # once (44µs+-44000ns) by Class::C3::Componentised::load_own_components at line 75
sub _load_components {
79590.000437.3e-6 my ($class, @comp) = @_;
80 foreach my $comp (@comp) {
81 $class->ensure_class_loaded($comp);
# spent 108ms making 23 calls to Class::C3::Componentised::ensure_class_loaded, avg 0/call, max recursion depth 1
82 }
83 $class->inject_base($class => @comp);
# spent 3.03ms making 9 calls to DBIx::Class::Componentised::inject_base, avg 337µs/call
84 Class::C3::reinitialize();
# spent 46µs making 9 calls to DBIx::Class::Schema::__ANON__[/wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/Schema.pm:288], avg 5µs/call
85}
86
87=head2 load_optional_components
88
89As L<load_components>, but will silently ignore any components that cannot be
90found.
91
92=cut
93
94sub load_optional_components {
95 my $class = shift;
96 my $base = $class->component_base_class;
97 my @comp = grep { $class->load_optional_class( $_ ) }
98 map { /^\+(.*)$/ ? $1 : "${base}::$_" }
99 grep { $_ !~ /^#/ } @_;
100
101 $class->_load_components( @comp ) if scalar @comp;
102}
103
104=head2 ensure_class_loaded
105
106Given a class name, tests to see if it is already loaded or otherwise
107defined. If it is not yet loaded, the package is require'd, and an exception
108is thrown if the class is still not loaded.
109
110 BUG: For some reason, packages with syntax errors are added to %INC on
111 require
112=cut
113
114#
115# TODO: handle ->has_many('rel', 'Class'...) instead of
116# ->has_many('rel', 'Some::Schema::Class'...)
117#
118
# spent 76.5ms (36.7+39.9) within Class::C3::Componentised::ensure_class_loaded which was called 30 times, avg 2.55ms/call: # 23 times (26.5ms+-26477000ns) by Class::C3::Componentised::_load_components at line 81, avg 0/call # 5 times (4.87ms+66.6ms) by DBIx::Class::Schema::load_classes at line 299 of /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/Schema.pm, avg 14.3ms/call # once (3.68ms+1.38ms) by DBIx::Class::Componentised::load_optional_class at line 40 of /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/Componentised.pm # once (1.66ms+-1663000ns) by DBIx::Class::Relationship::HasMany::has_many at line 11 of /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/Relationship/HasMany.pm
sub ensure_class_loaded {
1191340.001078.0e-6 my ($class, $f_class) = @_;
120
121 croak "Invalid class name $f_class"
122 if ($f_class=~m/(?:\b:\b|\:{3,})/);
123 return if Class::Inspector->loaded($f_class);
# spent 1.87ms making 30 calls to Class::Inspector::loaded, avg 62µs/call
12410.019320.01932 eval "require $f_class"; # require needs a bareword or filename
125 if ($@) {
126 if ($class->can('throw_exception')) {
127 $class->throw_exception($@);
128 } else {
129 croak $@;
130 }
131 }
132}
133
134=head2 ensure_class_found
135
136Returns true if the specified class is installed or already loaded, false
137otherwise
138
139=cut
140
141
# spent 336µs (15+321) within Class::C3::Componentised::ensure_class_found which was called # once (15µs+321µs) by DBIx::Class::Componentised::load_optional_class at line 39 of /wise/base/static/lib/perl5/site_perl/5.10.0/DBIx/Class/Componentised.pm
sub ensure_class_found {
14222.1e-51.0e-5 my ($class, $f_class) = @_;
143 return Class::Inspector->loaded($f_class) ||
# spent 175µs making 1 call to Class::Inspector::installed # spent 146µs making 1 call to Class::Inspector::loaded
144 Class::Inspector->installed($f_class);
145}
146
147# Returns a true value if the specified class is installed and loaded
148# successfully, throws an exception if the class is found but not loaded
149# successfully, and false if the class is not installed
150sub _load_optional_class {
151 my ($class, $f_class) = @_;
152 if ($class->ensure_class_found($f_class)) {
153 $class->ensure_class_loaded($f_class);
154 return 1;
155 } else {
156 return 0;
157 }
158}
159
160=head2 inject_base
161
162Does the actual magic of adjusting @ISA on the target module.
163
164=cut
165
166sub inject_base {
167590.000741.3e-5 my ($class, $target, @to_inject) = @_;
168 {
16930.000113.5e-5 no strict 'refs';
# spent 46µs making 1 call to strict::unimport
170 foreach my $to (reverse @to_inject) {
171 unshift ( @{"${target}::ISA"}, $to )
# spent 247µs making 23 calls to UNIVERSAL::isa, avg 11µs/call
172 unless ($target eq $to || $target->isa($to));
173 }
174 }
175
176 # Yes, this is hack. But it *does* work. Please don't submit tickets about
177 # it on the basis of the comments in Class::C3, the author was on #dbix-class
178 # while I was implementing this.
179
18010.000120.00012 eval "package $target; import Class::C3;" unless exists $Class::C3::MRO{$target};
# spent 170µs making 9 calls to Class::C3::import, avg 19µs/call
181}
182
183=head1 AUTHOR
184
185Matt S. Trout and the DBIx::Class team
186
187Pulled out into seperate module by Ash Berlin C<< <ash@cpan.org> >>
188
189=head1 LICENSE
190
191You may distribute this code under the same terms as Perl itself.
192
193=cut
194
19513.0e-63.0e-61;

Report produced by the NYTProf 2.07 Perl profiler, developed by Tim Bunce and Adam Kaplan.