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