Gecko [ edgpens.lpkmn.gov.my ]

Name	Size	Permission
GlobRef_InstanceMetaclass.pod	7.01 KB	-rw-rw-rw-
Labeled_AttributeTrait.pod	8.78 KB	-rw-rw-rw-
PrivateOrPublic_MethodMetaclas...	5.18 KB	-rw-rw-rw-
Table_MetaclassTrait.pod	3.45 KB	-rw-rw-rw-
WhyMeta.pod	2.67 KB	-rw-rw-rw-

Code Editor : GlobRef_InstanceMetaclass.pod

# PODNAME: Moose::Cookbook::Meta::GlobRef_InstanceMetaclass
# ABSTRACT: Creating a glob reference meta-instance class

__END__

=pod

=encoding UTF-8

=head1 NAME

Moose::Cookbook::Meta::GlobRef_InstanceMetaclass - Creating a glob reference meta-instance class

=head1 VERSION

version 2.2013

=head1 SYNOPSIS

package My::Meta::Instance;

use Scalar::Util qw( weaken );
  use Symbol qw( gensym );

use Moose::Role;

sub create_instance {
      my $self = shift;
      my $sym = gensym();
      bless $sym, $self->_class_name;
  }

sub clone_instance {
      my ( $self, $instance ) = @_;

my $new_sym = gensym();
      %{*$new_sym} = %{*$instance};

bless $new_sym, $self->_class_name;
  }

sub get_slot_value {
      my ( $self, $instance, $slot_name ) = @_;
      return *$instance->{$slot_name};
  }

sub set_slot_value {
      my ( $self, $instance, $slot_name, $value ) = @_;
      *$instance->{$slot_name} = $value;
  }

sub deinitialize_slot {
      my ( $self, $instance, $slot_name ) = @_;
      delete *$instance->{$slot_name};
  }

sub is_slot_initialized {
      my ( $self, $instance, $slot_name ) = @_;
      exists *$instance->{$slot_name};
  }

sub weaken_slot_value {
      my ( $self, $instance, $slot_name ) = @_;
      weaken *$instance->{$slot_name};
  }

sub inline_create_instance {
      my ( $self, $class_variable ) = @_;
      return 'do { my $sym = Symbol::gensym(); bless $sym, ' . $class_variable . ' }';
  }

sub inline_slot_access {
      my ( $self, $instance, $slot_name ) = @_;
      return '*{' . $instance . '}->{' . $slot_name . '}';
  }

package MyApp::User;

use Moose;
  Moose::Util::MetaRole::apply_metaroles(
      for => __PACKAGE__,
      class_metaroles => {
          instance => ['My::Meta::Instance'],
      },
  );

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 based on a
glob reference rather than a hash reference. This example is largely
based on the Piotr Roszatycki's L<MooseX::GlobRef> module.

Our extension is a role which will be applied to 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;
      my $sym = gensym();
      bless $sym, $self->_class_name;
  }

This returns an glob 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 ) = @_;

my $new_sym = gensym();
      %{*$new_sym} = %{*$instance};

bless $new_sym, $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 expect the object to be a hash reference, but we
need to change this to expect a glob reference instead.

sub get_slot_value {
      my ( $self, $instance, $slot_name ) = @_;
      *$instance->{$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 ) = @_;
      return '*{' . $instance . '}->{' . $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:

Moose::Util::MetaRole::apply_metaroles(
      for => __PACKAGE__,
      class_metaroles => {
          instance => ['My::Meta::Instance'],
      },
  );

We actually don't recommend the use of L<Moose::Util::MetaRole> directly in
your class in most cases. Typically, this would be provided by a
L<Moose::Exporter>-based module which handles applying the role for you.

=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

=begin testing

{
    package MyApp::Employee;

use Moose;
    extends 'MyApp::User';

has 'employee_number' => ( is => 'rw' );
}

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 glob ref 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' );
}

for my $x ( 0 .. 1 ) {
    MyApp::Employee->meta->make_immutable if $x;

my $emp = MyApp::Employee->new(
        name            => 'Faye',
        email           => 'faye@example.com',
        employee_number => $x,
    );

ok( eval { *{$emp} }, 'employee object is an glob ref with some values' );

is( $emp->name,            'Faye',             'check name' );
    is( $emp->email,           'faye@example.com', 'check email' );
    is( $emp->employee_number, $x,                 'check employee_number' );

$emp->name('Ralph');
    is( $emp->name, 'Ralph', 'check name after changing it' );

$emp->email('ralph@example.com');
    is( $emp->email, 'ralph@example.com', 'check email after changing it' );

$emp->employee_number(42);
    is( $emp->employee_number, 42, 'check employee_number after changing it' );
}

=end testing

=head1 AUTHORS

=over 4

=item *

Stevan Little <stevan.little@iinteractive.com>

=item *

Dave Rolsky <autarch@urth.org>

=item *

Jesse Luehrs <doy@tozt.net>

=item *

Shawn M Moore <code@sartak.org>

=item *

יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>

=item *

Karen Etheridge <ether@cpan.org>

=item *

Florian Ragwitz <rafl@debian.org>

=item *

Hans Dieter Pearcey <hdp@weftsoar.net>

=item *

Chris Prather <chris@prather.org>

=item *

Matt S Trout <mst@shadowcat.co.uk>

=back

=head1 COPYRIGHT AND LICENSE

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut

${this.title}

Code Editor : GlobRef_InstanceMetaclass.pod