=head1 NAME
-Class::C3::Componentised
-
-=head1 DESCRIPTION
-
-Load mix-ins or components to your C3-based class.
+Class::C3::Componentised - Load mix-ins or components to your C3-based class
=head1 SYNOPSIS
package main;
- MyModule->load_components( qw/Foo Bar/ );
- # Will load MyModule::Component::Foo an MyModule::Component::Bar
+ MyModule->load_components( qw/Foo Bar/ );
+ # Will load MyModule::Component::Foo and MyModule::Component::Bar
=head1 DESCRIPTION
This will inject base classes to your module using the L<Class::C3> method
resolution order.
-Please note: these are not plugins that can take precedence over methods
+Please note: these are not plugins that can take precedence over methods
declared in MyModule. If you want something like that, consider
L<MooseX::Object::Pluggable>.
use strict;
use warnings;
-# see Makefile.PL for discussion on why we load both Class::C3 and MRO::Compat
-use Class::C3 ();
+# 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::<something> will give him access to
+# Class::C3 itself, and this module has been providing this historically.
+# Therefore leaving it in indefinitely.
use MRO::Compat;
-use Class::Inspector;
-use Carp;
-our $VERSION = 1.0005;
+use Carp ();
+use List::Util ();
+
+our $VERSION = '1.001002';
+$VERSION =~ tr/_//d;
+
+my $invalid_class = qr/(?: \b:\b | \:{3,} | \:\:$ )/x;
=head2 load_components( @comps )
-Loads the given components into the current module. If a module begins with a
+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.
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 )
-Similar to L<load_components>, but assumes every class is C<"$class::$comp">.
+Similar to L<load_components|/load_components( @comps )>, 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();
}
=head2 load_optional_components
-As L<load_components>, but will silently ignore any components that cannot be
-found.
+As L<load_components|/load_components( @comps )>, but will silently ignore any
+components that cannot be found.
=cut
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
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.
=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]);
}
=head2 inject_base
-Does the actual magic of adjusting @ISA on the target module.
+Does the actual magic of adjusting C<@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));
- }
- }
+ my $class = shift;
+ my $target = shift;
mro::set_mro($target, 'c3');
+
+ for my $comp (reverse @_) {
+ my $apply = do {
+ no strict 'refs';
+ sub { unshift ( @{"${target}::ISA"}, $comp ) };
+ };
+ unless ($target eq $comp || $target->isa($comp)) {
+ our %APPLICATOR_FOR;
+ if (my $apply_class
+ = List::Util::first { $APPLICATOR_FOR{$_} } @{mro::get_linear_isa($comp)}
+ ) {
+ $APPLICATOR_FOR{$apply_class}->_apply_component_to_class($comp,$target,$apply);
+ } else {
+ $apply->();
+ }
+ }
+ }
}
=head2 load_optional_class
sub load_optional_class {
my ($class, $f_class) = @_;
- if ($class->ensure_class_found($f_class)) {
- eval { $class->ensure_class_loaded($f_class) };
- croak "Failed to load $f_class: $@" if $@;
- return 1;
+
+ # ensure_class_loaded either returns a () (*not* true) or throws
+ eval {
+ $class->ensure_class_loaded($f_class);
+ 1;
+ } && return 1;
+
+ 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;
}
- return 0;
}
+=head1 AUTHORS
+
+Matt S. Trout and the L<DBIx::Class team|DBIx::Class/CONTRIBUTORS>
+
+Pulled out into separate module by Ash Berlin C<< <ash@cpan.org> >>
-=head1 AUTHOR
+Optimizations and overall bolt-tightening by Peter "ribasushi" Rabbitson
+C<< <ribasushi@cpan.org> >>
-Matt S. Trout and the DBIx::Class team
+=head1 COPYRIGHT
-Pulled out into seperate module by Ash Berlin C<< <ash@cpan.org> >>
+Copyright (c) 2006 - 2011 the Class::C3::Componentised L</AUTHORS> as listed
+above.
=head1 LICENSE