X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FClass%2FImmutable%2FTrait.pm;h=0c8a50528955553b977cd11f12a781c071fa5ce4;hb=78f6e9c6a73ff3dd985a1cebaafd0b81e543beb8;hp=902e19b282bb12ca21c4aa24a10c2382ba8e0c24;hpb=9e25e01f9853de8ff1d02b0f06242c4ec97f37c3;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Class/Immutable/Trait.pm b/lib/Class/MOP/Class/Immutable/Trait.pm index 902e19b..0c8a505 100644 --- a/lib/Class/MOP/Class/Immutable/Trait.pm +++ b/lib/Class/MOP/Class/Immutable/Trait.pm @@ -8,91 +8,86 @@ use MRO::Compat; use Carp 'confess'; use Scalar::Util 'blessed', 'weaken'; -our $VERSION = '0.86'; +our $VERSION = '0.88'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; -sub meta { - my $self = shift; - - # if it is not blessed, then someone is asking - # for the meta of Class::MOP::Class:;Immutable::Trait - return Class::MOP::Class->initialize($self) unless blessed($self); - - # otherwise, they are asking for the metaclass - # which has been made immutable, which is itself - # except in the cases where it is a metaclass itself - # that has been made immutable and for that we need - # to dig a bit ... - - if ( $self->isa('Class::MOP::Class') ) { - - # except this is a lie... oh well - return Class::MOP::class_of( $self->get_mutable_metaclass_name ); - } - else { - return $self; - } -} - # the original class of the metaclass instance sub get_mutable_metaclass_name { $_[0]{__immutable}{original_class} } sub immutable_options { %{ $_[0]{__immutable}{options} } } -sub is_mutable {0} -sub is_immutable {1} +sub is_mutable { 0 } +sub is_immutable { 1 } sub superclasses { - confess "This method is read-only" if @_ > 1; - $_[0]->next::method; + my $orig = shift; + my $self = shift; + confess "This method is read-only" if @_; + $self->$orig; } sub _immutable_cannot_call { Carp::confess "This method cannot be called on an immutable instance"; } -sub add_method { shift->_immutable_cannot_call } -sub alias_method { shift->_immutable_cannot_call } -sub remove_method { shift->_immutable_cannot_call } -sub add_attribute { shift->_immutable_cannot_call } -sub remove_attribute { shift->_immutable_cannot_call } -sub remove_package_symbol { shift->_immutable_cannot_call } +sub add_method { _immutable_cannot_call() } +sub alias_method { _immutable_cannot_call() } +sub remove_method { _immutable_cannot_call() } +sub add_attribute { _immutable_cannot_call() } +sub remove_attribute { _immutable_cannot_call() } +sub remove_package_symbol { _immutable_cannot_call() } sub class_precedence_list { - @{ $_[0]{__immutable}{class_precedence_list} - ||= [ shift->next::method ] }; + my $orig = shift; + my $self = shift; + @{ $self->{__immutable}{class_precedence_list} + ||= [ $self->$orig ] }; } sub linearized_isa { - @{ $_[0]{__immutable}{linearized_isa} ||= [ shift->next::method ] }; + my $orig = shift; + my $self = shift; + @{ $self->{__immutable}{linearized_isa} ||= [ $self->$orig ] }; } sub get_all_methods { - @{ $_[0]{__immutable}{get_all_methods} ||= [ shift->next::method ] }; + my $orig = shift; + my $self = shift; + @{ $self->{__immutable}{get_all_methods} ||= [ $self->$orig ] }; } sub get_all_method_names { - @{ $_[0]{__immutable}{get_all_method_names} ||= [ shift->next::method ] }; + my $orig = shift; + my $self = shift; + @{ $self->{__immutable}{get_all_method_names} ||= [ $self->$orig ] }; } sub get_all_attributes { - @{ $_[0]{__immutable}{get_all_attributes} ||= [ shift->next::method ] }; + my $orig = shift; + my $self = shift; + @{ $self->{__immutable}{get_all_attributes} ||= [ $self->$orig ] }; } sub get_meta_instance { - $_[0]{__immutable}{get_meta_instance} ||= shift->next::method; + my $orig = shift; + my $self = shift; + $self->{__immutable}{get_meta_instance} ||= $self->$orig; } sub get_method_map { - $_[0]{__immutable}{get_method_map} ||= shift->next::method; + my $orig = shift; + my $self = shift; + $self->{__immutable}{get_method_map} ||= $self->$orig; } sub add_package_symbol { + my $orig = shift; + my $self = shift; confess "Cannot add package symbols to an immutable metaclass" - unless ( caller(1) )[3] eq 'Class::MOP::Package::get_package_symbol'; + unless ( caller(3) )[3] eq 'Class::MOP::Package::get_package_symbol'; - shift->next::method(@_); + $self->$orig(@_); } 1;