1 package Moose::Cookbook::Meta::Recipe7;
3 # ABSTRACT: Creating a glob reference meta-instance class
13 package My::Meta::Instance;
16 # This needs to be in a BEGIN block so to avoid a metaclass
17 # incompatibility error from Moose. In normal usage,
18 # My::Meta::Instance would be in a separate file from MyApp::User,
19 # and this would be a non-issue.
20 BEGIN { extends 'Moose::Meta::Instance' }
27 package My::Meta::Instance;
29 use Scalar::Util qw( weaken );
30 use Symbol qw( gensym );
33 extends 'Moose::Meta::Instance';
38 bless $sym, $self->_class_name;
42 my ( $self, $instance ) = @_;
44 my $new_sym = gensym();
45 %{*$new_sym} = %{*$instance};
47 bless $new_sym, $self->_class_name;
51 my ( $self, $instance, $slot_name ) = @_;
52 return *$instance->{$slot_name};
56 my ( $self, $instance, $slot_name, $value ) = @_;
57 *$instance->{$slot_name} = $value;
60 sub deinitialize_slot {
61 my ( $self, $instance, $slot_name ) = @_;
62 delete *$instance->{$slot_name};;
65 sub is_slot_initialized {
66 my ( $self, $instance, $slot_name, $value ) = @_;
67 exists *$instance->{$slot_name};;
70 sub weaken_slot_value {
71 my ( $self, $instance, $slot_name ) = @_;
72 weaken *$instance->{$slot_name};;
75 sub inline_create_instance {
76 my ( $self, $class_variable ) = @_;
77 return 'do { my $sym = Symbol::gensym(); bless $sym, ' . $class_variable . ' }';
80 sub inline_slot_access {
81 my ( $self, $instance, $slot_name ) = @_;
82 return '*{' . $instance . '}->{' . $slot_name . '}';
87 use metaclass 'Moose::Meta::Class' =>
88 ( instance_metaclass => 'My::Meta::Instance' );
104 This recipe shows how to build your own meta-instance. The meta
105 instance is the metaclass that creates object instances and helps
106 manages access to attribute slots.
108 In this example, we're creating a meta-instance that is based on a
109 glob reference rather than a hash reference. This example is largely
110 based on the Piotr Roszatycki's L<MooseX::GlobRef> module.
112 Our class is a subclass of L<Moose::Meta::Instance>, which creates
113 hash reference based objects. We need to override all the methods
114 which make assumptions about the object's data structure.
116 The first method we override is C<create_instance>:
119 sub create_instance {
122 bless $sym, $self->_class_name;
125 This returns an glob reference which has been blessed into our
126 meta-instance's associated class.
128 We also override C<clone_instance> to create a new array reference:
131 my ( $self, $instance ) = @_;
133 my $new_sym = gensym();
134 %{*$new_sym} = %{*$instance};
136 bless $new_sym, $self->_class_name;
139 After that, we have a series of methods which mediate access to the
140 object's slots (attributes are stored in "slots"). In the default
141 instance class, these expect the object to be a hash reference, but we
142 need to change this to expect a glob reference instead.
145 my ( $self, $instance, $slot_name ) = @_;
146 *$instance->{$slot_name};;
149 This level of indirection probably makes our instance class I<slower>
150 than the default. However, when attribute access is inlined, this
151 lookup will be cached:
153 sub inline_create_instance {
154 my ( $self, $class_variable ) = @_;
155 return 'do { my $sym = Symbol::gensym(); bless $sym, ' . $class_variable . ' }';
158 The code snippet that the C<inline_slot_access> method returns will
159 get C<eval>'d once per attribute.
161 Finally, we use this meta-instance in our C<MyApp::User> class:
163 use metaclass 'Moose::Meta::Class' =>
164 ( instance_metaclass => 'My::Meta::Instance' );
166 We actually don't recommend the use of L<metaclass> in most
167 cases. However, the other ways of using alternate metaclasses are more
168 complex, and would complicate our example code unnecessarily.
172 This recipe shows how to create your own meta-instance class. It's
173 unlikely that you'll need to do this yourself, but it's interesting to
174 take a peek at how Moose works under the hood.
178 There are a few meta-instance class extensions on CPAN:
182 =item * L<MooseX::Singleton>
184 This module extends the instance class in order to ensure that the
185 object is a singleton. The instance it uses is still a blessed hash
188 =item * L<MooseX::GlobRef>
190 This module makes the instance a blessed glob reference. This lets you
191 use a handle as an object instance.
198 package MyApp::Employee;
201 extends 'MyApp::User';
203 has 'employee_number' => ( is => 'rw' );
206 for my $x ( 0 .. 1 ) {
207 MyApp::User->meta->make_immutable if $x;
209 my $user = MyApp::User->new(
211 email => 'faye@example.com',
214 ok( eval { *{$user} }, 'user object is an glob ref with some values' );
216 is( $user->name, 'Faye', 'check name' );
217 is( $user->email, 'faye@example.com', 'check email' );
219 $user->name('Ralph');
220 is( $user->name, 'Ralph', 'check name after changing it' );
222 $user->email('ralph@example.com');
223 is( $user->email, 'ralph@example.com', 'check email after changing it' );
226 for my $x ( 0 .. 1 ) {
227 MyApp::Employee->meta->make_immutable if $x;
229 my $emp = MyApp::Employee->new(
231 email => 'faye@example.com',
232 employee_number => $x,
235 ok( eval { *{$emp} }, 'employee object is an glob ref with some values' );
237 is( $emp->name, 'Faye', 'check name' );
238 is( $emp->email, 'faye@example.com', 'check email' );
239 is( $emp->employee_number, $x, 'check employee_number' );
242 is( $emp->name, 'Ralph', 'check name after changing it' );
244 $emp->email('ralph@example.com');
245 is( $emp->email, 'ralph@example.com', 'check email after changing it' );
247 $emp->employee_number(42);
248 is( $emp->employee_number, 42, 'check employee_number after changing it' );