lib/Moose/Cookbook/Meta/Recipe7.pod

   1
   2 =pod
   3
   4 =begin testing-SETUP
   5
   6 {
   7     package My::Meta::Instance;
   8     use Moose;
   9
  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' }
  15 }
  16
  17 =end testing-SETUP
  18
  19 =head1 NAME
  20
  21 Moose::Cookbook::Meta::Recipe7 - Creating an array reference meta-instance class
  22
  23 =head1 SYNOPSIS
  24
  25   package My::Meta::Instance;
  26
  27   use List::Util qw( max );
  28
  29   use Moose;
  30   extends 'Moose::Meta::Instance';
  31
  32   sub create_instance {
  33       my $self = shift;
  34       bless [], $self->_class_name;
  35   }
  36
  37   sub clone_instance {
  38       my ( $self, $instance ) = @_;
  39       bless [@$instance], $self->_class_name;
  40   }
  41
  42   sub get_slot_value {
  43       my ( $self, $instance, $slot_name ) = @_;
  44       $instance->[ $self->_index_for_slot_name($slot_name) ];
  45   }
  46
  47   sub set_slot_value {
  48       my ( $self, $instance, $slot_name, $value ) = @_;
  49       $instance->[ $self->_index_for_slot_name($slot_name) ] = $value;
  50   }
  51
  52   sub deinitialize_slot {
  53       my ( $self, $instance, $slot_name ) = @_;
  54       delete $instance->[ $self->_index_for_slot_name($slot_name) ];
  55   }
  56
  57   sub is_slot_initialized {
  58       my ( $self, $instance, $slot_name, $value ) = @_;
  59       exists $instance->[ $self->_index_for_slot_name($slot_name) ];
  60   }
  61
  62   sub weaken_slot_value {
  63       my ( $self, $instance, $slot_name ) = @_;
  64       weaken $instance->[ $self->_index_for_slot_name($slot_name) ];
  65   }
  66
  67   sub inline_create_instance {
  68       my ( $self, $class_variable ) = @_;
  69       'bless [] => ' . $class_variable;
  70   }
  71
  72   sub inline_slot_access {
  73       my ( $self, $instance, $slot_name ) = @_;
  74       $slot_name =~ s/^\'|\'$//g;
  75       sprintf "%s->[%s]", $instance, $self->_index_for_slot_name($slot_name);
  76   }
  77
  78   my %Indexes;
  79   sub _index_for_slot_name {
  80       my $self      = shift;
  81       my $slot_name = shift;
  82
  83       my $indexes = $Indexes{ $self->associated_metaclass->name } ||= {};
  84
  85       return $indexes->{$slot_name}
  86           if exists $indexes->{$slot_name};
  87
  88       my $max = max values %{$indexes};
  89
  90       return $indexes->{$slot_name} = ( $max || 0 ) + 1;
  91   }
  92
  93   package MyApp::User;
  94
  95   use metaclass 'Moose::Meta::Class' =>
  96       ( instance_metaclass => 'My::Meta::Instance' );
  97
  98   use Moose;
  99
 100   has 'name' => (
 101       is  => 'rw',
 102       isa => 'Str',
 103   );
 104
 105   has 'email' => (
 106       is  => 'rw',
 107       isa => 'Str',
 108   );
 109
 110 =head1 DESCRIPTION
 111
 112 This recipe shows how to build your own meta-instance. The meta
 113 instance is the metaclass that creates object instances and helps
 114 manages access to attribute slots.
 115
 116 In this example, we're creating a meta-instance that is an array
 117 reference rather than a hash reference. In theory, this might be a bit
 118 faster than using a hash, though in practice the difference may be
 119 neglible. Nonetheless, it makes for a simple example here.
 120
 121 Our class is a subclass of L<Moose::Meta::Instance>, which creates
 122 hash reference based objects. We need to override all the methods
 123 which make assumptions about the object's data structure.
 124
 125 The first method we override is C<create_instance>:
 126
 127   sub create_instance {
 128       my $self = shift;
 129       bless [], $self->_class_name;
 130   }
 131
 132 This returns an array reference which has been blessed into our
 133 meta-instance's associated class.
 134
 135 We also override C<clone_instance> to create a new array reference:
 136
 137   sub clone_instance {
 138       my ( $self, $instance ) = @_;
 139       bless [@$instance], $self->_class_name;
 140   }
 141
 142 After that, we have a series of methods which mediate access to the
 143 object's slots (attributes are stored in "slots"). In the default
 144 instance class, these look up the slot by name. We need to translate
 145 the name to a numeric index instead:
 146
 147   sub get_slot_value {
 148       my ( $self, $instance, $slot_name ) = @_;
 149       $instance->[ $self->_index_for_slot_name($slot_name) ];
 150   }
 151
 152 This level of indirection probably makes our instance class I<slower>
 153 than the default. However, when attribute access is inlined, this
 154 lookup will be cached:
 155
 156   sub inline_slot_access {
 157       my ( $self, $instance, $slot_name ) = @_;
 158       $slot_name =~ s/^\'|\'$//g;
 159       sprintf "%s->[%s]", $instance, $self->_index_for_slot_name($slot_name);
 160   }
 161
 162 The code snippet that the C<inline_slot_access> method returns will
 163 get C<eval>'d once per attribute.
 164
 165 Finally, we use this meta-instance in our C<MyApp::User> class:
 166
 167   use metaclass 'Moose::Meta::Class' =>
 168       ( instance_metaclass => 'My::Meta::Instance' );
 169
 170 We actually don't recommend the use of L<metaclass> in most
 171 cases. However, the other ways of using alternate metaclasses are more
 172 complex, and would complicate our example code unnecessarily.
 173
 174 =head1 CONCLUSION
 175
 176 This recipe shows how to create your own meta-instance class. It's
 177 unlikely that you'll need to do this yourself, but it's interesting to
 178 take a peek at how Moose works under the hood.
 179
 180 =head1 SEE ALSO
 181
 182 There are a few meta-instance class extensions on CPAN:
 183
 184 =over 4
 185
 186 =item * L<MooseX::Singleton>
 187
 188 This module extends the instance class in order to ensure that the
 189 object is a singleton. The instance it uses is still a blessed hash
 190 reference.
 191
 192 =item * L<MooseX::GlobRef>
 193
 194 This module makes the instance a blessed glob reference. This lets you
 195 use a handle as an object instance.
 196
 197 =back
 198
 199 =head1 AUTHOR
 200
 201 Dave Rolsky E<lt>autarch@urth.orgE<gt>
 202
 203 =head1 COPYRIGHT AND LICENSE
 204
 205 Copyright 2006-2009 by Infinity Interactive, Inc.
 206
 207 L<http://www.iinteractive.com>
 208
 209 This library is free software; you can redistribute it and/or modify
 210 it under the same terms as Perl itself.
 211
 212 =begin testing
 213
 214 for my $x ( 0..1 )
 215 {
 216     MyApp::User->meta->make_immutable if $x;
 217
 218     my $user = MyApp::User->new( name => 'Faye', email => 'faye@example.com' );
 219
 220     ok( eval { @{$user} }, 'user object is an arrayref with some values' );
 221
 222     is( $user->name, 'Faye', 'check name' );
 223     is( $user->email, 'faye@example.com', 'check email' );
 224
 225     $user->name('Ralph');
 226     is( $user->name, 'Ralph', 'check name after changing it' );
 227
 228     $user->email('ralph@example.com');
 229     is( $user->email, 'ralph@example.com', 'check email after changing it' );
 230 }
 231
 232
 233
 234 =end testing
 235
 236 =pod