From: Stevan Little Date: Mon, 27 Nov 2006 01:22:46 +0000 (+0000) Subject: tweaking a little here and there X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8ea9d56063946421d3a822fcd539620b42f34537;p=gitmo%2FClass-MOP.git tweaking a little here and there --- diff --git a/Changes b/Changes index 8268375..aee6cb0 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,31 @@ Revision history for Perl extension Class-MOP. +0.37_001 + + ~~ GLOBAL CHANGES ~~ + - All attribute names are now consistent and follow Perl 6 + style (prefixed with the sigil, and ! as the twigil for + private attrs). This should not affect any code, unless + you broke encapsulation, in which case, it is your problem + anyway. + + !! Class::MOP::Class::Immutable has been removed + + * Class::MOP::Method::Constructor + - this has been moved out of Class::MOP::Class::Immutable + and is a proper subclass of Class::MOP::Method now. + + * Class::MOP::Class + - this module now uses Class::MOP::Immutable for the + immutable transformation instead of + Class::MOP::Class::Immutable. + + + Class::MOP::Immutable + - this module now controls the transformation from a mutable + to an immutable version of the class. Docs for this will + be coming eventually. + + 0.36 Sun. Nov. 5, 2006 * Class::MOP::Class - added a few 'no warnings' lines to keep annoying diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index 9d72cbd..d741ee2 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -438,20 +438,8 @@ Class::MOP::Method::Constructor->meta->add_attribute( ); Class::MOP::Method::Constructor->meta->add_attribute( - Class::MOP::Attribute->new('$!meta_instance' => ( - init_arg => 'meta_instance', - reader => { - 'meta_instance' => \&Class::MOP::Method::Constructor::meta_instance - }, - )) -); - -Class::MOP::Method::Constructor->meta->add_attribute( - Class::MOP::Attribute->new('@!attributes' => ( - init_arg => 'attributes', - reader => { - 'attributes' => \&Class::MOP::Method::Constructor::attributes - }, + Class::MOP::Attribute->new('$!metaclass' => ( + init_arg => 'metaclass', )) ); diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index db13b1a..2935d35 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -122,7 +122,7 @@ sub is_default_a_coderef { sub default { my ($self, $instance) = @_; - if ($instance && $self->is_default_a_coderef) { + if (defined $instance && $self->is_default_a_coderef) { # if the default is a CODE ref, then # we pass in the instance and default # can return a value based on that diff --git a/lib/Class/MOP/Immutable.pm b/lib/Class/MOP/Immutable.pm index c16ddda..1af082a 100644 --- a/lib/Class/MOP/Immutable.pm +++ b/lib/Class/MOP/Immutable.pm @@ -16,9 +16,9 @@ sub new { my ($class, $metaclass, $options) = @_; my $self = bless { - metaclass => $metaclass, - options => $options, - immutable_metaclass => undef, + '$!metaclass' => $metaclass, + '%!options' => $options, + '$!immutable_metaclass' => undef, } => $class; # NOTE: @@ -29,9 +29,9 @@ sub new { return $self; } -sub immutable_metaclass { (shift)->{immutable_metaclass} } -sub metaclass { (shift)->{metaclass} } -sub options { (shift)->{options} } +sub immutable_metaclass { (shift)->{'$!immutable_metaclass'} } +sub metaclass { (shift)->{'$!metaclass'} } +sub options { (shift)->{'%!options'} } sub create_immutable_metaclass { my $self = shift; @@ -41,7 +41,7 @@ sub create_immutable_metaclass { # metaclass is just a anon-class # which shadows the methods # appropriately - $self->{immutable_metaclass} = Class::MOP::Class->create_anon_class( + $self->{'$!immutable_metaclass'} = Class::MOP::Class->create_anon_class( superclasses => [ blessed($self->metaclass) ], methods => $self->create_methods_for_immutable_metaclass, ); @@ -71,6 +71,7 @@ sub make_metaclass_immutable { $options{inline_accessors} = 1 unless exists $options{inline_accessors}; $options{inline_constructor} = 1 unless exists $options{inline_constructor}; + $options{inline_destructor} = 0 unless exists $options{inline_destructor}; $options{constructor_name} = 'new' unless exists $options{constructor_name}; $options{debug} = 0 unless exists $options{debug}; @@ -88,15 +89,33 @@ sub make_metaclass_immutable { $metaclass->add_method( $options{constructor_name}, $constructor_class->new( - metaclass => $metaclass, - options => \%options, - # deprecate them ... - meta_instance => $metaclass->get_meta_instance, - attributes => [ $metaclass->compute_all_applicable_attributes ] + options => \%options, + metaclass => $metaclass, ) ) unless $metaclass->has_method($options{constructor_name}); } + if ($options{inline_destructor}) { + (exists $options{destructor_class}) + || confess "The 'inline_destructor' option is present, but " + . "no destructor class was specified"; + + my $destructor_class = $options{destructor_class}; + + my $destructor = $destructor_class->new( + options => \%options, + metaclass => $metaclass, + ); + + $metaclass->add_method('DESTROY' => $destructor) + # NOTE: + # we allow the destructor to determine + # if it is needed or not, it can perform + # all sorts of checks because it has the + # metaclass instance + if $destructor->is_needed; + } + my $memoized_methods = $self->options->{memoize}; foreach my $method_name (keys %{$memoized_methods}) { my $type = $memoized_methods->{$method_name}; diff --git a/lib/Class/MOP/Method/Constructor.pm b/lib/Class/MOP/Method/Constructor.pm index 2d4c99a..748c72a 100644 --- a/lib/Class/MOP/Method/Constructor.pm +++ b/lib/Class/MOP/Method/Constructor.pm @@ -19,40 +19,40 @@ sub new { (exists $options{options} && ref $options{options} eq 'HASH') || confess "You must pass a hash of options"; - (blessed $options{meta_instance} && $options{meta_instance}->isa('Class::MOP::Instance')) - || confess "You must supply a meta-instance"; - - (exists $options{attributes} && ref $options{attributes} eq 'ARRAY') - || confess "You must pass an array of options"; - - (blessed($_) && $_->isa('Class::MOP::Attribute')) - || confess "You must supply a list of attributes which is a 'Class::MOP::Attribute' instance" - for @{$options{attributes}}; + (blessed $options{metaclass} && $options{metaclass}->isa('Class::MOP::Class')) + || confess "You must pass a metaclass instance"; my $self = bless { # from our superclass '&!body' => undef, # specific to this subclass - '%!options' => $options{options}, - '$!meta_instance' => $options{meta_instance}, - '@!attributes' => $options{attributes}, + '$!metaclass' => $options{metaclass}, + '%!options' => $options{options}, } => $class; # we don't want this creating # a cycle in the code, if not # needed - weaken($self->{'$!meta_instance'}); + weaken($self->{'$!metaclass'}); $self->intialize_body; return $self; } +## predicates + +# NOTE: +# if it is blessed into this class, +# then it is always inlined, that is +# pretty much what this class is for. +sub is_inline { 1 } + ## accessors -sub options { (shift)->{'%!options'} } -sub meta_instance { (shift)->{'$!meta_instance'} } -sub attributes { (shift)->{'@!attributes'} } +sub options { (shift)->{'%!options'} } +sub meta_instance { (shift)->{'$!metaclass'}->get_meta_instance } +sub attributes { [ (shift)->{'$!metaclass'}->compute_all_applicable_attributes ] } ## method @@ -142,6 +142,8 @@ Class::MOP::Method::Constructor - Method Meta Object for constructors =item B +=item B + =item B =item B