X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FModule.pm;h=94ac4bc1d8df6939306847aacdb8c7e9510ec41d;hp=9cacd9bb2f38bba18636842e89e09d0d231ed651;hb=506fb74dbff3e8f756230c643d8bff7b85ae9ca3;hpb=6a97bbdad44391f2a587165cb81fcf8aedc642ac diff --git a/lib/Mouse/Meta/Module.pm b/lib/Mouse/Meta/Module.pm index 9cacd9b..94ac4bc 100755 --- a/lib/Mouse/Meta/Module.pm +++ b/lib/Mouse/Meta/Module.pm @@ -1,13 +1,20 @@ package Mouse::Meta::Module; use Mouse::Util qw/:meta get_code_package get_code_ref load_class not_supported/; # enables strict and warnings -use Mouse::Util::TypeConstraints (); - use Carp (); use Scalar::Util (); my %METAS; +# XXX: work around a warning "useless use of a constant in void context" in 5.6.2 +if(&Mouse::Util::MOUSE_XS){ + # register meta storage for performance + Mouse::Util::__register_metaclass_storage(\%METAS, 0); + + # ensure thread safety + *CLONE = sub { Mouse::Util::__register_metaclass_storage(\%METAS, 1) }; +} + sub _metaclass_cache { # DEPRECATED my($class, $name) = @_; return $METAS{$name}; @@ -23,7 +30,19 @@ sub initialize { ||= $class->_construct_meta(package => $package_name, @args); } -sub class_of{ +sub reinitialize { + my($class, $package_name, @args) = @_; + + $package_name = $package_name->name if ref $package_name; + + ($package_name && !ref($package_name)) + || $class->throw_error("You must pass a package name and it cannot be blessed"); + + delete $METAS{$package_name}; + return $class->initialize($package_name, @args); +} + +sub _class_of{ my($class_or_instance) = @_; return undef unless defined $class_or_instance; return $METAS{ ref($class_or_instance) || $class_or_instance }; @@ -31,14 +50,14 @@ sub class_of{ # Means of accessing all the metaclasses that have # been initialized thus far -#sub get_all_metaclasses { %METAS } -sub get_all_metaclass_instances { values %METAS } -sub get_all_metaclass_names { keys %METAS } -sub get_metaclass_by_name { $METAS{$_[0]} } -#sub store_metaclass_by_name { $METAS{$_[0]} = $_[1] } -#sub weaken_metaclass { weaken($METAS{$_[0]}) } -#sub does_metaclass_exist { defined $METAS{$_[0]} } -#sub remove_metaclass_by_name { delete $METAS{$_[0]} } +#sub _get_all_metaclasses { %METAS } +sub _get_all_metaclass_instances { values %METAS } +sub _get_all_metaclass_names { keys %METAS } +sub _get_metaclass_by_name { $METAS{$_[0]} } +#sub _store_metaclass_by_name { $METAS{$_[0]} = $_[1] } +#sub _weaken_metaclass { weaken($METAS{$_[0]}) } +#sub _does_metaclass_exist { defined $METAS{$_[0]} } +#sub _remove_metaclass_by_name { delete $METAS{$_[0]} } sub name; @@ -66,9 +85,11 @@ sub get_attribute_map { # DEPRECATED sub has_attribute { exists $_[0]->{attributes}->{$_[1]} } sub get_attribute { $_[0]->{attributes}->{$_[1]} } -sub get_attribute_list{ keys %{$_[0]->{attributes}} } sub remove_attribute { delete $_[0]->{attributes}->{$_[1]} } +sub get_attribute_list{ keys %{$_[0]->{attributes}} } + + # XXX: for backward compatibility my %foreign = map{ $_ => undef } qw( Mouse Mouse::Role Mouse::Util Mouse::Util::TypeConstraints @@ -244,6 +265,8 @@ sub get_method_list { sub DESTROY{ my($self) = @_; + return if $Mouse::Util::in_global_destruction; + my $serial_id = $self->{anon_serial_id}; return if !$serial_id; @@ -290,7 +313,7 @@ Mouse::Meta::Module - The base class for Mouse::Meta::Class and Mouse::Meta::Rol =head1 VERSION -This document describes Mouse version 0.40_04 +This document describes Mouse version 0.40_09 =head1 SEE ALSO