X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FUtil.pm;h=53af4cfd9778d92690774bc86df58814c930056c;hb=52c48ad7f7cf12cefee9c6e15ab00289976e342b;hp=f53fb080d7f4ca6638f9e693512e25f87788bb1a;hpb=07d18a6b15d6d937a78ecd2dd24f5375f0096766;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm index f53fb08..53af4cf 100644 --- a/lib/Mouse/Util.pm +++ b/lib/Mouse/Util.pm @@ -6,6 +6,7 @@ use Carp; our @EXPORT_OK = qw( get_linear_isa + apply_all_roles ); our %EXPORT_TAGS = ( all => \@EXPORT_OK, @@ -14,11 +15,12 @@ our %EXPORT_TAGS = ( BEGIN { my $impl; if ($] >= 5.009_005) { + require mro; $impl = \&mro::get_linear_isa; } else { my $loaded = do { local $SIG{__DIE__} = 'DEFAULT'; - eval "require MRO::Compat; 1"; + eval { require MRO::Compat; 1 }; }; if ($loaded) { $impl = \&mro::get_linear_isa; @@ -51,10 +53,105 @@ BEGIN { *{ __PACKAGE__ . '::get_linear_isa'} = $impl; } +# taken from Class/MOP.pm +{ + my %cache; + + sub resolve_metaclass_alias { + my ( $type, $metaclass_name, %options ) = @_; + + my $cache_key = $type; + return $cache{$cache_key}{$metaclass_name} + if $cache{$cache_key}{$metaclass_name}; + + my $possible_full_name = + 'Mouse::Meta::' + . $type + . '::Custom::' + . $metaclass_name; + + my $loaded_class = + load_first_existing_class( $possible_full_name, + $metaclass_name ); + + return $cache{$cache_key}{$metaclass_name} = + $loaded_class->can('register_implementation') + ? $loaded_class->register_implementation + : $loaded_class; + } +} + +# taken from Class/MOP.pm +sub _is_valid_class_name { + my $class = shift; + + return 0 if ref($class); + return 0 unless defined($class); + return 0 unless length($class); + + return 1 if $class =~ /^\w+(?:::\w+)*$/; + + return 0; +} + +# taken from Class/MOP.pm +sub load_first_existing_class { + my @classes = @_ + or return; + + foreach my $class (@classes) { + unless ( _is_valid_class_name($class) ) { + my $display = defined($class) ? $class : 'undef'; + confess "Invalid class name ($display)"; + } + } + + my $found; + my %exceptions; + for my $class (@classes) { + my $e = _try_load_one_class($class); + + if ($e) { + $exceptions{$class} = $e; + } + else { + $found = $class; + last; + } + } + return $found if $found; + + confess join( + "\n", + map { + sprintf( "Could not load class (%s) because : %s", + $_, $exceptions{$_} ) + } @classes + ); +} + +# taken from Class/MOP.pm +sub _try_load_one_class { + my $class = shift; + + return if Mouse::is_class_loaded($class); + + my $file = $class . '.pm'; + $file =~ s{::}{/}g; + + return do { + local $@; + eval { require($file) }; + $@; + }; +} + sub apply_all_roles { my $meta = Mouse::Meta::Class->initialize(shift); my @roles; + + # Basis of Data::OptList my $max = scalar(@_); for (my $i = 0; $i < $max ; $i++) { if ($i + 1 < $max && ref($_[$i + 1])) {