From: Stevan Little Date: Thu, 20 Apr 2006 17:58:39 +0000 (+0000) Subject: better X-Git-Tag: 0_26~11 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fed4cee789bd571326383fe4997cb5b64e0928ea;p=gitmo%2FClass-MOP.git better --- diff --git a/Changes b/Changes index c5c4c5f..5ec8315 100644 --- a/Changes +++ b/Changes @@ -15,6 +15,10 @@ Revision history for Perl extension Class-MOP. - attribute slot initialization is now the responsibility of the attribute itself, so we added a method for it called initialize_instance_slot + + * examples/ + - adjusted all the examples to use the new attribute + initialize_instance_slot method 0.24 Tues. April 11, 2006 * Class::MOP::Class diff --git a/examples/ClassEncapsulatedAttributes.pod b/examples/ClassEncapsulatedAttributes.pod index 0b86031..e7688b7 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.04'; +our $VERSION = '0.05'; use base 'Class::MOP::Class'; @@ -25,21 +25,7 @@ sub construct_instance { my $meta = $current_class->meta; foreach my $attr_name ($meta->get_attribute_list()) { my $attr = $meta->get_attribute($attr_name); - # if the attr has an init_arg, use that, otherwise, - # use the attributes name itself as the init_arg - my $init_arg = $attr->init_arg(); - # try to fetch the init arg from the %params ... - my $val; - $val = $params{$current_class}->{$init_arg} - if exists $params{$current_class} && - exists ${$params{$current_class}}{$init_arg}; - # if nothing was in the %params, we can use the - # attribute's default value (if it has one) - if (!defined $val && $attr->has_default) { - $val = $attr->default($instance); - } - # now add this to the instance structure - $instance->{$current_class}->{$attr_name} = $val; + $attr->initialize_instance_slot($meta, $instance, \%params); } } return $instance; @@ -51,10 +37,29 @@ package # hide the package from PAUSE use strict; use warnings; -our $VERSION = '0.02'; +our $VERSION = '0.03'; use base 'Class::MOP::Attribute'; +sub initialize_instance_slot { + my ($self, $class, $instance, $params) = @_; + # if the attr has an init_arg, use that, otherwise, + # use the attributes name itself as the init_arg + my $init_arg = $self->init_arg(); + # try to fetch the init arg from the %params ... + my $val; + $val = $params->{$class->name}->{$init_arg} + if exists $params->{$class->name} && + exists ${$params->{$class->name}}{$init_arg}; + # if nothing was in the %params, we can use the + # attribute's default value (if it has one) + if (!defined $val && $self->has_default) { + $val = $self->default($instance); + } + # now add this to the instance structure + $instance->{$class->name}->{$self->name} = $val; +} + sub generate_accessor_method { my ($self, $attr_name) = @_; my $class_name = $self->associated_class->name; diff --git a/examples/InsideOutClass.pod b/examples/InsideOutClass.pod index 1de1123..5242275 100644 --- a/examples/InsideOutClass.pod +++ b/examples/InsideOutClass.pod @@ -1,38 +1,4 @@ -package # hide the package from PAUSE - InsideOutClass; - -use strict; -use warnings; - -our $VERSION = '0.04'; - -use Scalar::Util 'refaddr'; - -use base 'Class::MOP::Class'; - -sub construct_instance { - my ($class, %params) = @_; - # create a scalar ref to use as - # the inside-out instance - my $instance = \(my $var); - foreach my $attr ($class->compute_all_applicable_attributes()) { - # if the attr has an init_arg, use that, otherwise, - # use the attributes name itself as the init_arg - my $init_arg = $attr->init_arg(); - # try to fetch the init arg from the %params ... - my $val; - $val = $params{$init_arg} if exists $params{$init_arg}; - # if nothing was in the %params, we can use the - # attribute's default value (if it has one) - if (!defined $val && $attr->has_default) { - $val = $attr->default($instance); - } - # now add this to the instance structure - $class->get_package_variable('%' . $attr->name)->{ refaddr($instance) } = $val; - } - return $instance; -} package # hide the package from PAUSE InsideOutClass::Attribute; @@ -40,13 +6,30 @@ package # hide the package from PAUSE use strict; use warnings; -our $VERSION = '0.04'; +our $VERSION = '0.05'; use Carp 'confess'; use Scalar::Util 'refaddr'; use base 'Class::MOP::Attribute'; +sub initialize_instance_slot { + my ($self, $class, $instance, $params) = @_; + # if the attr has an init_arg, use that, otherwise, + # use the attributes name itself as the init_arg + my $init_arg = $self->init_arg(); + # try to fetch the init arg from the %params ... + my $val; + $val = $params->{$init_arg} if exists $params->{$init_arg}; + # if nothing was in the %params, we can use the + # attribute's default value (if it has one) + if (!defined $val && $self->has_default) { + $val = $self->default($instance); + } + # now add this to the instance structure + $class->get_package_variable('%' . $self->name)->{ refaddr($instance) } = $val; +} + sub generate_accessor_method { my ($self, $attr_name) = @_; $attr_name = ($self->associated_class->name . '::' . $attr_name); @@ -94,7 +77,7 @@ InsideOutClass - A set of example metaclasses which implement the Inside-Out tec package Foo; - use metaclass 'InsideOutClass' => ( + use metaclass 'Class::MOP::Class' => ( # tell our metaclass to use the # InsideOut attribute metclass # to construct all it's attributes @@ -119,19 +102,12 @@ This is a set of example metaclasses which implement the Inside-Out class technique. What follows is a brief explaination of the code found in this module. -First step is to subclass B and override the -C method. The default C -will create a HASH reference using the parameters and attribute -default values. Since inside-out objects don't use HASH refs, and -use package variables instead, we need to write code to handle -this difference. - -The next step is to create the subclass of B -and override the method generation code. This requires overloading -C, C, -C and C. All -other aspects are taken care of with the existing B -infastructure. +We must create a subclass of B and override +the instance initialization and method generation code. This requires +overloading C, C, +C, C and +C. All other aspects are taken care of with +the existing B infastructure. And that is pretty much all. Of course I am ignoring need for inside-out objects to be C-ed, and some other details as diff --git a/examples/LazyClass.pod b/examples/LazyClass.pod index 690007f..fc5ee70 100644 --- a/examples/LazyClass.pod +++ b/examples/LazyClass.pod @@ -1,32 +1,5 @@ package # hide the package from PAUSE - LazyClass; - -use strict; -use warnings; - -our $VERSION = '0.02'; - -use base 'Class::MOP::Class'; - -sub construct_instance { - my ($class, %params) = @_; - my $instance = {}; - foreach my $attr ($class->compute_all_applicable_attributes()) { - # if the attr has an init_arg, use that, otherwise, - # use the attributes name itself as the init_arg - my $init_arg = $attr->init_arg(); - # try to fetch the init arg from the %params ... - my $val; - $val = $params{$init_arg} if exists $params{$init_arg}; - # now add this to the instance structure - # only if we have found a value at all - $instance->{$attr->name} = $val if defined $val; - } - return $instance; -} - -package # hide the package from PAUSE LazyClass::Attribute; use strict; @@ -34,10 +7,24 @@ use warnings; use Carp 'confess'; -our $VERSION = '0.02'; +our $VERSION = '0.03'; use base 'Class::MOP::Attribute'; +sub initialize_instance_slot { + my ($self, $class, $instance, $params) = @_; + # if the attr has an init_arg, use that, otherwise, + # use the attributes name itself as the init_arg + my $init_arg = $self->init_arg(); + # try to fetch the init arg from the %params ... + my $val; + $val = $params->{$init_arg} if exists $params->{$init_arg}; + # now add this to the instance structure + # only if we have found a value at all + $instance->{$self->name} = $val if defined $val; +} + + sub generate_accessor_method { my ($self, $attr_name) = @_; sub { @@ -80,7 +67,7 @@ LazyClass - An example metaclass with lazy initialization package BinaryTree; - use metaclass 'LazyClass' => ( + use metaclass 'Class::MOP::Class' => ( ':attribute_metaclass' => 'LazyClass::Attribute' ); diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index 305d70e..6f70615 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -61,7 +61,7 @@ sub clone { } sub initialize_instance_slot { - my ($self, $instance, $params) = @_; + my ($self, $class, $instance, $params) = @_; my $init_arg = $self->init_arg(); # try to fetch the init arg from the %params ... my $val; diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index 26f5e12..91fcf3b 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -177,7 +177,7 @@ sub construct_instance { my ($class, %params) = @_; my $instance = {}; foreach my $attr ($class->compute_all_applicable_attributes()) { - $attr->initialize_instance_slot($instance, \%params); + $attr->initialize_instance_slot($class, $instance, \%params); } return $instance; } diff --git a/t/102_InsideOutClass_test.t b/t/102_InsideOutClass_test.t index fcd877d..9e25568 100644 --- a/t/102_InsideOutClass_test.t +++ b/t/102_InsideOutClass_test.t @@ -14,7 +14,7 @@ BEGIN { { package Foo; - use metaclass 'InsideOutClass' => ( + use metaclass 'Class::MOP::Class' => ( ':attribute_metaclass' => 'InsideOutClass::Attribute' ); diff --git a/t/106_LazyClass_test.t b/t/106_LazyClass_test.t index 6a75aac..877c845 100644 --- a/t/106_LazyClass_test.t +++ b/t/106_LazyClass_test.t @@ -14,7 +14,7 @@ BEGIN { { package BinaryTree; - use metaclass 'LazyClass' => ( + use metaclass 'Class::MOP::Class' => ( ':attribute_metaclass' => 'LazyClass::Attribute' );