Commit | Line | Data |
83eef562 |
1 | use DBIx::Class::Optional::Dependencies -skip_all_without => 'cdbicompat'; |
2 | |
5ef62e9f |
3 | use strict; |
4a233f30 |
4 | use warnings; |
83eef562 |
5 | |
5ef62e9f |
6 | use Test::More; |
7 | use Test::Warn; |
8 | |
50891152 |
9 | use lib 't/cdbi/testlib'; |
5ef62e9f |
10 | use Film; |
11 | |
12 | my $waves = Film->insert({ |
13 | Title => "Breaking the Waves", |
14 | Director => 'Lars von Trier', |
15 | Rating => 'R' |
16 | }); |
17 | |
8ed9eec6 |
18 | local $ENV{DBIC_CDBICOMPAT_HASH_WARN} = 0; |
10221b79 |
19 | |
8ed9eec6 |
20 | { |
21 | local $ENV{DBIC_CDBICOMPAT_HASH_WARN} = 1; |
ebe790db |
22 | |
8ed9eec6 |
23 | warnings_like { |
24 | my $rating = $waves->{rating}; |
25 | $waves->Rating("PG"); |
26 | is $rating, "R", 'evaluation of column value is not deferred'; |
de0ed7f1 |
27 | } qr{^Column 'rating' of 'Film/$waves' was fetched as a hash at\b}; |
5ef62e9f |
28 | |
8ed9eec6 |
29 | warnings_like { |
30 | is $waves->{title}, $waves->Title, "columns can be accessed as hashes"; |
31 | } qr{^Column 'title' of 'Film/$waves' was fetched as a hash at\b}; |
5ef62e9f |
32 | |
8ed9eec6 |
33 | $waves->Rating("G"); |
5ef62e9f |
34 | |
8ed9eec6 |
35 | warnings_like { |
36 | is $waves->{rating}, "G", "updating via the accessor updates the hash"; |
37 | } qr{^Column 'rating' of 'Film/$waves' was fetched as a hash at\b}; |
5ef62e9f |
38 | |
5ef62e9f |
39 | |
8ed9eec6 |
40 | warnings_like { |
41 | $waves->{rating} = "PG"; |
42 | } qr{^Column 'rating' of 'Film/$waves' was stored as a hash at\b}; |
10221b79 |
43 | |
8ed9eec6 |
44 | $waves->update; |
45 | my @films = Film->search( Rating => "PG", Title => "Breaking the Waves" ); |
46 | is @films, 1, "column updated as hash was saved"; |
47 | } |
10221b79 |
48 | |
49 | warning_is { |
10221b79 |
50 | $waves->{rating} |
92a23d90 |
51 | } '', 'DBIC_CDBICOMPAT_HASH_WARN controls warnings'; |
52 | |
53 | |
8273e845 |
54 | { |
92a23d90 |
55 | $waves->rating("R"); |
56 | $waves->update; |
8273e845 |
57 | |
92a23d90 |
58 | no warnings 'redefine'; |
59 | local *Film::rating = sub { |
60 | return "wibble"; |
61 | }; |
8273e845 |
62 | |
92a23d90 |
63 | is $waves->{rating}, "R"; |
64 | } |
d656262b |
65 | |
66 | |
67 | { |
68 | no warnings 'redefine'; |
69 | no warnings 'once'; |
70 | local *Actor::accessor_name_for = sub { |
71 | my($class, $col) = @_; |
72 | return "movie" if lc $col eq "film"; |
73 | return $col; |
74 | }; |
8273e845 |
75 | |
d656262b |
76 | require Actor; |
abb4aae3 |
77 | Actor->has_a( film => "Film" ); |
78 | |
d656262b |
79 | my $actor = Actor->insert({ |
80 | name => 'Emily Watson', |
81 | film => $waves, |
82 | }); |
8273e845 |
83 | |
d656262b |
84 | ok !eval { $actor->film }; |
85 | is $actor->{film}->id, $waves->id, |
86 | 'hash access still works despite lack of accessor'; |
1c779eb2 |
87 | } |
88 | |
89 | |
90 | # Emulate that Class::DBI inflates immediately |
895b576d |
91 | SKIP: { |
461e818a |
92 | DBIx::Class::Optional::Dependencies->skip_without([qw( Date::Simple>=3.03 test_rdbms_mysql )]); |
93 | require MyFoo; |
1c779eb2 |
94 | my $foo = MyFoo->insert({ |
95 | name => 'Whatever', |
96 | tdate => '1949-02-01', |
97 | }); |
98 | isa_ok $foo, 'MyFoo'; |
8273e845 |
99 | |
1c779eb2 |
100 | isa_ok $foo->{tdate}, 'Date::Simple'; |
101 | is $foo->{tdate}->year, 1949; |
89bddb49 |
102 | } |
103 | |
104 | done_testing; |