2 package # hide the package from PAUSE
3 ClassEncapsulatedAttributes;
10 use base 'Class::MOP::Class';
13 (shift)->SUPER::initialize(@_,
14 # use the custom attribute metaclass here
15 ':attribute_metaclass' => 'ClassEncapsulatedAttributes::Attribute',
19 sub construct_instance {
20 my ($class, %params) = @_;
22 my $meta_instance = $class->get_meta_instance;
23 my $instance = $meta_instance->create_instance();
25 # initialize *ALL* attributes, including masked ones (as opposed to applicable)
26 foreach my $current_class ($class->class_precedence_list()) {
27 my $meta = $current_class->meta;
28 foreach my $attr_name ($meta->get_attribute_list()) {
29 my $attr = $meta->get_attribute($attr_name);
30 $attr->initialize_instance_slot($meta_instance, $instance, \%params);
37 package # hide the package from PAUSE
38 ClassEncapsulatedAttributes::Attribute;
43 our $VERSION = '0.04';
45 use base 'Class::MOP::Attribute';
47 # alter the way parameters are specified
48 sub initialize_instance_slot {
49 my ($self, $meta_instance, $instance, $params) = @_;
50 # if the attr has an init_arg, use that, otherwise,
51 # use the attributes name itself as the init_arg
52 my $init_arg = $self->init_arg();
53 # try to fetch the init arg from the %params ...
54 my $class = $self->associated_class;
56 $val = $params->{$class->name}->{$init_arg}
57 if exists $params->{$class->name} &&
58 exists ${$params->{$class->name}}{$init_arg};
59 # if nothing was in the %params, we can use the
60 # attribute's default value (if it has one)
61 if (!defined $val && $self->has_default) {
62 $val = $self->default($instance);
65 # now add this to the instance structure
66 $meta_instance->set_slot_value($instance, $self->name, $val);
71 return ($self->associated_class->name . '::' . $self->SUPER::name)
82 ClassEncapsulatedAttributes - A set of example metaclasses with class encapsulated attributes
88 use metaclass 'ClassEncapsulatedAttributes';
90 Foo->meta->add_attribute('foo' => (
91 accessor => 'Foo_foo',
92 default => 'init in FOO'
97 $class->meta->new_object(@_);
103 # duplicate the attribute name here
104 Bar->meta->add_attribute('foo' => (
105 accessor => 'Bar_foo',
106 default => 'init in BAR'
109 # ... later in other code ...
111 my $bar = Bar->new();
112 prints $bar->Bar_foo(); # init in BAR
113 prints $bar->Foo_foo(); # init in FOO
118 'Foo' => { 'foo' => 'Foo::foo' },
119 'Bar' => { 'foo' => 'Bar::foo' }
122 prints $bar->Bar_foo(); # Foo::foo
123 prints $bar->Foo_foo(); # Bar::foo
127 This is an example metaclass which encapsulates a class's
128 attributes on a per-class basis. This means that there is no
129 possibility of name clashes with inherited attributes. This
130 is similar to how C++ handles its data members.
132 =head1 ACKNOWLEDGEMENTS
134 Thanks to Yuval "nothingmuch" Kogman for the idea for this example.
138 Stevan Little E<lt>stevan@iinteractive.comE<gt>
140 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
142 =head1 COPYRIGHT AND LICENSE
144 Copyright 2006 by Infinity Interactive, Inc.
146 L<http://www.iinteractive.com>
148 This library is free software; you can redistribute it and/or modify
149 it under the same terms as Perl itself.