this has worked for a while
[gitmo/Moose.git] / examples / ClassEncapsulatedAttributes.pod
CommitLineData
38bf2a25 1
2package # hide the package from PAUSE
3 ClassEncapsulatedAttributes;
4
5use strict;
6use warnings;
7
8our $VERSION = '0.06';
9
10use base 'Class::MOP::Class';
11
12sub initialize {
13 (shift)->SUPER::initialize(@_,
14 # use the custom attribute metaclass here
15 'attribute_metaclass' => 'ClassEncapsulatedAttributes::Attribute',
16 );
17}
18
19sub construct_instance {
20 my ($class, %params) = @_;
21
22 my $meta_instance = $class->get_meta_instance;
23 my $instance = $meta_instance->create_instance();
24
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);
31 }
32 }
33
34 return $instance;
35}
36
37package # hide the package from PAUSE
38 ClassEncapsulatedAttributes::Attribute;
39
40use strict;
41use warnings;
42
43our $VERSION = '0.04';
44
45use base 'Class::MOP::Attribute';
46
47# alter the way parameters are specified
48sub 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;
55 my $val;
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);
63 }
64
65 # now add this to the instance structure
66 $meta_instance->set_slot_value($instance, $self->name, $val);
67}
68
69sub name {
70 my $self = shift;
71 return ($self->associated_class->name . '::' . $self->SUPER::name)
72}
73
741;
75
76__END__
77
78=pod
79
80=head1 NAME
81
82ClassEncapsulatedAttributes - A set of example metaclasses with class encapsulated attributes
83
84=head1 SYNOPSIS
85
86 package Foo;
87
88 use metaclass 'ClassEncapsulatedAttributes';
89
90 Foo->meta->add_attribute('foo' => (
91 accessor => 'Foo_foo',
92 default => 'init in FOO'
93 ));
94
95 sub new {
96 my $class = shift;
97 $class->meta->new_object(@_);
98 }
99
100 package Bar;
101 our @ISA = ('Foo');
102
103 # duplicate the attribute name here
104 Bar->meta->add_attribute('foo' => (
105 accessor => 'Bar_foo',
106 default => 'init in BAR'
107 ));
108
109 # ... later in other code ...
110
111 my $bar = Bar->new();
112 prints $bar->Bar_foo(); # init in BAR
113 prints $bar->Foo_foo(); # init in FOO
114
115 # and ...
116
117 my $bar = Bar->new(
118 'Foo' => { 'foo' => 'Foo::foo' },
119 'Bar' => { 'foo' => 'Bar::foo' }
120 );
121
122 prints $bar->Bar_foo(); # Foo::foo
123 prints $bar->Foo_foo(); # Bar::foo
124
125=head1 DESCRIPTION
126
127This is an example metaclass which encapsulates a class's
128attributes on a per-class basis. This means that there is no
129possibility of name clashes with inherited attributes. This
130is similar to how C++ handles its data members.
131
132=head1 ACKNOWLEDGEMENTS
133
134Thanks to Yuval "nothingmuch" Kogman for the idea for this example.
135
136=head1 AUTHORS
137
138Stevan Little E<lt>stevan@iinteractive.comE<gt>
139
140Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
141
142=head1 COPYRIGHT AND LICENSE
143
144Copyright 2006-2008 by Infinity Interactive, Inc.
145
146L<http://www.iinteractive.com>
147
148This library is free software; you can redistribute it and/or modify
149it under the same terms as Perl itself.
150
151=cut