From: Dave Rolsky <autarch@urth.org>
Date: Tue, 3 Mar 2009 16:08:36 +0000 (+0000)
Subject: Wrote the meta-instance recipe
X-Git-Tag: 0.72_01~90
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=08e2f1fe584ea009b5a7f089aebef8dae09f049d;p=gitmo%2FMoose.git

Wrote the meta-instance recipe
---

diff --git a/lib/Moose/Cookbook/Meta/Recipe7.pod b/lib/Moose/Cookbook/Meta/Recipe7.pod
new file mode 100644
index 0000000..8260ef7
--- /dev/null
+++ b/lib/Moose/Cookbook/Meta/Recipe7.pod
@@ -0,0 +1,236 @@
+
+=pod
+
+=begin testing-SETUP
+
+{
+    package My::Meta::Instance;
+    use Moose;
+
+    # This needs to be in a BEGIN block so to avoid a metaclass
+    # incompatibility error from Moose. In normal usage,
+    # My::Meta::Instance would be in a separate file from MyApp::User,
+    # and this would be a non-issue.
+    BEGIN { extends 'Moose::Meta::Instance' }
+}
+
+=end testing-SETUP
+
+=head1 NAME
+
+Moose::Cookbook::Meta::Recipe7 - Creating an array reference meta-instance class
+
+=head1 SYNOPSIS
+
+  package My::Meta::Instance;
+
+  use List::Util qw( max );
+
+  use Moose;
+  extends 'Moose::Meta::Instance';
+
+  sub create_instance {
+      my $self = shift;
+      bless [], $self->_class_name;
+  }
+
+  sub clone_instance {
+      my ( $self, $instance ) = @_;
+      bless [@$instance], $self->_class_name;
+  }
+
+  sub get_slot_value {
+      my ( $self, $instance, $slot_name ) = @_;
+      $instance->[ $self->_index_for_slot_name($slot_name) ];
+  }
+
+  sub set_slot_value {
+      my ( $self, $instance, $slot_name, $value ) = @_;
+      $instance->[ $self->_index_for_slot_name($slot_name) ] = $value;
+  }
+
+  sub deinitialize_slot {
+      my ( $self, $instance, $slot_name ) = @_;
+      delete $instance->[ $self->_index_for_slot_name($slot_name) ];
+  }
+
+  sub is_slot_initialized {
+      my ( $self, $instance, $slot_name, $value ) = @_;
+      exists $instance->[ $self->_index_for_slot_name($slot_name) ];
+  }
+
+  sub weaken_slot_value {
+      my ( $self, $instance, $slot_name ) = @_;
+      weaken $instance->[ $self->_index_for_slot_name($slot_name) ];
+  }
+
+  sub inline_create_instance {
+      my ( $self, $class_variable ) = @_;
+      'bless [] => ' . $class_variable;
+  }
+
+  sub inline_slot_access {
+      my ( $self, $instance, $slot_name ) = @_;
+      $slot_name =~ s/^\'|\'$//g;
+      sprintf "%s->[%s]", $instance, $self->_index_for_slot_name($slot_name);
+  }
+
+  my %Indexes;
+  sub _index_for_slot_name {
+      my $self      = shift;
+      my $slot_name = shift;
+
+      my $indexes = $Indexes{ $self->associated_metaclass->name } ||= {};
+
+      return $indexes->{$slot_name}
+          if exists $indexes->{$slot_name};
+
+      my $max = max values %{$indexes};
+
+      return $indexes->{$slot_name} = ( $max || 0 ) + 1;
+  }
+
+  package MyApp::User;
+
+  use metaclass 'Moose::Meta::Class' =>
+      ( instance_metaclass => 'My::Meta::Instance' );
+
+  use Moose;
+
+  has 'name' => (
+      is  => 'rw',
+      isa => 'Str',
+  );
+
+  has 'email' => (
+      is  => 'rw',
+      isa => 'Str',
+  );
+
+=head1 DESCRIPTION
+
+This recipe shows how to build your own meta-instance. The meta
+instance is the metaclass that creates object instances and helps
+manages access to attribute slots.
+
+In this example, we're creating a meta-instance that is an array
+reference rather than a hash reference. In theory, this might be a bit
+faster than using a hash, though in practice the difference may be
+neglible. Nonetheless, it makes for a simple example here.
+
+Our class is a subclass of L<Moose::Meta::Instance>, which creates
+hash reference based objects. We need to override all the methods
+which make assumptions about the object's data structure.
+
+The first method we override is C<create_instance>:
+
+  sub create_instance {
+      my $self = shift;
+      bless [], $self->_class_name;
+  }
+
+This returns an array reference which has been blessed into our
+meta-instance's associated class.
+
+We also override C<clone_instance> to create a new array reference:
+
+  sub clone_instance {
+      my ( $self, $instance ) = @_;
+      bless [@$instance], $self->_class_name;
+  }
+
+After that, we have a series of methods which mediate access to the
+object's slots (attributes are stored in "slots"). In the default
+instance class, these look up the slot by name. We need to translate
+the name to a numeric index instead:
+
+  sub get_slot_value {
+      my ( $self, $instance, $slot_name ) = @_;
+      $instance->[ $self->_index_for_slot_name($slot_name) ];
+  }
+
+This level of indirection probably makes our instance class I<slower>
+than the default. However, when attribute access is inlined, this
+lookup will be cached:
+
+  sub inline_slot_access {
+      my ( $self, $instance, $slot_name ) = @_;
+      $slot_name =~ s/^\'|\'$//g;
+      sprintf "%s->[%s]", $instance, $self->_index_for_slot_name($slot_name);
+  }
+
+The code snippet that the C<inline_slot_access> method returns will
+get C<eval>'d once per attribute.
+
+Finally, we use this meta-instance in our C<MyApp::User> class:
+
+  use metaclass 'Moose::Meta::Class' =>
+      ( instance_metaclass => 'My::Meta::Instance' );
+
+We actually don't recommend the use of L<metaclass> in most
+cases. However, the other ways of using alternate metaclasses are more
+complex, and would complicate our example code unnecessarily.
+
+=head1 CONCLUSION
+
+This recipe shows how to create your own meta-instance class. It's
+unlikely that you'll need to do this yourself, but it's interesting to
+take a peek at how Moose works under the hood.
+
+=head1 SEE ALSO
+
+There are a few meta-instance class extensions on CPAN:
+
+=over 4
+
+=item * L<MooseX::Singleton>
+
+This module extends the instance class in order to ensure that the
+object is a singleton. The instance it uses is still a blessed hash
+reference.
+
+=item * L<MooseX::GlobRef>
+
+This module makes the instance a blessed glob reference. This lets you
+use a handle as an object instance.
+
+=back
+
+=head1 AUTHOR
+
+Dave Rolsky E<lt>autarch@urth.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006-2009 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=begin testing
+
+for my $x ( 0..1 )
+{
+    MyApp::User->meta->make_immutable if $x;
+
+    my $user = MyApp::User->new( name => 'Faye', email => 'faye@example.com' );
+
+    ok( eval { @{$user} }, 'user object is an arrayref with some values' );
+
+    is( $user->name, 'Faye', 'check name' );
+    is( $user->email, 'faye@example.com', 'check email' );
+
+    $user->name('Ralph');
+    is( $user->name, 'Ralph', 'check name after changing it' );
+
+    $user->email('ralph@example.com');
+    is( $user->email, 'ralph@example.com', 'check email after changing it' );
+}
+
+
+
+=end testing
+
+=pod