use
lib
't/cdbi/testlib'
;
my
$waves
= Film->insert({
Title
=>
"Breaking the Waves"
,
Director
=>
'Lars von Trier'
,
Rating
=>
'R'
});
local
$ENV
{DBIC_CDBICOMPAT_HASH_WARN} = 0;
{
local
$ENV
{DBIC_CDBICOMPAT_HASH_WARN} = 1;
warnings_like {
my
$rating
=
$waves
->{rating};
$waves
->Rating(
"PG"
);
is
$rating
,
"R"
,
'evaluation of column value is not deferred'
;
}
qr{^Column 'rating' of 'Film/$waves' was fetched as a hash at\b}
;
warnings_like {
is
$waves
->{title},
$waves
->Title,
"columns can be accessed as hashes"
;
}
qr{^Column 'title' of 'Film/$waves' was fetched as a hash at\b}
;
$waves
->Rating(
"G"
);
warnings_like {
is
$waves
->{rating},
"G"
,
"updating via the accessor updates the hash"
;
}
qr{^Column 'rating' of 'Film/$waves' was fetched as a hash at\b}
;
warnings_like {
$waves
->{rating} =
"PG"
;
}
qr{^Column 'rating' of 'Film/$waves' was stored as a hash at\b}
;
$waves
->update;
my
@films
= Film->search(
Rating
=>
"PG"
,
Title
=>
"Breaking the Waves"
);
is
@films
, 1,
"column updated as hash was saved"
;
}
warning_is {
$waves
->{rating}
}
''
,
'DBIC_CDBICOMPAT_HASH_WARN controls warnings'
;
{
$waves
->rating(
"R"
);
$waves
->update;
no
warnings
'redefine'
;
local
*Film::rating
=
sub
{
return
"wibble"
;
};
is
$waves
->{rating},
"R"
;
}
{
no
warnings
'redefine'
;
no
warnings
'once'
;
local
*Actor::accessor_name_for
=
sub
{
my
(
$class
,
$col
) =
@_
;
return
"movie"
if
lc
$col
eq
"film"
;
return
$col
;
};
Actor->has_a(
film
=>
"Film"
);
my
$actor
= Actor->insert({
name
=>
'Emily Watson'
,
film
=>
$waves
,
});
ok !
eval
{
$actor
->film };
is
$actor
->{film}->id,
$waves
->id,
'hash access still works despite lack of accessor'
;
}
SKIP: {
unless
(
eval
{
require
MyFoo }) {
my
(
$err
) = $@ =~ /([^\n]+)/;
skip
$err
, 3
}
my
$foo
= MyFoo->insert({
name
=>
'Whatever'
,
tdate
=>
'1949-02-01'
,
});
isa_ok
$foo
,
'MyFoo'
;
isa_ok
$foo
->{tdate},
'Date::Simple'
;
is
$foo
->{tdate}->year, 1949;
}
done_testing;