t/cdbi/columns_as_hashes.t

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