Commit | Line | Data |
d6fbcd05 |
1 | |
2 | package # hide the package from PAUSE |
3 | ClassEncapsulatedAttributes; |
4 | |
5 | use strict; |
6 | use warnings; |
7 | |
2bab2be6 |
8 | our $VERSION = '0.06'; |
d6fbcd05 |
9 | |
10 | use base 'Class::MOP::Class'; |
11 | |
351bd7d4 |
12 | sub initialize { |
13 | (shift)->SUPER::initialize(@_, |
14 | # use the custom attribute metaclass here |
2d711cc8 |
15 | ':attribute_metaclass' => 'ClassEncapsulatedAttributes::Attribute', |
351bd7d4 |
16 | ); |
17 | } |
18 | |
d6fbcd05 |
19 | sub construct_instance { |
20 | my ($class, %params) = @_; |
2d711cc8 |
21 | |
22 | my $instance = $class->get_meta_instance->create_instance(); |
23 | |
24 | # initialize *ALL* attributes, including masked ones (as opposed to applicable) |
d6fbcd05 |
25 | foreach my $current_class ($class->class_precedence_list()) { |
aa448b16 |
26 | my $meta = $current_class->meta; |
d6fbcd05 |
27 | foreach my $attr_name ($meta->get_attribute_list()) { |
28 | my $attr = $meta->get_attribute($attr_name); |
2d711cc8 |
29 | $attr->initialize_instance_slot($instance, \%params); |
d6fbcd05 |
30 | } |
31 | } |
2d711cc8 |
32 | |
33 | return $instance; |
d6fbcd05 |
34 | } |
35 | |
36 | package # hide the package from PAUSE |
37 | ClassEncapsulatedAttributes::Attribute; |
38 | |
39 | use strict; |
40 | use warnings; |
41 | |
2bab2be6 |
42 | our $VERSION = '0.04'; |
d6fbcd05 |
43 | |
44 | use base 'Class::MOP::Attribute'; |
45 | |
2d711cc8 |
46 | # alter the way parameters are specified |
fed4cee7 |
47 | sub initialize_instance_slot { |
2d711cc8 |
48 | my ($self, $instance, $params) = @_; |
fed4cee7 |
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 ... |
2d711cc8 |
53 | my $class = $self->associated_class; |
54 | my $val; |
fed4cee7 |
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) { |
2d711cc8 |
61 | $val = $self->default($instance); |
fed4cee7 |
62 | } |
fed4cee7 |
63 | |
2d711cc8 |
64 | # now add this to the instance structure |
65 | my $meta_instance = $self->associated_class->get_meta_instance; |
66 | $meta_instance->set_slot_value_with_init( $instance, $self->slot_name, $val ); |
d6fbcd05 |
67 | } |
68 | |
2d711cc8 |
69 | # mangle the slot name to include the fully qualified attr |
70 | sub slot_name { |
71 | my $self = shift; |
72 | $self->associated_class->name . "::" . $self->SUPER::slot_name; |
d6fbcd05 |
73 | } |
74 | |
d6fbcd05 |
75 | 1; |
76 | |
77 | __END__ |
78 | |
79 | =pod |
80 | |
81 | =head1 NAME |
82 | |
83 | ClassEncapsulatedAttributes - A set of example metaclasses with class encapsulated attributes |
84 | |
85 | =head1 SYNOPSIS |
86 | |
87 | package Foo; |
88 | |
677eb158 |
89 | use metaclass 'ClassEncapsulatedAttributes'; |
d6fbcd05 |
90 | |
2e41896e |
91 | Foo->meta->add_attribute('foo' => ( |
92 | accessor => 'Foo_foo', |
93 | default => 'init in FOO' |
94 | )); |
d6fbcd05 |
95 | |
96 | sub new { |
97 | my $class = shift; |
5659d76e |
98 | $class->meta->new_object(@_); |
d6fbcd05 |
99 | } |
100 | |
101 | package Bar; |
102 | our @ISA = ('Foo'); |
103 | |
104 | # duplicate the attribute name here |
2e41896e |
105 | Bar->meta->add_attribute('foo' => ( |
106 | accessor => 'Bar_foo', |
107 | default => 'init in BAR' |
108 | )); |
d6fbcd05 |
109 | |
110 | # ... later in other code ... |
111 | |
112 | my $bar = Bar->new(); |
113 | prints $bar->Bar_foo(); # init in BAR |
114 | prints $bar->Foo_foo(); # init in FOO |
115 | |
116 | # and ... |
117 | |
118 | my $bar = Bar->new( |
119 | 'Foo' => { 'foo' => 'Foo::foo' }, |
120 | 'Bar' => { 'foo' => 'Bar::foo' } |
121 | ); |
122 | |
123 | prints $bar->Bar_foo(); # Foo::foo |
124 | prints $bar->Foo_foo(); # Bar::foo |
125 | |
126 | =head1 DESCRIPTION |
127 | |
d7c2cbe3 |
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. |
132 | |
133 | =head1 ACKNOWLEDGEMENTS |
134 | |
135 | Thanks to Yuval "nothingmuch" Kogman for the idea for this example. |
136 | |
d6fbcd05 |
137 | =head1 AUTHOR |
138 | |
139 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
140 | |
141 | =head1 COPYRIGHT AND LICENSE |
142 | |
143 | Copyright 2006 by Infinity Interactive, Inc. |
144 | |
145 | L<http://www.iinteractive.com> |
146 | |
147 | This library is free software; you can redistribute it and/or modify |
148 | it under the same terms as Perl itself. |
149 | |
150 | =cut |