X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=examples%2FClassEncapsulatedAttributes.pod;h=c1ddae88b83ec6be5c041af673fc4de6d623076b;hb=da34f0548381c10dba4299089c07ffe64a0706e1;hp=44e279b159f86dc707f91e12afc6be5c9faa2d4f;hpb=351bd7d4e81d6a359feac9b128bd975e06668990;p=gitmo%2FClass-MOP.git diff --git a/examples/ClassEncapsulatedAttributes.pod b/examples/ClassEncapsulatedAttributes.pod index 44e279b..c1ddae8 100644 --- a/examples/ClassEncapsulatedAttributes.pod +++ b/examples/ClassEncapsulatedAttributes.pod @@ -5,44 +5,33 @@ package # hide the package from PAUSE use strict; use warnings; -use Class::MOP 'meta'; - -our $VERSION = '0.02'; +our $VERSION = '0.06'; use base 'Class::MOP::Class'; sub initialize { (shift)->SUPER::initialize(@_, # use the custom attribute metaclass here - ':attribute_metaclass' => 'ClassEncapsulatedAttributes::Attribute' + 'attribute_metaclass' => 'ClassEncapsulatedAttributes::Attribute', ); } sub construct_instance { my ($class, %params) = @_; - my $instance = {}; + + my $meta_instance = $class->get_meta_instance; + my $instance = $meta_instance->create_instance(); + + # initialize *ALL* attributes, including masked ones (as opposed to applicable) foreach my $current_class ($class->class_precedence_list()) { - $instance->{$current_class} = {} - unless exists $instance->{$current_class}; - my $meta = $class->initialize($current_class); + 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->has_init_arg() ? $attr->init_arg() : $attr->name; - # 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) - $val ||= $attr->default($instance) if $attr->has_default(); - # now add this to the instance structure - $instance->{$current_class}->{$attr_name} = $val; + $attr->initialize_instance_slot($meta_instance, $instance, \%params); } } - return $instance; + + return $instance; } package # hide the package from PAUSE @@ -51,47 +40,37 @@ package # hide the package from PAUSE use strict; use warnings; -use Class::MOP 'meta'; - -our $VERSION = '0.01'; +our $VERSION = '0.04'; use base 'Class::MOP::Attribute'; -sub generate_accessor_method { - my ($self, $attr_name) = @_; - my $class_name = $self->associated_class->name; - eval qq{sub { - \$_[0]->{'$class_name'}->{'$attr_name'} = \$_[1] if scalar(\@_) == 2; - \$_[0]->{'$class_name'}->{'$attr_name'}; - }}; +# alter the way parameters are specified +sub initialize_instance_slot { + my ($self, $meta_instance, $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 $class = $self->associated_class; + 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 + $meta_instance->set_slot_value($instance, $self->name, $val); } -sub generate_reader_method { - my ($self, $attr_name) = @_; - my $class_name = $self->associated_class->name; - eval qq{sub { - \$_[0]->{'$class_name'}->{'$attr_name'}; - }}; +sub name { + my $self = shift; + return ($self->associated_class->name . '::' . $self->SUPER::name) } -sub generate_writer_method { - my ($self, $attr_name) = @_; - my $class_name = $self->associated_class->name; - eval qq{sub { - \$_[0]->{'$class_name'}->{'$attr_name'} = \$_[1]; - }}; -} - -sub generate_predicate_method { - my ($self, $attr_name) = @_; - my $class_name = $self->associated_class->name; - eval qq{sub { - defined \$_[0]->{'$class_name'}->{'$attr_name'} ? 1 : 0; - }}; -} - -## &remove_attribute is left as an exercise for the reader :) - 1; __END__ @@ -106,7 +85,7 @@ ClassEncapsulatedAttributes - A set of example metaclasses with class encapsulat package Foo; - sub meta { ClassEncapsulatedAttributes->initialize($_[0]) } + use metaclass 'ClassEncapsulatedAttributes'; Foo->meta->add_attribute('foo' => ( accessor => 'Foo_foo', @@ -115,7 +94,7 @@ ClassEncapsulatedAttributes - A set of example metaclasses with class encapsulat sub new { my $class = shift; - bless $class->meta->construct_instance(@_) => $class; + $class->meta->new_object(@_); } package Bar; @@ -154,13 +133,15 @@ is similar to how C++ handles its data members. Thanks to Yuval "nothingmuch" Kogman for the idea for this example. -=head1 AUTHOR +=head1 AUTHORS Stevan Little Estevan@iinteractive.comE +Yuval Kogman Enothingmuch@woobling.comE + =head1 COPYRIGHT AND LICENSE -Copyright 2006 by Infinity Interactive, Inc. +Copyright 2006-2008 by Infinity Interactive, Inc. L