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