lib/Moose/Cookbook/Meta/Recipe7.pod

   1 package Moose::Cookbook::Meta::Recipe7;
   2
   3 # ABSTRACT: Creating a glob reference meta-instance class
   4
   5 __END__
   6
   7
   8 =pod
   9
  10 =begin testing-SETUP
  11
  12 {
  13     package My::Meta::Instance;
  14     use Moose;
  15
  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' }
  21 }
  22
  23 =end testing-SETUP
  24
  25 =head1 SYNOPSIS
  26
  27   package My::Meta::Instance;
  28
  29   use Scalar::Util qw( weaken );
  30   use Symbol qw( gensym );
  31
  32   use Moose;
  33   extends 'Moose::Meta::Instance';
  34
  35   sub create_instance {
  36       my $self = shift;
  37       my $sym = gensym();
  38       bless $sym, $self->_class_name;
  39   }
  40
  41   sub clone_instance {
  42       my ( $self, $instance ) = @_;
  43
  44       my $new_sym = gensym();
  45       %{*$new_sym} = %{*$instance};
  46
  47       bless $new_sym, $self->_class_name;
  48   }
  49
  50   sub get_slot_value {
  51       my ( $self, $instance, $slot_name ) = @_;
  52       return *$instance->{$slot_name};
  53   }
  54
  55   sub set_slot_value {
  56       my ( $self, $instance, $slot_name, $value ) = @_;
  57       *$instance->{$slot_name} = $value;
  58   }
  59
  60   sub deinitialize_slot {
  61       my ( $self, $instance, $slot_name ) = @_;
  62       delete *$instance->{$slot_name};;
  63   }
  64
  65   sub is_slot_initialized {
  66       my ( $self, $instance, $slot_name, $value ) = @_;
  67       exists *$instance->{$slot_name};;
  68   }
  69
  70   sub weaken_slot_value {
  71       my ( $self, $instance, $slot_name ) = @_;
  72       weaken *$instance->{$slot_name};;
  73   }
  74
  75   sub inline_create_instance {
  76       my ( $self, $class_variable ) = @_;
  77       return 'do { my $sym = Symbol::gensym(); bless $sym, ' . $class_variable . ' }';
  78   }
  79
  80   sub inline_slot_access {
  81       my ( $self, $instance, $slot_name ) = @_;
  82       return '*{' . $instance . '}->{' . $slot_name . '}';
  83   }
  84
  85   package MyApp::User;
  86
  87   use metaclass 'Moose::Meta::Class' =>
  88       ( instance_metaclass => 'My::Meta::Instance' );
  89
  90   use Moose;
  91
  92   has 'name' => (
  93       is  => 'rw',
  94       isa => 'Str',
  95   );
  96
  97   has 'email' => (
  98       is  => 'rw',
  99       isa => 'Str',
 100   );
 101
 102 =head1 DESCRIPTION
 103
 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.
 107
 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.
 111
 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.
 115
 116 The first method we override is C<create_instance>:
 117
 118
 119   sub create_instance {
 120       my $self = shift;
 121       my $sym = gensym();
 122       bless $sym, $self->_class_name;
 123   }
 124
 125 This returns an glob reference which has been blessed into our
 126 meta-instance's associated class.
 127
 128 We also override C<clone_instance> to create a new array reference:
 129
 130   sub clone_instance {
 131       my ( $self, $instance ) = @_;
 132
 133       my $new_sym = gensym();
 134       %{*$new_sym} = %{*$instance};
 135
 136       bless $new_sym, $self->_class_name;
 137   }
 138
 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.
 143
 144   sub get_slot_value {
 145       my ( $self, $instance, $slot_name ) = @_;
 146       *$instance->{$slot_name};;
 147   }
 148
 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:
 152
 153   sub inline_create_instance {
 154       my ( $self, $class_variable ) = @_;
 155       return 'do { my $sym = Symbol::gensym(); bless $sym, ' . $class_variable . ' }';
 156   }
 157
 158 The code snippet that the C<inline_slot_access> method returns will
 159 get C<eval>'d once per attribute.
 160
 161 Finally, we use this meta-instance in our C<MyApp::User> class:
 162
 163   use metaclass 'Moose::Meta::Class' =>
 164       ( instance_metaclass => 'My::Meta::Instance' );
 165
 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.
 169
 170 =head1 CONCLUSION
 171
 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.
 175
 176 =head1 SEE ALSO
 177
 178 There are a few meta-instance class extensions on CPAN:
 179
 180 =over 4
 181
 182 =item * L<MooseX::Singleton>
 183
 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
 186 reference.
 187
 188 =item * L<MooseX::GlobRef>
 189
 190 This module makes the instance a blessed glob reference. This lets you
 191 use a handle as an object instance.
 192
 193 =back
 194
 195 =begin testing
 196
 197 {
 198     package MyApp::Employee;
 199
 200     use Moose;
 201     extends 'MyApp::User';
 202
 203     has 'employee_number' => ( is => 'rw' );
 204 }
 205
 206 for my $x ( 0 .. 1 ) {
 207     MyApp::User->meta->make_immutable if $x;
 208
 209     my $user = MyApp::User->new(
 210         name  => 'Faye',
 211         email => 'faye@example.com',
 212     );
 213
 214     ok( eval { *{$user} }, 'user object is an glob ref with some values' );
 215
 216     is( $user->name,  'Faye',             'check name' );
 217     is( $user->email, 'faye@example.com', 'check email' );
 218
 219     $user->name('Ralph');
 220     is( $user->name, 'Ralph', 'check name after changing it' );
 221
 222     $user->email('ralph@example.com');
 223     is( $user->email, 'ralph@example.com', 'check email after changing it' );
 224 }
 225
 226 for my $x ( 0 .. 1 ) {
 227     MyApp::Employee->meta->make_immutable if $x;
 228
 229     my $emp = MyApp::Employee->new(
 230         name            => 'Faye',
 231         email           => 'faye@example.com',
 232         employee_number => $x,
 233     );
 234
 235     ok( eval { *{$emp} }, 'employee object is an glob ref with some values' );
 236
 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' );
 240
 241     $emp->name('Ralph');
 242     is( $emp->name, 'Ralph', 'check name after changing it' );
 243
 244     $emp->email('ralph@example.com');
 245     is( $emp->email, 'ralph@example.com', 'check email after changing it' );
 246
 247     $emp->employee_number(42);
 248     is( $emp->employee_number, 42, 'check employee_number after changing it' );
 249 }
 250
 251 =end testing
 252
 253 =pod