1 package Class::C3::Componentised;
5 Class::C3::Componentised
9 Load mix-ins or components to your C3-based class.
18 use base 'Class::C3::Componentised';
20 sub component_base_class { "MyModule::Component" }
24 MyModule->load_components( qw/Foo Bar/ );
25 # Will load MyModule::Component::Foo an MyModule::Component::Bar
29 This will inject base classes to your module using the L<Class::C3> method
32 Please note: these are not plugins that can take precedence over methods
33 declared in MyModule. If you want something like that, consider
34 L<MooseX::Object::Pluggable>.
43 # see Makefile.PL for discussion on why we load both Class::C3 and MRO::Compat
49 our $VERSION = 1.0005;
51 =head2 load_components( @comps )
53 Loads the given components into the current module. If a module begins with a
54 C<+> character, it is taken to be a fully qualified class name, otherwise
55 C<< $class->component_base_class >> is prepended to it.
57 Calling this will call C<Class::C3::reinitialize>.
63 my $base = $class->component_base_class;
64 my @comp = map { /^\+(.*)$/ ? $1 : "${base}::$_" } grep { $_ !~ /^#/ } @_;
65 $class->_load_components(@comp);
68 =head2 load_own_components( @comps )
70 Similar to L<load_components>, but assumes every class is C<"$class::$comp">.
74 sub load_own_components {
76 my @comp = map { "${class}::$_" } grep { $_ !~ /^#/ } @_;
77 $class->_load_components(@comp);
80 sub _load_components {
81 my ($class, @comp) = @_;
82 foreach my $comp (@comp) {
83 $class->ensure_class_loaded($comp);
85 $class->inject_base($class => @comp);
86 Class::C3::reinitialize();
89 =head2 load_optional_components
91 As L<load_components>, but will silently ignore any components that cannot be
96 sub load_optional_components {
98 my $base = $class->component_base_class;
99 my @comp = grep { $class->load_optional_class( $_ ) }
100 map { /^\+(.*)$/ ? $1 : "${base}::$_" }
101 grep { $_ !~ /^#/ } @_;
103 $class->_load_components( @comp ) if scalar @comp;
106 =head2 ensure_class_loaded
108 Given a class name, tests to see if it is already loaded or otherwise
109 defined. If it is not yet loaded, the package is require'd, and an exception
110 is thrown if the class is still not loaded.
112 BUG: For some reason, packages with syntax errors are added to %INC on
117 # TODO: handle ->has_many('rel', 'Class'...) instead of
118 # ->has_many('rel', 'Some::Schema::Class'...)
120 sub ensure_class_loaded {
121 my ($class, $f_class) = @_;
123 croak "Invalid class name $f_class"
124 if ($f_class=~m/(?:\b:\b|\:{3,})/);
125 return if Class::Inspector->loaded($f_class);
126 my $file = $f_class . '.pm';
128 eval { CORE::require($file) }; # require needs a bareword or filename
130 if ($class->can('throw_exception')) {
131 $class->throw_exception($@);
138 =head2 ensure_class_found
140 Returns true if the specified class is installed or already loaded, false
145 sub ensure_class_found {
146 my ($class, $f_class) = @_;
147 return Class::Inspector->loaded($f_class) ||
148 Class::Inspector->installed($f_class);
154 Does the actual magic of adjusting @ISA on the target module.
159 my ($class, $target, @to_inject) = @_;
162 foreach my $to (reverse @to_inject) {
163 unshift ( @{"${target}::ISA"}, $to )
164 unless ($target eq $to || $target->isa($to));
168 mro::set_mro($target, 'c3');
171 =head2 load_optional_class
173 Returns a true value if the specified class is installed and loaded
174 successfully, throws an exception if the class is found but not loaded
175 successfully, and false if the class is not installed
179 sub load_optional_class {
180 my ($class, $f_class) = @_;
181 eval { $class->ensure_class_loaded($f_class) };
182 my $err = $@; # so we don't lose it
187 my $fn = (join ('/', split ('::', $f_class) ) ) . '.pm';
188 if ($err =~ /Can't locate ${fn} in \@INC/ ) {
199 Matt S. Trout and the DBIx::Class team
201 Pulled out into seperate module by Ash Berlin C<< <ash@cpan.org> >>
205 You may distribute this code under the same terms as Perl itself.