#!/usr/bin/perl -w
$| = 1;
{
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
.
'}'
;
}
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'
,
);
}
{
{
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'
);
}
}
1;