From: Stevan Little Date: Thu, 27 Apr 2006 03:09:16 +0000 (+0000) Subject: instance-protocol X-Git-Tag: 0_29_02~46 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2bab2be690fec92f81ec4174ae83e09bde362ca7;hp=839ea97307cde7e936bff72d3f76d6213b9883a9;p=gitmo%2FClass-MOP.git instance-protocol --- diff --git a/Changes b/Changes index b5d2e4d..27c5472 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,14 @@ Revision history for Perl extension Class-MOP. +0.30 + * Class::MOP::Instance + - added new instance construction protocol + - added tests for this + - changed all relevant modules and examples + - Class::MOP::Class + - Class::MOP::Attribute + - examples/* + 0.26 Mon. April 24, 2006 * Class::MOP::Class - added find_attribute_by_name method diff --git a/README b/README index 338ce3b..2443f43 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ -Class::MOP version 0.26 +Class::MOP version 0.30 =========================== See the individual module documentation for more information diff --git a/examples/ClassEncapsulatedAttributes.pod b/examples/ClassEncapsulatedAttributes.pod index e14a17a..8e84dbd 100644 --- a/examples/ClassEncapsulatedAttributes.pod +++ b/examples/ClassEncapsulatedAttributes.pod @@ -5,7 +5,7 @@ package # hide the package from PAUSE use strict; use warnings; -our $VERSION = '0.05'; +our $VERSION = '0.06'; use base 'Class::MOP::Class'; @@ -37,7 +37,7 @@ package # hide the package from PAUSE use strict; use warnings; -our $VERSION = '0.03'; +our $VERSION = '0.04'; use base 'Class::MOP::Attribute'; @@ -57,7 +57,10 @@ sub initialize_instance_slot { $val = $self->default($meta_instance->get_instance); } # now add this to the instance structure - $meta_instance->get_slot_value($class->name)->{$self->name} = $val; + $meta_instance->get_slot_value( + $meta_instance->get_instance, + $class->name + )->{$self->name} = $val; } sub generate_accessor_method { diff --git a/examples/InsideOutClass.pod b/examples/InsideOutClass.pod index 779cc77..ec1d21b 100644 --- a/examples/InsideOutClass.pod +++ b/examples/InsideOutClass.pod @@ -6,7 +6,7 @@ package # hide the package from PAUSE use strict; use warnings; -our $VERSION = '0.05'; +our $VERSION = '0.06'; use Carp 'confess'; use Scalar::Util 'refaddr'; diff --git a/examples/LazyClass.pod b/examples/LazyClass.pod index 1847939..3ce659b 100644 --- a/examples/LazyClass.pod +++ b/examples/LazyClass.pod @@ -7,7 +7,7 @@ use warnings; use Carp 'confess'; -our $VERSION = '0.03'; +our $VERSION = '0.04'; use base 'Class::MOP::Attribute'; diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index a08426f..20e02b6 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -11,7 +11,7 @@ use Class::MOP::Class; use Class::MOP::Attribute; use Class::MOP::Method; -our $VERSION = '0.26'; +our $VERSION = '0.30'; ## ---------------------------------------------------------------------------- ## Setting up our environment ... @@ -70,6 +70,14 @@ Class::MOP::Class->meta->add_attribute( )) ); +Class::MOP::Class->meta->add_attribute( + Class::MOP::Attribute->new('$:instance_metaclass' => ( + reader => 'instance_metaclass', + init_arg => ':instance_metaclass', + default => 'Class::MOP::Instance', + )) +); + ## Class::MOP::Attribute Class::MOP::Attribute->meta->add_attribute( diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index f8cfe64..0677448 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -7,7 +7,7 @@ use warnings; use Carp 'confess'; use Scalar::Util 'blessed', 'reftype', 'weaken'; -our $VERSION = '0.07'; +our $VERSION = '0.08'; sub meta { require Class::MOP::Class; @@ -128,28 +128,36 @@ sub detach_from_class { sub generate_accessor_method { my ($self, $attr_name) = @_; + my $meta_instance = $self->associated_class->instance_metaclass; sub { - $_[0]->{$attr_name} = $_[1] if scalar(@_) == 2; - $_[0]->{$attr_name}; + $meta_instance->set_slot_value($_[0], $attr_name, $_[1]) if scalar(@_) == 2; + $meta_instance->get_slot_value($_[0], $attr_name); }; } sub generate_reader_method { my ($self, $attr_name) = @_; + my $meta_instance = $self->associated_class->instance_metaclass; sub { confess "Cannot assign a value to a read-only accessor" if @_ > 1; - $_[0]->{$attr_name}; + $meta_instance->get_slot_value($_[0], $attr_name); }; } sub generate_writer_method { my ($self, $attr_name) = @_; - sub { $_[0]->{$attr_name} = $_[1] }; + my $meta_instance = $self->associated_class->instance_metaclass; + sub { + $meta_instance->set_slot_value($_[0], $attr_name, $_[1]); + }; } sub generate_predicate_method { my ($self, $attr_name) = @_; - sub { defined $_[0]->{$attr_name} ? 1 : 0 }; + my $meta_instance = $self->associated_class->instance_metaclass; + sub { + $meta_instance->has_slot_value($_[0], $attr_name); + }; } sub process_accessors { diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index b32e02a..5ba6570 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -9,7 +9,7 @@ use Scalar::Util 'blessed', 'reftype'; use Sub::Name 'subname'; use B 'svref_2object'; -our $VERSION = '0.13'; +our $VERSION = '0.14'; use Class::MOP::Instance; @@ -67,7 +67,8 @@ sub meta { Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) } '$:package' => $package_name, '%:attributes' => {}, '$:attribute_metaclass' => $options{':attribute_metaclass'} || 'Class::MOP::Attribute', - '$:method_metaclass' => $options{':method_metaclass'} || 'Class::MOP::Method', + '$:method_metaclass' => $options{':method_metaclass'} || 'Class::MOP::Method', + '$:instance_metaclass' => $options{':instance_metaclass'} || 'Class::MOP::Instance', } => $class; } else { @@ -160,6 +161,7 @@ sub name { $_[0]->{'$:package'} } sub get_attribute_map { $_[0]->{'%:attributes'} } sub attribute_metaclass { $_[0]->{'$:attribute_metaclass'} } sub method_metaclass { $_[0]->{'$:method_metaclass'} } +sub instance_metaclass { $_[0]->{'$:instance_metaclass'} } # Instance Construction & Cloning @@ -177,7 +179,7 @@ sub new_object { sub construct_instance { my ($class, %params) = @_; - my $meta_instance = Class::MOP::Instance->new($class); + my $meta_instance = $class->instance_metaclass->new($class); foreach my $attr ($class->compute_all_applicable_attributes()) { $attr->initialize_instance_slot($class, $meta_instance, \%params); } @@ -777,6 +779,8 @@ to use them or not. =over 4 +=item B + =item B This is a convience method for creating a new object of the class, and diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm index 1bd598c..9d47700 100644 --- a/lib/Class/MOP/Instance.pm +++ b/lib/Class/MOP/Instance.pm @@ -33,11 +33,19 @@ sub has_slot { } sub get_slot_value { - my ($self, $slot_name) = @_; - return $self->{instance}->{$slot_name}; + my ($self, $instance, $slot_name) = @_; + return $instance->{$slot_name}; } -*set_slot_value = \&add_slot; +sub set_slot_value { + my ($self, $instance, $slot_name, $value) = @_; + $instance->{$slot_name} = $value; +} + +sub has_slot_value { + my ($self, $instance, $slot_name) = @_; + defined $instance->{$slot_name} ? 1 : 0; +} sub get_instance { (shift)->{instance} } @@ -69,6 +77,8 @@ Class::MOP::Instance - Instance Meta Object =item B +=item B + =item B =back diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t index a59ef86..febc677 100644 --- a/t/010_self_introspection.t +++ b/t/010_self_introspection.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 136; +use Test::More tests => 140; use Test::Exception; BEGIN { @@ -26,6 +26,7 @@ my @methods = qw( initialize create create_anon_class + instance_metaclass new_object clone_object construct_instance construct_class_instance clone_instance check_metaclass_compatability @@ -73,7 +74,13 @@ foreach my $non_method_name (qw( # check for the right attributes -my @attributes = ('$:package', '%:attributes', '$:attribute_metaclass', '$:method_metaclass'); +my @attributes = ( + '$:package', + '%:attributes', + '$:attribute_metaclass', + '$:method_metaclass', + '$:instance_metaclass' +); is_deeply( [ sort @attributes ], diff --git a/t/060_instance.t b/t/060_instance.t new file mode 100644 index 0000000..5dbbde1 --- /dev/null +++ b/t/060_instance.t @@ -0,0 +1,14 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 1; +use Test::Exception; + +use Scalar::Util 'reftype', 'isweak'; + +BEGIN { + use_ok('Class::MOP::Instance'); +} +