Commit | Line | Data |
9ec169fe |
1 | |
9ec169fe |
2 | package # hide the package from PAUSE |
f892c0f0 |
3 | InsideOutClass::Attribute; |
4 | |
5 | use strict; |
6 | use warnings; |
7 | |
8 | use Carp 'confess'; |
9 | |
10 | our $VERSION = '0.01'; |
11 | |
12 | use base 'Class::MOP::Attribute'; |
13 | |
14 | sub generate_accessor_method { |
15 | my $self = shift; |
16 | my $attr_name = $self->name; |
17 | return sub { |
18 | my $meta_instance = $_[0]->meta->get_meta_instance; |
19 | $meta_instance->set_slot_value($_[0], $attr_name, $_[1]) if scalar(@_) == 2; |
20 | $meta_instance->get_slot_value($_[0], $attr_name); |
21 | }; |
22 | } |
23 | |
24 | sub generate_reader_method { |
25 | my $self = shift; |
26 | my $attr_name = $self->name; |
27 | return sub { |
28 | confess "Cannot assign a value to a read-only accessor" if @_ > 1; |
29 | $_[0]->meta |
30 | ->get_meta_instance |
31 | ->get_slot_value($_[0], $attr_name); |
32 | }; |
33 | } |
34 | |
35 | sub generate_writer_method { |
36 | my $self = shift; |
37 | my $attr_name = $self->name; |
38 | return sub { |
39 | $_[0]->meta |
40 | ->get_meta_instance |
41 | ->set_slot_value($_[0], $attr_name, $_[1]); |
42 | }; |
43 | } |
44 | |
45 | sub generate_predicate_method { |
46 | my $self = shift; |
47 | my $attr_name = $self->name; |
48 | return sub { |
49 | defined $_[0]->meta |
50 | ->get_meta_instance |
51 | ->get_slot_value($_[0], $attr_name) ? 1 : 0; |
52 | }; |
53 | } |
54 | |
55 | package # hide the package from PAUSE |
2d711cc8 |
56 | InsideOutClass::Instance; |
9ec169fe |
57 | |
58 | use strict; |
59 | use warnings; |
60 | |
2bab2be6 |
61 | our $VERSION = '0.06'; |
9ec169fe |
62 | |
b9dfbf78 |
63 | use Carp 'confess'; |
9ec169fe |
64 | use Scalar::Util 'refaddr'; |
65 | |
2d711cc8 |
66 | use base 'Class::MOP::Instance'; |
67 | |
68 | sub create_instance { |
49c93440 |
69 | my ($self, $class) = @_; |
70 | $self->bless_instance_structure(\(my $instance)); |
9ec169fe |
71 | } |
72 | |
2d711cc8 |
73 | sub get_slot_value { |
49c93440 |
74 | my ($self, $instance, $slot_name) = @_; |
75 | $self->{meta}->get_package_variable('%' . $slot_name)->{refaddr $instance}; |
9ec169fe |
76 | } |
77 | |
2d711cc8 |
78 | sub set_slot_value { |
49c93440 |
79 | my ($self, $instance, $slot_name, $value) = @_; |
80 | $self->{meta}->get_package_variable('%' . $slot_name)->{refaddr $instance} = $value; |
9ec169fe |
81 | } |
82 | |
49c93440 |
83 | sub initialize_slot { |
84 | my ($self, $instance, $slot_name) = @_; |
0e76a376 |
85 | $self->{meta}->add_package_variable(('%' . $slot_name) => {}) |
86 | unless $self->{meta}->has_package_variable('%' . $slot_name); |
49c93440 |
87 | $self->{meta}->get_package_variable('%' . $slot_name)->{refaddr $instance} = undef; |
88 | } |
2d711cc8 |
89 | |
49c93440 |
90 | sub is_slot_initialized { |
91 | my ($self, $instance, $slot_name) = @_; |
92 | return 0 unless $self->{meta}->has_package_variable('%' . $slot_name); |
93 | return exists $self->{meta}->get_package_variable('%' . $slot_name)->{refaddr $instance} ? 1 : 0; |
9ec169fe |
94 | } |
95 | |
9ec169fe |
96 | 1; |
97 | |
98 | __END__ |
99 | |
100 | =pod |
101 | |
102 | =head1 NAME |
103 | |
104 | InsideOutClass - A set of example metaclasses which implement the Inside-Out technique |
105 | |
106 | =head1 SYNOPSIS |
107 | |
108 | package Foo; |
109 | |
fed4cee7 |
110 | use metaclass 'Class::MOP::Class' => ( |
677eb158 |
111 | # tell our metaclass to use the |
112 | # InsideOut attribute metclass |
113 | # to construct all it's attributes |
2d711cc8 |
114 | ':instance_metaclass' => 'InsideOutClass::Instance' |
677eb158 |
115 | ); |
9ec169fe |
116 | |
2e41896e |
117 | __PACKAGE__->meta->add_attribute('foo' => ( |
118 | reader => 'get_foo', |
119 | writer => 'set_foo' |
120 | )); |
9ec169fe |
121 | |
122 | sub new { |
123 | my $class = shift; |
5659d76e |
124 | $class->meta->new_object(@_); |
125 | } |
9ec169fe |
126 | |
127 | # now you can just use the class as normal |
128 | |
129 | =head1 DESCRIPTION |
130 | |
131 | This is a set of example metaclasses which implement the Inside-Out |
132 | class technique. What follows is a brief explaination of the code |
133 | found in this module. |
134 | |
2d711cc8 |
135 | We must create a subclass of B<Class::MOP::Instance> and override |
136 | the slot operations. This requires |
137 | overloading C<get_slot_value>, C<set_slot_value>, C<slot_initialized>, and |
138 | C<initialize_slot>, as well as their inline counterparts. Additionally we |
139 | overload C<add_slot> in order to initialize the global hash containing the |
140 | actual slot values. |
9ec169fe |
141 | |
142 | And that is pretty much all. Of course I am ignoring need for |
143 | inside-out objects to be C<DESTROY>-ed, and some other details as |
2d711cc8 |
144 | well (threading, etc), but this is an example. A real implementation is left as |
145 | an exercise to the reader. |
9ec169fe |
146 | |
147 | =head1 AUTHOR |
148 | |
149 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
150 | |
2d711cc8 |
151 | =head1 SEE ALSO |
152 | |
153 | L<Tie::RefHash::Weak> |
154 | |
9ec169fe |
155 | =head1 COPYRIGHT AND LICENSE |
156 | |
157 | Copyright 2006 by Infinity Interactive, Inc. |
158 | |
159 | L<http://www.iinteractive.com> |
160 | |
161 | This library is free software; you can redistribute it and/or modify |
162 | it under the same terms as Perl itself. |
163 | |
164 | =cut |