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;
-# 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.0004;
+use Carp ();
+
+our $VERSION = 1.0008;
+
+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 )
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);
- 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]);
}
=cut
sub inject_base {
- my ($class, $target, @to_inject) = @_;
- {
+ my $class = shift;
+ my $target = shift;
+
+ for (reverse @_) {
no strict 'refs';
- foreach my $to (reverse @to_inject) {
- unshift ( @{"${target}::ISA"}, $to )
- unless ($target eq $to || $target->isa($to));
- }
+ unshift ( @{"${target}::ISA"}, $_ )
+ unless ($target eq $_ || $target->isa($_));
}
mro::set_mro($target, 'c3');
}
+=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
+
+ 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
Matt S. Trout and the DBIx::Class team
projects / p5sagit/Class-C3-Componentised.git / blobdiff