X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FC3%2FComponentised.pm;h=a5c3b992ca7851ea828c021bb0a181faaf083ee3;hb=e6b8b400a35fbeab4b07c8f2fb5d7df72040f382;hp=ed0ac418958d64041f769ca56fd09c4a4a945a83;hpb=4a196a90116e3209994ffe0577e7dd08582e7311;p=p5sagit%2FClass-C3-Componentised.git diff --git a/lib/Class/C3/Componentised.pm b/lib/Class/C3/Componentised.pm index ed0ac41..a5c3b99 100644 --- a/lib/Class/C3/Componentised.pm +++ b/lib/Class/C3/Componentised.pm @@ -22,7 +22,7 @@ Load mix-ins or components to your C3-based class. package main; MyModule->load_components( qw/Foo Bar/ ); - # Will load MyModule::Component::Foo an MyModule::Component::Bar + # Will load MyModule::Component::Foo and MyModule::Component::Bar =head1 DESCRIPTION @@ -40,11 +40,18 @@ L. use strict; use warnings; -use Class::C3; -use Class::Inspector; -use Carp; +# This will prime the Class::C3 namespace (either by loading it proper on 5.8 +# or by installing compat shims on 5.10+). A user might have a reasonable +# expectation that using Class::C3:: will give him access to +# Class::C3 itself, and this module has been providing this historically. +# Therefore leaving it in indefinitely. +use MRO::Compat; -our $VERSION = 1.0003; +use Carp (); + +our $VERSION = 1.0009; + +my $invalid_class = qr/(?: \b:\b | \:{3,} | \:\:$ )/x; =head2 load_components( @comps ) @@ -58,29 +65,31 @@ Calling this will call C. sub load_components { my $class = shift; - my $base = $class->component_base_class; - my @comp = map { /^\+(.*)$/ ? $1 : "${base}::$_" } grep { $_ !~ /^#/ } @_; - $class->_load_components(@comp); + $class->_load_components( map { + /^\+(.*)$/ + ? $1 + : join ('::', $class->component_base_class, $_) + } grep { $_ !~ /^#/ } @_ + ); } =head2 load_own_components( @comps ) -Simialr to L, but assumes every class is C<"$class::$comp">. +Similar to L, but assumes every class is C<"$class::$comp">. =cut sub load_own_components { my $class = shift; - my @comp = map { "${class}::$_" } grep { $_ !~ /^#/ } @_; - $class->_load_components(@comp); + $class->_load_components( map { "${class}::$_" } grep { $_ !~ /^#/ } @_ ); } sub _load_components { - my ($class, @comp) = @_; - foreach my $comp (@comp) { - $class->ensure_class_loaded($comp); - } - $class->inject_base($class => @comp); + my $class = shift; + return unless @_; + + $class->ensure_class_loaded($_) for @_; + $class->inject_base($class => @_); Class::C3::reinitialize(); } @@ -93,12 +102,16 @@ found. sub load_optional_components { my $class = shift; - my $base = $class->component_base_class; - my @comp = grep { $class->load_optional_class( $_ ) } - map { /^\+(.*)$/ ? $1 : "${base}::$_" } - grep { $_ !~ /^#/ } @_; - - $class->_load_components( @comp ) if scalar @comp; + $class->_load_components( grep + { $class->load_optional_class( $_ ) } + ( map + { /^\+(.*)$/ + ? $1 + : join ('::', $class->component_base_class, $_) + } + grep { $_ !~ /^#/ } @_ + ) + ); } =head2 ensure_class_loaded @@ -111,39 +124,57 @@ is thrown if the class is still not loaded. 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 ($@) { + no strict 'refs'; + + # ripped from Class::Inspector for speed + # note that the order is important (faster items are first) + return if ${"${f_class}::VERSION"}; + + return if @{"${f_class}::ISA"}; + + my $file = (join ('/', split ('::', $f_class) ) ) . '.pm'; + return if $INC{$file}; + + for ( keys %{"${f_class}::"} ) { + return if ( *{"${f_class}::$_"}{CODE} ); + } + + # require always returns true on success + # ill-behaved modules might very well obliterate $_ + eval { local $_; require($file) } or do { + + $@ = "Invalid class name '$f_class'" if $f_class =~ $invalid_class; + if ($class->can('throw_exception')) { $class->throw_exception($@); } else { - croak $@; + Carp::croak $@; } - } + }; + + return; } =head2 ensure_class_found Returns true if the specified class is installed or already loaded, false -otherwise +otherwise. + +Note that the underlying mechanism (Class::Inspector->installed()) used by this +sub will not, at the time of writing, correctly function when @INC includes +coderefs. Since PAR relies upon coderefs in @INC, this function should be +avoided in modules that are likely to be included within a PAR. =cut sub ensure_class_found { - my ($class, $f_class) = @_; - return Class::Inspector->loaded($f_class) || - Class::Inspector->installed($f_class); + #my ($class, $f_class) = @_; + require Class::Inspector; + return Class::Inspector->loaded($_[1]) || + Class::Inspector->installed($_[1]); } @@ -154,28 +185,94 @@ Does the actual magic of adjusting @ISA on the target module. =cut sub inject_base { - my ($class, $target, @to_inject) = @_; - { + my $class = shift; + my $target = shift; + + mro::set_mro($target, 'c3'); + + for my $comp (reverse @_) { no strict 'refs'; - foreach my $to (reverse @to_inject) { - unshift ( @{"${target}::ISA"}, $to ) - unless ($target eq $to || $target->isa($to)); + unless ($target eq $comp || $target->isa($comp)) { + my @heritage = @{mro::get_linear_isa($comp)}; + + my @before = map { + my $to_run = $Class::C3::Componentised::ApplyHooks::Before{$_}; + ($to_run?[$_,$to_run]:()) + } @heritage; + + for my $todo (@before) { + my ($parent, $fn) = @$todo; + for my $f (reverse @$fn) { + $target->$f($parent) + } + } + + unshift ( @{"${target}::ISA"}, $comp ); + + my @after = map { + my $to_run = $Class::C3::Componentised::ApplyHooks::After{$_}; + ($to_run?[$_,$to_run]:()) + } @heritage; + + for my $todo (reverse @after) { + my ($parent, $fn) = @$todo; + for my $f (@$fn) { + $target->$f($parent) + } + } } } +} + +=head2 load_optional_class + +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) = @_; - # 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. + # ensure_class_loaded either returns a () (*not* true) or throws + eval { + $class->ensure_class_loaded($f_class); + 1; + } && return 1; - eval "package $target; import Class::C3;" unless exists $Class::C3::MRO{$target}; + my $err = $@; # so we don't lose it + + if ($f_class =~ $invalid_class) { + $err = "Invalid class name '$f_class'"; + } + else { + my $fn = quotemeta( (join ('/', split ('::', $f_class) ) ) . '.pm' ); + return 0 if ($err =~ /Can't locate ${fn} in \@INC/ ); + } + + if ($class->can('throw_exception')) { + $class->throw_exception($err); + } + else { + die $err; + } } -=head1 AUTHOR +=head1 AUTHORS -Matt S. Trout and the DBIx::Class team +Matt S. Trout and the L Pulled out into seperate module by Ash Berlin C<< >> +Optimizations and overall bolt-tightening by Peter "ribasushi" Rabbitson +C<< >> + +=head1 COPYRIGHT + +Copyright (c) 2006 - 2011 the Class::C3::Componentised L as listed +above. + =head1 LICENSE You may distribute this code under the same terms as Perl itself.