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