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 $instance = $class->get_meta_instance->create_instance();
24 # initialize *ALL* attributes, including masked ones (as opposed to applicable)
25 foreach my $current_class ($class->class_precedence_list()) {
26 my $meta = $current_class->meta;
27 foreach my $attr_name ($meta->get_attribute_list()) {
28 my $attr = $meta->get_attribute($attr_name);
29 $attr->initialize_instance_slot($instance, \%params);
36 package # hide the package from PAUSE
37 ClassEncapsulatedAttributes::Attribute;
42 our $VERSION = '0.04';
44 use base 'Class::MOP::Attribute';
46 # alter the way parameters are specified
47 sub initialize_instance_slot {
48 my ($self, $instance, $params) = @_;
49 # if the attr has an init_arg, use that, otherwise,
50 # use the attributes name itself as the init_arg
51 my $init_arg = $self->init_arg();
52 # try to fetch the init arg from the %params ...
53 my $class = $self->associated_class;
55 $val = $params->{$class->name}->{$init_arg}
56 if exists $params->{$class->name} &&
57 exists ${$params->{$class->name}}{$init_arg};
58 # if nothing was in the %params, we can use the
59 # attribute's default value (if it has one)
60 if (!defined $val && $self->has_default) {
61 $val = $self->default($instance);
64 # now add this to the instance structure
65 $self->associated_class
67 ->set_slot_value($instance, $self->name, $val);
72 return ($self->associated_class->name . '::' . $self->SUPER::name)
83 ClassEncapsulatedAttributes - A set of example metaclasses with class encapsulated attributes
89 use metaclass 'ClassEncapsulatedAttributes';
91 Foo->meta->add_attribute('foo' => (
92 accessor => 'Foo_foo',
93 default => 'init in FOO'
98 $class->meta->new_object(@_);
104 # duplicate the attribute name here
105 Bar->meta->add_attribute('foo' => (
106 accessor => 'Bar_foo',
107 default => 'init in BAR'
110 # ... later in other code ...
112 my $bar = Bar->new();
113 prints $bar->Bar_foo(); # init in BAR
114 prints $bar->Foo_foo(); # init in FOO
119 'Foo' => { 'foo' => 'Foo::foo' },
120 'Bar' => { 'foo' => 'Bar::foo' }
123 prints $bar->Bar_foo(); # Foo::foo
124 prints $bar->Foo_foo(); # Bar::foo
128 This is an example metaclass which encapsulates a class's
129 attributes on a per-class basis. This means that there is no
130 possibility of name clashes with inherited attributes. This
131 is similar to how C++ handles its data members.
133 =head1 ACKNOWLEDGEMENTS
135 Thanks to Yuval "nothingmuch" Kogman for the idea for this example.
139 Stevan Little E<lt>stevan@iinteractive.comE<gt>
141 =head1 COPYRIGHT AND LICENSE
143 Copyright 2006 by Infinity Interactive, Inc.
145 L<http://www.iinteractive.com>
147 This library is free software; you can redistribute it and/or modify
148 it under the same terms as Perl itself.