1 package Class::C3::Componentised;
5 Class::C3::Componentised - Load mix-ins or components to your C3-based class
14 use base 'Class::C3::Componentised';
16 sub component_base_class { "MyModule::Component" }
20 MyModule->load_components( qw/Foo Bar/ );
21 # Will load MyModule::Component::Foo and MyModule::Component::Bar
25 This will inject base classes to your module using the L<Class::C3> method
28 Please note: these are not plugins that can take precedence over methods
29 declared in MyModule. If you want something like that, consider
30 L<MooseX::Object::Pluggable>.
39 # This will prime the Class::C3 namespace (either by loading it proper on 5.8
40 # or by installing compat shims on 5.10+). A user might have a reasonable
41 # expectation that using Class::C3::<something> will give him access to
42 # Class::C3 itself, and this module has been providing this historically.
43 # Therefore leaving it in indefinitely.
49 our $VERSION = '1.001000';
52 my $invalid_class = qr/(?: \b:\b | \:{3,} | \:\:$ )/x;
54 =head2 load_components( @comps )
56 Loads the given components into the current module. If a module begins with a
57 C<+> character, it is taken to be a fully qualified class name, otherwise
58 C<< $class->component_base_class >> is prepended to it.
60 Calling this will call C<Class::C3::reinitialize>.
66 $class->_load_components( map {
69 : join ('::', $class->component_base_class, $_)
70 } grep { $_ !~ /^#/ } @_
74 =head2 load_own_components( @comps )
76 Similar to L<load_components|/load_components( @comps )>, but assumes every
77 class is C<"$class::$comp">.
81 sub load_own_components {
83 $class->_load_components( map { "${class}::$_" } grep { $_ !~ /^#/ } @_ );
86 sub _load_components {
90 $class->ensure_class_loaded($_) for @_;
91 $class->inject_base($class => @_);
92 Class::C3::reinitialize();
95 =head2 load_optional_components
97 As L<load_components|/load_components( @comps )>, but will silently ignore any
98 components that cannot be found.
102 sub load_optional_components {
104 $class->_load_components( grep
105 { $class->load_optional_class( $_ ) }
109 : join ('::', $class->component_base_class, $_)
111 grep { $_ !~ /^#/ } @_
116 =head2 ensure_class_loaded
118 Given a class name, tests to see if it is already loaded or otherwise
119 defined. If it is not yet loaded, the package is require'd, and an exception
120 is thrown if the class is still not loaded.
122 BUG: For some reason, packages with syntax errors are added to %INC on
126 sub ensure_class_loaded {
127 my ($class, $f_class) = @_;
131 # ripped from Class::Inspector for speed
132 # note that the order is important (faster items are first)
133 return if ${"${f_class}::VERSION"};
135 return if @{"${f_class}::ISA"};
137 my $file = (join ('/', split ('::', $f_class) ) ) . '.pm';
138 return if $INC{$file};
140 for ( keys %{"${f_class}::"} ) {
141 return if ( *{"${f_class}::$_"}{CODE} );
144 # require always returns true on success
145 # ill-behaved modules might very well obliterate $_
146 eval { local $_; require($file) } or do {
148 $@ = "Invalid class name '$f_class'" if $f_class =~ $invalid_class;
150 if ($class->can('throw_exception')) {
151 $class->throw_exception($@);
160 =head2 ensure_class_found
162 Returns true if the specified class is installed or already loaded, false
167 sub ensure_class_found {
168 #my ($class, $f_class) = @_;
169 require Class::Inspector;
170 return Class::Inspector->loaded($_[1]) ||
171 Class::Inspector->installed($_[1]);
177 Does the actual magic of adjusting C<@ISA> on the target module.
185 mro::set_mro($target, 'c3');
187 for my $comp (reverse @_) {
190 sub { unshift ( @{"${target}::ISA"}, $comp ) };
192 unless ($target eq $comp || $target->isa($comp)) {
195 = List::Util::first { $APPLICATOR_FOR{$_} } @{mro::get_linear_isa($comp)}
197 $APPLICATOR_FOR{$apply_class}->_apply_component_to_class($comp,$target,$apply);
205 =head2 load_optional_class
207 Returns a true value if the specified class is installed and loaded
208 successfully, throws an exception if the class is found but not loaded
209 successfully, and false if the class is not installed
213 sub load_optional_class {
214 my ($class, $f_class) = @_;
216 # ensure_class_loaded either returns a () (*not* true) or throws
218 $class->ensure_class_loaded($f_class);
222 my $err = $@; # so we don't lose it
224 if ($f_class =~ $invalid_class) {
225 $err = "Invalid class name '$f_class'";
228 my $fn = quotemeta( (join ('/', split ('::', $f_class) ) ) . '.pm' );
229 return 0 if ($err =~ /Can't locate ${fn} in \@INC/ );
232 if ($class->can('throw_exception')) {
233 $class->throw_exception($err);
242 Matt S. Trout and the L<DBIx::Class team|DBIx::Class/CONTRIBUTORS>
244 Pulled out into separate module by Ash Berlin C<< <ash@cpan.org> >>
246 Optimizations and overall bolt-tightening by Peter "ribasushi" Rabbitson
247 C<< <ribasushi@cpan.org> >>
251 Copyright (c) 2006 - 2011 the Class::C3::Componentised L</AUTHORS> as listed
256 You may distribute this code under the same terms as Perl itself.