From: Stevan Little Date: Tue, 29 Aug 2006 06:17:41 +0000 (+0000) Subject: immutability is good X-Git-Tag: 0_35~13^2~2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ce2ae40ffeddb31c70db36ca6614e7d7b9a34861;p=gitmo%2FClass-MOP.git immutability is good --- diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index b7d634c..7e450d7 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -74,7 +74,10 @@ Class::MOP::Package->meta->add_attribute( # NOTE: we need to do this in order # for the instance meta-object to # not fall into meta-circular death - 'name' => sub { (shift)->{'$:package'} } + # + # we just alias the original method + # rather than re-produce it here + 'name' => \&Class::MOP::Package::name }, init_arg => ':package', )) @@ -84,16 +87,9 @@ Class::MOP::Package->meta->add_attribute( Class::MOP::Attribute->new('%:namespace' => ( reader => { # NOTE: - # because of issues with the Perl API - # to the typeglob in some versions, we - # need to just always grab a new - # reference to the hash here. Ideally - # we could just store a ref and it would - # Just Work, but oh well :\ - 'namespace' => sub { - no strict 'refs'; - \%{$_[0]->name . '::'} - } + # we just alias the original method + # rather than re-produce it here + 'namespace' => \&Class::MOP::Package::namespace }, # NOTE: # protect this from silliness @@ -127,10 +123,10 @@ Class::MOP::Package->meta->add_method('initialize' => sub { Class::MOP::Module->meta->add_attribute( Class::MOP::Attribute->new('$:version' => ( reader => { - 'version' => sub { - my $self = shift; - ${$self->get_package_symbol('$VERSION')}; - } + # NOTE: + # we just alias the original method + # rather than re-produce it here + 'version' => \&Class::MOP::Module::version }, # NOTE: # protect this from silliness @@ -148,10 +144,10 @@ Class::MOP::Module->meta->add_attribute( Class::MOP::Module->meta->add_attribute( Class::MOP::Attribute->new('$:authority' => ( reader => { - 'authority' => sub { - my $self = shift; - ${$self->get_package_symbol('$AUTHORITY')}; - } + # NOTE: + # we just alias the original method + # rather than re-produce it here + 'authority' => \&Class::MOP::Module::authority }, # NOTE: # protect this from silliness @@ -168,8 +164,11 @@ Class::MOP::Class->meta->add_attribute( reader => { # NOTE: we need to do this in order # for the instance meta-object to - # not fall into meta-circular death - 'get_attribute_map' => sub { (shift)->{'%:attributes'} } + # not fall into meta-circular death + # + # we just alias the original method + # rather than re-produce it here + 'get_attribute_map' => \&Class::MOP::Class::get_attribute_map }, init_arg => ':attributes', default => sub { {} } @@ -179,16 +178,10 @@ Class::MOP::Class->meta->add_attribute( Class::MOP::Class->meta->add_attribute( Class::MOP::Attribute->new('%:methods' => ( reader => { - 'get_method_map' => sub { - my $self = shift; - my $map = $self->{'%:methods'}; - foreach my $symbol ($self->list_all_package_symbols('CODE')) { - my $code = $self->get_package_symbol('&' . $symbol); - next if exists $map->{$symbol} && $map->{$symbol}->body == $code; - $map->{$symbol} = $self->method_metaclass->wrap($code); - } - return $map; - } + # NOTE: + # we just alias the original method + # rather than re-produce it here + 'get_method_map' => \&Class::MOP::Class::get_method_map }, default => sub { {} } )) @@ -215,8 +208,11 @@ Class::MOP::Class->meta->add_attribute( reader => { # NOTE: we need to do this in order # for the instance meta-object to - # not fall into meta-circular death - 'instance_metaclass' => sub { (shift)->{'$:instance_metaclass'} } + # not fall into meta-circular death + # + # we just alias the original method + # rather than re-produce it here + 'instance_metaclass' => \&Class::MOP::Class::instance_metaclass }, init_arg => ':instance_metaclass', default => 'Class::MOP::Instance', @@ -237,8 +233,11 @@ Class::MOP::Attribute->meta->add_attribute( reader => { # NOTE: we need to do this in order # for the instance meta-object to - # not fall into meta-circular death - 'name' => sub { (shift)->{name} } + # not fall into meta-circular death + # + # we just alias the original method + # rather than re-produce it here + 'name' => \&Class::MOP::Attribute::name } )) ); @@ -248,8 +247,11 @@ Class::MOP::Attribute->meta->add_attribute( reader => { # NOTE: we need to do this in order # for the instance meta-object to - # not fall into meta-circular death - 'associated_class' => sub { (shift)->{associated_class} } + # not fall into meta-circular death + # + # we just alias the original method + # rather than re-produce it here + 'associated_class' => \&Class::MOP::Attribute::associated_class } )) ); diff --git a/lib/Class/MOP/Class/Immutable.pm b/lib/Class/MOP/Class/Immutable.pm index 5906784..20e5769 100644 --- a/lib/Class/MOP/Class/Immutable.pm +++ b/lib/Class/MOP/Class/Immutable.pm @@ -73,6 +73,9 @@ sub make_metaclass_immutable { ) ); } + + # now cache the method map ... + $metaclass->{'___method_map'} = $metaclass->get_method_map; bless $metaclass => $class; } @@ -135,6 +138,7 @@ sub get_meta_instance { (shift)->{'___get_meta_instance'} sub class_precedence_list { @{(shift)->{'___class_precedence_list'}} } sub compute_all_applicable_attributes { @{(shift)->{'___compute_all_applicable_attributes'}} } sub get_mutable_metaclass_name { (shift)->{'___original_class'} } +sub get_method_map { (shift)->{'___method_map'} } 1; @@ -259,6 +263,8 @@ to this method, which =item B +=item B + =back =head1 AUTHORS diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm index d34604a..16fc8ad 100644 --- a/lib/Class/MOP/Method.pm +++ b/lib/Class/MOP/Method.pm @@ -11,8 +11,10 @@ use B 'svref_2object'; our $VERSION = '0.03'; our $AUTHORITY = 'cpan:STEVAN'; -use overload '&{}' => sub { $_[0]->{body} }, - fallback => 1; +# NOTE: +# if poked in the right way, +# they should act like CODE refs. +use overload '&{}' => sub { $_[0]->{body} }, fallback => 1; # introspection @@ -33,15 +35,27 @@ sub wrap { } => blessed($class) || $class; } +## accessors + sub body { (shift)->{body} } # informational +# NOTE: +# this may not be the same name +# as the class you got it from +# This gets the package stash name +# associated with the actual CODE-ref sub package_name { my $code = (shift)->{body}; svref_2object($code)->GV->STASH->NAME; } +# NOTE: +# this may not be the same name +# as the method name it is stored +# with. This gets the name associated +# with the actual CODE-ref sub name { my $code = (shift)->{body}; svref_2object($code)->GV->NAME;