[Moose-commits] r7812 - Moose/trunk/lib/Moose/Cookbook/Meta
autarch at code2.0beta.co.uk
autarch at code2.0beta.co.uk
Tue Mar 3 16:08:36 GMT 2009
Author: autarch
Date: 2009-03-03 08:08:36 -0800 (Tue, 03 Mar 2009)
New Revision: 7812
Added:
Moose/trunk/lib/Moose/Cookbook/Meta/Recipe7.pod
Log:
Wrote the meta-instance recipe
Added: Moose/trunk/lib/Moose/Cookbook/Meta/Recipe7.pod
===================================================================
--- Moose/trunk/lib/Moose/Cookbook/Meta/Recipe7.pod (rev 0)
+++ Moose/trunk/lib/Moose/Cookbook/Meta/Recipe7.pod 2009-03-03 16:08:36 UTC (rev 7812)
@@ -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 at 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 at example.com' );
+
+ ok( eval { @{$user} }, 'user object is an arrayref with some values' );
+
+ is( $user->name, 'Faye', 'check name' );
+ is( $user->email, 'faye at example.com', 'check email' );
+
+ $user->name('Ralph');
+ is( $user->name, 'Ralph', 'check name after changing it' );
+
+ $user->email('ralph at example.com');
+ is( $user->email, 'ralph at example.com', 'check email after changing it' );
+}
+
+
+
+=end testing
+
+=pod
More information about the Moose-commits
mailing list