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
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::<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;
-our $VERSION = 1.0000;
+use Carp ();
+
+our $VERSION = 1.0009;
+
+my $invalid_class = qr/(?: \b:\b | \:{3,} | \:\:$ )/x;
=head2 load_components( @comps )
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<load_components>, but assumes every class is C<"$class::$comp">.
+Similar to L<load_components>, 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();
}
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);
- eval "require $f_class"; # 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]);
}
-# 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
-sub _load_optional_class {
- my ($class, $f_class) = @_;
- if ($class->ensure_class_found($f_class)) {
- $class->ensure_class_loaded($f_class);
- return 1;
- } else {
- return 0;
- }
-}
=head2 inject_base
=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) = @_;
+
+ # 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
- # 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.
+ 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/ );
+ }
- eval "package $target; import Class::C3;" unless exists $Class::C3::MRO{$target};
+ 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<DBIx::Class team|DBIx::Class/CONTRIBUTORS>
Pulled out into seperate module by Ash Berlin C<< <ash@cpan.org> >>
+Optimizations and overall bolt-tightening by Peter "ribasushi" Rabbitson
+C<< <ribasushi@cpan.org> >>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2006 - 2011 the Class::C3::Componentised L</AUTHORS> as listed
+above.
+
=head1 LICENSE
You may distribute this code under the same terms as Perl itself.