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