7 package My::Meta::Instance;
10 # This needs to be in a BEGIN block so to avoid a metaclass
11 # incompatibility error from Moose. In normal usage,
12 # My::Meta::Instance would be in a separate file from MyApp::User,
13 # and this would be a non-issue.
14 BEGIN { extends 'Moose::Meta::Instance' }
21 Moose::Cookbook::Meta::Recipe7 - Creating a glob reference meta-instance class
25 package My::Meta::Instance;
27 use Scalar::Util qw( weaken );
28 use Symbol qw( gensym );
31 extends 'Moose::Meta::Instance';
36 bless $sym, $self->_class_name;
40 my ( $self, $instance ) = @_;
42 my $new_sym = gensym();
43 %{*$new_sym} = %{*$instance};
45 bless $new_sym, $self->_class_name;
49 my ( $self, $instance, $slot_name ) = @_;
50 return *$instance->{$slot_name};
54 my ( $self, $instance, $slot_name, $value ) = @_;
55 *$instance->{$slot_name} = $value;
58 sub deinitialize_slot {
59 my ( $self, $instance, $slot_name ) = @_;
60 delete *$instance->{$slot_name};;
63 sub is_slot_initialized {
64 my ( $self, $instance, $slot_name, $value ) = @_;
65 exists *$instance->{$slot_name};;
68 sub weaken_slot_value {
69 my ( $self, $instance, $slot_name ) = @_;
70 weaken *$instance->{$slot_name};;
73 sub inline_create_instance {
74 my ( $self, $class_variable ) = @_;
75 return 'do { my $sym = Symbol::gensym(); bless $sym, ' . $class_variable . ' }';
78 sub inline_slot_access {
79 my ( $self, $instance, $slot_name ) = @_;
80 return '*{' . $instance . '}->{' . $slot_name . '}';
85 use metaclass 'Moose::Meta::Class' =>
86 ( instance_metaclass => 'My::Meta::Instance' );
102 This recipe shows how to build your own meta-instance. The meta
103 instance is the metaclass that creates object instances and helps
104 manages access to attribute slots.
106 In this example, we're creating a meta-instance that is based on a
107 glob reference rather than a hash reference. This example is largely
108 based on the Piotr Roszatycki's L<MooseX::GlobRef> module.
110 Our class is a subclass of L<Moose::Meta::Instance>, which creates
111 hash reference based objects. We need to override all the methods
112 which make assumptions about the object's data structure.
114 The first method we override is C<create_instance>:
117 sub create_instance {
120 bless $sym, $self->_class_name;
123 This returns an glob reference which has been blessed into our
124 meta-instance's associated class.
126 We also override C<clone_instance> to create a new array reference:
129 my ( $self, $instance ) = @_;
131 my $new_sym = gensym();
132 %{*$new_sym} = %{*$instance};
134 bless $new_sym, $self->_class_name;
137 After that, we have a series of methods which mediate access to the
138 object's slots (attributes are stored in "slots"). In the default
139 instance class, these expect the object to be a hash reference, but we
140 need to change this to expect a glob reference instead.
143 my ( $self, $instance, $slot_name ) = @_;
144 *$instance->{$slot_name};;
147 This level of indirection probably makes our instance class I<slower>
148 than the default. However, when attribute access is inlined, this
149 lookup will be cached:
151 sub inline_create_instance {
152 my ( $self, $class_variable ) = @_;
153 return 'do { my $sym = Symbol::gensym(); bless $sym, ' . $class_variable . ' }';
156 The code snippet that the C<inline_slot_access> method returns will
157 get C<eval>'d once per attribute.
159 Finally, we use this meta-instance in our C<MyApp::User> class:
161 use metaclass 'Moose::Meta::Class' =>
162 ( instance_metaclass => 'My::Meta::Instance' );
164 We actually don't recommend the use of L<metaclass> in most
165 cases. However, the other ways of using alternate metaclasses are more
166 complex, and would complicate our example code unnecessarily.
170 This recipe shows how to create your own meta-instance class. It's
171 unlikely that you'll need to do this yourself, but it's interesting to
172 take a peek at how Moose works under the hood.
176 There are a few meta-instance class extensions on CPAN:
180 =item * L<MooseX::Singleton>
182 This module extends the instance class in order to ensure that the
183 object is a singleton. The instance it uses is still a blessed hash
186 =item * L<MooseX::GlobRef>
188 This module makes the instance a blessed glob reference. This lets you
189 use a handle as an object instance.
195 Dave Rolsky E<lt>autarch@urth.orgE<gt>
197 =head1 COPYRIGHT AND LICENSE
199 Copyright 2006-2010 by Infinity Interactive, Inc.
201 L<http://www.iinteractive.com>
203 This library is free software; you can redistribute it and/or modify
204 it under the same terms as Perl itself.
209 package MyApp::Employee;
212 extends 'MyApp::User';
214 has 'employee_number' => ( is => 'rw' );
217 for my $x ( 0 .. 1 ) {
218 MyApp::User->meta->make_immutable if $x;
220 my $user = MyApp::User->new(
222 email => 'faye@example.com',
225 ok( eval { *{$user} }, 'user object is an glob ref with some values' );
227 is( $user->name, 'Faye', 'check name' );
228 is( $user->email, 'faye@example.com', 'check email' );
230 $user->name('Ralph');
231 is( $user->name, 'Ralph', 'check name after changing it' );
233 $user->email('ralph@example.com');
234 is( $user->email, 'ralph@example.com', 'check email after changing it' );
237 for my $x ( 0 .. 1 ) {
238 MyApp::Employee->meta->make_immutable if $x;
240 my $emp = MyApp::Employee->new(
242 email => 'faye@example.com',
243 employee_number => $x,
246 ok( eval { *{$emp} }, 'employee object is an glob ref with some values' );
248 is( $emp->name, 'Faye', 'check name' );
249 is( $emp->email, 'faye@example.com', 'check email' );
250 is( $emp->employee_number, $x, 'check employee_number' );
253 is( $emp->name, 'Ralph', 'check name after changing it' );
255 $emp->email('ralph@example.com');
256 is( $emp->email, 'ralph@example.com', 'check email after changing it' );
258 $emp->employee_number(42);
259 is( $emp->employee_number, 42, 'check employee_number after changing it' );