{
has
'$.x'
;
}
my
$dummy
= Dummy->new;
isa_ok(
$dummy
,
'Dummy'
,
'should have a Dummy instance'
);
ok(
$dummy
->can(
'x'
),
'should have an accessor for x attribute'
);
ok(
$dummy
->can(
'set_x'
),
'should have a mutator for x attribute'
);
is(
$dummy
->set_x(101),
$dummy
,
'should set a value'
);
is(
$dummy
->x(101),
'101'
,
'should get the value'
);
{
has
'$.x'
=> (
required
=> 1);
}
eval
{ Dummy::Required->new; };
like($@,
qr/x is required/
,
'should catch x is required attribute'
);
my
$required
= Dummy::Required->new(
x
=> 1);
isa_ok(
$required
,
'Dummy::Required'
,
'should have a Dummy::Required instance'
);
{
has
'%.xs'
=> (
item_accessor
=>
'x'
,
required
=> 1);
}
my
$hash
= Dummy::Hash->new(
xs
=> {
key1
=> 1,
key2
=> 2});
isa_ok(
$hash
,
'Dummy::Hash'
,
'should have a Dummy::Hash instance'
);
is(
$hash
->x(
'key1'
), 1,
'should have key1 value'
);
is(
$hash
->x(
'key2'
), 2,
'should have key2 value'
);
{
has
'@.xs'
=> (
item_accessor
=>
'x'
);
}
my
$array
= Dummy::Array->new(
xs
=> [3, 2, 1]);
isa_ok(
$array
,
'Dummy::Array'
,
'should have a Dummy::Array instance'
);
my
$array_ref
=
$array
->xs;
is_deeply(
$array_ref
, [3, 2, 1],
'should have xs attribute'
);
my
@array
=
$array
->xs;
is(
@array
, 3,
'should have 3 items'
);
is(
$array
->x(0), 3,
'should have [0] value'
);
is(
$array
->x(1), 2,
'should have [1] value'
);
is(
$array
->count_xs, 3,
'should count'
);
is(
$array
->push_xs(0,7), 5,
'should extent array by push'
);
is(
$array
->x(4), 7,
'should have the last extended item'
);
is(
$array
->pop_xs, 7,
'should pop item'
);
is(
$array
->unshift_xs(5, 6), 6,
'should extent array by unshift'
);
is(
$array
->x(0), 5,
'should have the first extended item'
);
is(
$array
->shift_xs, 5,
'should shit item'
);
{
has
'$.z'
=> (
default
=> 0);
has
'$.x'
=> (
default
=>
'x'
);
has
'%.h'
=> (
default
=> {
a
=> 1});
has
'@.a'
=> (
default
=> [1, 2, 3],
required
=> 1);
has
'&.c'
=> (
required
=> 1);
has
'$.d'
=> (
default
=>
sub
{
'stuff'
} ,
required
=> 1);
}
my
$default
= Dummy::Default->new(
c
=>
sub
{123});
isa_ok(
$default
,
'Dummy::Default'
);
is(
$default
->x,
'x'
,
'should have default for the x attribute'
);
is_deeply({
$default
->h}, {
a
=> 1},
'should have default for the h attribute'
);
is_deeply([
$default
->a], [1, 2, 3],
'should have default for the a attribute'
);
is(
$default
->d,
'stuff'
,
'should have default for the x attribute'
);
is(
$default
->z, 0,
'should have 0 as default value'
);
is(
$default
->c->(),
'123'
,
'should have code value'
);
{
has
'$.a'
=> (
on_change
=>
sub
{
my
(
$self
,
$attribute
,
$scope
,
$value_ref
) =
@_
;
return
!! 0;
},
);
my
$x_value
;
my
$x_attribute
;
my
$x_scope
;
my
$x_attr
=
has
'$.x'
=> (
on_change
=>
sub
{
my
(
$self
,
$attribute
,
$scope
,
$value_ref
) =
@_
;
$x_value
=
$$value_ref
;
$x_attribute
=
$attribute
;
$x_scope
=
$scope
;
$self
;
},
);
my
$y_value
;
my
$y_attribute
;
my
$y_scope
;
my
$y_index
;
my
$y_attr
=
has
'@.y'
=> (
on_change
=>
sub
{
my
(
$self
,
$attribute
,
$scope
,
$value_ref
,
$index
) =
@_
;
$y_value
=
$$value_ref
;
$y_attribute
=
$attribute
;
$y_scope
=
$scope
;
$y_index
=
$index
;
$self
;
},
item_accessor
=>
'y_item'
);
my
$z_value
;
my
$z_attribute
;
my
$z_scope
;
my
$z_key
;
my
$z_attr
=
has
'%.z'
=> (
on_change
=>
sub
{
my
(
$self
,
$attribute
,
$scope
,
$value
,
$key
) =
@_
;
$z_value
=
$$value
;
$z_attribute
=
$attribute
;
$z_scope
=
$scope
;
$z_key
=
$key
;
$self
;
},
item_accessor
=>
'z_value'
);
my
$on_change
= Dummy::OnChange->new;
::isa_ok(
$on_change
,
'Dummy::OnChange'
,
'should have a Dummy::OnChange instance'
);
$on_change
->x(100);
::is_deeply([100,
'mutator'
,
$x_attr
], [
$x_value
,
$x_scope
,
$x_attribute
],
'should trigger on change for scalar'
);
$on_change
->y([
'1'
,
'2'
,
'3'
]);
::is_deeply([[
'1'
,
'2'
,
'3'
],
'mutator'
,
$y_attr
], [
$y_value
,
$y_scope
,
$y_attribute
],
'should trigger on change for array'
);
$on_change
->y_item(1, 20);
::is_deeply([20,
'item_accessor'
,
$y_attr
, 1], [
$y_value
,
$y_scope
,
$y_attribute
,
$y_index
],
'should trigger on change for array by item accessor'
);
$on_change
->z({
a
=>
'1'
});
::is_deeply([{
a
=>
'1'
},
'mutator'
,
$z_attr
], [
$z_value
,
$z_scope
,
$z_attribute
],
'should trigger on change for hash'
);
$on_change
->z_value(
b
=>
'10'
);
::is_deeply([10,
'item_accessor'
,
$z_attr
,
'b'
], [
$z_value
,
$z_scope
,
$z_attribute
,
$z_key
],
'should trigger on change for hash'
);
::is_deeply({
a
=>
'1'
,
b
=> 10}, {
$on_change
->z},
'should have modyfied hash'
);
$on_change
->set_a(
'100'
);
::ok(!
$on_change
->a,
'should not change a attribute'
);
}
{
has
'$.x'
=> (
required
=> 1);
has
'$.t'
=> (
transistent
=> 3);
has
'%.th'
=> (
transistent
=> 1,
item_accessor
=>
'item_t'
);
has
'@.ta'
=> (
transistent
=> 1);
my
$obj
= Transistent->new(
x
=> 1,
t
=> 2,
th
=> {
a
=> 1,
b
=> 2},
ta
=> [1,2]);
::ok(
@$obj
== 1,
'should have only x stored in object'
);
::is(
$obj
->t, 2,
'should have value for t'
);
::is(
$obj
->item_t(
'a'
),
'1'
,
'should have 1'
);
::is(
$obj
->item_t(
'b'
),
'2'
,
'should have 2'
);
$obj
->cleanup;
::is(
$obj
->t,
undef
,
'should not have value for t after cleanup method was called'
);
}
{
my
%access_log
;
has
'%.attrs'
=> (
on_read
=>
sub
{
my
(
$self
,
$attribute
,
$scope
,
$key
) =
@_
;
my
$values
=
$attribute
->get_value(
$self
);
$access_log
{
$scope
}++;
if
(
$scope
eq
'accessor'
) {
return
$values
;
}
else
{
return
$values
->{
$key
};
}
},
item_accessor
=>
'attr'
);
my
$attr
= DynamicInterceptor->meta->attribute(
'attrs'
);
my
$code_ref
=
$attr
->on_read;
my
$obj
= DynamicInterceptor->new(
attrs
=> {
a
=> 1,
b
=> 2});
my
$a
=
$obj
->attr(
'a'
);
my
%hook_access_log
;
my
$ncode_ref
=
sub
{
my
(
$self
,
$attribute
,
$scope
,
$key
) =
@_
;
$hook_access_log
{
$scope
}++;
$code_ref
->(
$self
,
$attribute
,
$scope
,
$key
);
};
$attr
->set_on_read(
$ncode_ref
);
my
$b
=
$obj
->attr(
'b'
);
::is_deeply(\
%access_log
, {
item_accessor
=> 2,
accessor
=> 2},
'should have updated access log'
);
::is_deeply(\
%hook_access_log
, {
item_accessor
=> 1,
accessor
=> 1},
'should have updated hook_access_log'
);
}
{
has
'$.x'
=> (
required
=> 1,
storage_key
=>
'x'
);
has
'@.y'
=> (
required
=> 1,
storage_key
=>
'y'
);
my
$obj
= StorageKey->new(
x
=> 1,
y
=> [1,2]);
::is_deeply(
$obj
, [1, [1,2]],
'should have storage key'
);
}
{
my
$attr
=
has
'$.x'
=> (
on_validate
=>
sub
{
});
$attr
->set_on_validate(
sub
{
my
(
$self
,
$attribute
,
$scope
,
$value
) =
@_
;
die
'invalid value'
if
(
$$value
ne 1);
}
);
eval
{
Validate->new(
x
=> 2);
};
::like($@,
qr{invalid value}
,
'should validate'
);
::isa_ok(Validate->new(
x
=> 1),
'Validate'
);
}