X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FC3%2FComponentised.pm;h=5d8c73be08ef687650d9414f61164b508a712fc5;hb=b0dd4f7ba77d3889d34af444ac19b8760a877305;hp=2cfcbce1724f83ea95c635d08a71fe464b6936c8;hpb=d288ce5366c6e385364d6406b5ded37c6fa27420;p=p5sagit%2FClass-C3-Componentised.git diff --git a/lib/Class/C3/Componentised.pm b/lib/Class/C3/Componentised.pm index 2cfcbce..5d8c73b 100644 --- a/lib/Class/C3/Componentised.pm +++ b/lib/Class/C3/Componentised.pm @@ -1,41 +1,80 @@ package Class::C3::Componentised; +=head1 NAME + +Class::C3::Componentised + +=head1 DESCRIPTION + +Load mix-ins or components to your C3-based class. + +=head1 SYNOPSIS + + package MyModule; + + use strict; + use warnings; + + use base 'Class::C3::Componentised'; + + sub component_base_class { "MyModule::Component" } + + package main; + + MyModule->load_components( qw/Foo Bar/ ); + # Will load MyModule::Component::Foo an MyModule::Component::Bar + +=head1 DESCRIPTION + +This will inject base classes to your module using the L method +resolution order. + +Please note: these are not plugins that can take precedence over methods +declared in MyModule. If you want something like that, consider +L. + +=head1 METHODS + +=cut + use strict; use warnings; -use vars qw($VERSION); +# see Makefile.PL for discussion on why we load both Class::C3 and MRO::Compat +use Class::C3 (); +use MRO::Compat; +use Class::Inspector; +use Carp; -use Class::C3; +our $VERSION = 1.0005; -$VERSION = "0.01"; +=head2 load_components( @comps ) -sub inject_base { - my ($class, $target, @to_inject) = @_; - { - no strict 'refs'; - my %seen; - unshift( @{"${target}::ISA"}, - grep { !$seen{ $_ }++ && $target ne $_ && !$target->isa($_) } - @to_inject - ); - } +Loads the given components into the current module. If a module begins with a +C<+> character, it is taken to be a fully qualified class name, otherwise +C<< $class->component_base_class >> is prepended to it. - # Yes, this is hack. But it *does* work. Please don't submit tickets about - # it on the basis of the comments in Class::C3, the author was on #dbix-class - # while I was implementing this. +Calling this will call C. - my $table = { Class::C3::_dump_MRO_table }; - eval "package $target; import Class::C3;" unless exists $table->{$target}; -} +=cut sub load_components { my $class = shift; - my $base = $class->component_base_class; - my @comp = map { /^\+(.*)$/ ? $1 : "${base}::$_" } grep { $_ !~ /^#/ } @_; + my @comp = map { + /^\+(.*)$/ + ? $1 + : join ('::', $class->component_base_class, $_) + } + grep { $_ !~ /^#/ } @_; $class->_load_components(@comp); - Class::C3::reinitialize(); } +=head2 load_own_components( @comps ) + +Similar to L, but assumes every class is C<"$class::$comp">. + +=cut + sub load_own_components { my $class = shift; my @comp = map { "${class}::$_" } grep { $_ !~ /^#/ } @_; @@ -45,45 +84,133 @@ sub load_own_components { sub _load_components { my ($class, @comp) = @_; foreach my $comp (@comp) { - eval "use $comp"; - die $@ if $@; + $class->ensure_class_loaded($comp); } $class->inject_base($class => @comp); + Class::C3::reinitialize(); } -1; - -__END__ +=head2 load_optional_components -=head1 NAME +As L, but will silently ignore any components that cannot be +found. -Class::C3::Componentised - extend and mix classes at runtime +=cut -=head1 SYNOPSIS +sub load_optional_components { + my $class = shift; + my @comp = grep { $class->load_optional_class( $_ ) } + map { + /^\+(.*)$/ + ? $1 + : join ('::', $class->component_base_class, $_) + } + grep { $_ !~ /^#/ } @_; + + $class->_load_components( @comp ) if scalar @comp; +} - package MyApp; +=head2 ensure_class_loaded + +Given a class name, tests to see if it is already loaded or otherwise +defined. If it is not yet loaded, the package is require'd, and an exception +is thrown if the class is still not loaded. + + BUG: For some reason, packages with syntax errors are added to %INC on + require +=cut + +# +# TODO: handle ->has_many('rel', 'Class'...) instead of +# ->has_many('rel', 'Some::Schema::Class'...) +# +sub ensure_class_loaded { + my ($class, $f_class) = @_; + + croak "Invalid class name $f_class" + if ($f_class=~m/(?:\b:\b|\:{3,})/); + return if Class::Inspector->loaded($f_class); + my $file = $f_class . '.pm'; + $file =~ s{::}{/}g; + eval { CORE::require($file) }; # require needs a bareword or filename + if ($@) { + if ($class->can('throw_exception')) { + $class->throw_exception($@); + } else { + croak $@; + } + } +} - use base "Class::C3::Componentised"; +=head2 ensure_class_found - sub component_base_class { "MyApp" }; - +Returns true if the specified class is installed or already loaded, false +otherwise - package main; +=cut - MyApp->load_components(qw/Foo Bar Baz/); +sub ensure_class_found { + my ($class, $f_class) = @_; + return Class::Inspector->loaded($f_class) || + Class::Inspector->installed($f_class); +} -=head1 DESCRIPTION =head2 inject_base -=head2 load_components +Does the actual magic of adjusting @ISA on the target module. + +=cut + +sub inject_base { + my ($class, $target, @to_inject) = @_; + { + no strict 'refs'; + foreach my $to (reverse @to_inject) { + unshift ( @{"${target}::ISA"}, $to ) + unless ($target eq $to || $target->isa($to)); + } + } + + mro::set_mro($target, 'c3'); +} + +=head2 load_optional_class -=head2 load_own_components +Returns a true value if the specified class is installed and loaded +successfully, throws an exception if the class is found but not loaded +successfully, and false if the class is not installed + +=cut + +sub load_optional_class { + my ($class, $f_class) = @_; + eval { $class->ensure_class_loaded($f_class) }; + my $err = $@; # so we don't lose it + if (! $err) { + return 1; + } + else { + my $fn = (join ('/', split ('::', $f_class) ) ) . '.pm'; + if ($err =~ /Can't locate ${fn} in \@INC/ ) { + return 0; + } + else { + die $err; + } + } +} =head1 AUTHOR -Matt S. Trout +Matt S. Trout and the DBIx::Class team + +Pulled out into seperate module by Ash Berlin C<< >> =head1 LICENSE You may distribute this code under the same terms as Perl itself. + +=cut + +1;