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 and 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 40use strict; 41use warnings; 42 43# see Makefile.PL for discussion on why we load both Class::C3 and MRO::Compat 44use Class::C3 (); 45use MRO::Compat; 46use Class::Inspector; 47use Carp; 48 49our $VERSION = 1.0006; 50 51=head2 load_components( @comps ) 52 53Loads the given components into the current module. If a module begins with a 54C<+> character, it is taken to be a fully qualified class name, otherwise 55C<< $class->component_base_class >> is prepended to it. 56 57Calling this will call C<Class::C3::reinitialize>. 58 59=cut 60 61sub load_components { 62 my $class = shift; 63 my @comp = map { 64 /^\+(.*)$/ 65 ? $1 66 : join ('::', $class->component_base_class, $_) 67 } 68 grep { $_ !~ /^#/ } @_; 69 $class->_load_components(@comp); 70} 71 72=head2 load_own_components( @comps ) 73 74Similar to L<load_components>, but assumes every class is C<"$class::$comp">. 75 76=cut 77 78sub load_own_components { 79 my $class = shift; 80 my @comp = map { "${class}::$_" } grep { $_ !~ /^#/ } @_; 81 $class->_load_components(@comp); 82} 83 84sub _load_components { 85 my ($class, @comp) = @_; 86 foreach my $comp (@comp) { 87 $class->ensure_class_loaded($comp); 88 } 89 $class->inject_base($class => @comp); 90 Class::C3::reinitialize(); 91} 92 93=head2 load_optional_components 94 95As L<load_components>, but will silently ignore any components that cannot be 96found. 97 98=cut 99 100sub load_optional_components { 101 my $class = shift; 102 my @comp = grep { $class->load_optional_class( $_ ) } 103 map { 104 /^\+(.*)$/ 105 ? $1 106 : join ('::', $class->component_base_class, $_) 107 } 108 grep { $_ !~ /^#/ } @_; 109 110 $class->_load_components( @comp ) if scalar @comp; 111} 112 113=head2 ensure_class_loaded 114 115Given a class name, tests to see if it is already loaded or otherwise 116defined. If it is not yet loaded, the package is require'd, and an exception 117is thrown if the class is still not loaded. 118 119 BUG: For some reason, packages with syntax errors are added to %INC on 120 require 121=cut 122 123# 124# TODO: handle ->has_many('rel', 'Class'...) instead of 125# ->has_many('rel', 'Some::Schema::Class'...) 126# 127sub ensure_class_loaded { 128 my ($class, $f_class) = @_; 129 130 croak "Invalid class name $f_class" 131 if ($f_class=~m/(?:\b:\b|\:{3,})/); 132 return if Class::Inspector->loaded($f_class); 133 my $file = $f_class . '.pm'; 134 $file =~ s{::}{/}g; 135 eval { CORE::require($file) }; # require needs a bareword or filename 136 if ($@) { 137 if ($class->can('throw_exception')) { 138 $class->throw_exception($@); 139 } else { 140 croak $@; 141 } 142 } 143} 144 145=head2 ensure_class_found 146 147Returns true if the specified class is installed or already loaded, false 148otherwise. 149 150Note that the underlying mechanism (Class::Inspector->installed()) used by this 151sub will not, at the time of writing, correctly function when @INC includes 152coderefs. Since PAR relies upon coderefs in @INC, this function should be 153avoided in modules that are likely to be included within a PAR. 154 155=cut 156 157sub ensure_class_found { 158 my ($class, $f_class) = @_; 159 return Class::Inspector->loaded($f_class) || 160 Class::Inspector->installed($f_class); 161} 162 163 164=head2 inject_base 165 166Does the actual magic of adjusting @ISA on the target module. 167 168=cut 169 170sub inject_base { 171 my ($class, $target, @to_inject) = @_; 172 { 173 no strict 'refs'; 174 foreach my $to (reverse @to_inject) { 175 unshift ( @{"${target}::ISA"}, $to ) 176 unless ($target eq $to || $target->isa($to)); 177 } 178 } 179 180 mro::set_mro($target, 'c3'); 181} 182 183=head2 load_optional_class 184 185Returns a true value if the specified class is installed and loaded 186successfully, throws an exception if the class is found but not loaded 187successfully, and false if the class is not installed 188 189=cut 190 191sub load_optional_class { 192 my ($class, $f_class) = @_; 193 eval { $class->ensure_class_loaded($f_class) }; 194 my $err = $@; # so we don't lose it 195 if (! $err) { 196 return 1; 197 } 198 else { 199 my $fn = (join ('/', split ('::', $f_class) ) ) . '.pm'; 200 if ($err =~ /Can't locate ${fn} in \@INC/ ) { 201 return 0; 202 } 203 else { 204 die $err; 205 } 206 } 207} 208 209=head1 AUTHOR 210 211Matt S. Trout and the DBIx::Class team 212 213Pulled out into seperate module by Ash Berlin C<< <ash@cpan.org> >> 214 215=head1 LICENSE 216 217You may distribute this code under the same terms as Perl itself. 218 219=cut 220 2211; 222