view release on metacpan or  search on metacpan

data/t/recipes/meta_globref_instancemetaclass.t  view on Meta::CPAN

#!/usr/bin/perl -w

use strict;
use Test::More 'no_plan';
use Test::Fatal;
$| = 1;



# =begin testing SETUP
{

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



# =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');