t/cdbi/14-might_have.t

   1 use strict;
   2 use Test::More;
   3
   4 use lib 't/cdbi/testlib';
   5 use Film;
   6 use Blurb;
   7
   8 is(Blurb->primary_column, "title", "Primary key of Blurb = title");
   9 is_deeply [ Blurb->columns('Essential') ], [ Blurb->primary_column ], "Essential = Primary";
  10
  11 eval { Blurb->retrieve(10) };
  12 is $@, "", "No problem retrieving non-existent Blurb";
  13
  14 Film->might_have(info => Blurb => qw/blurb/);
  15
  16 Film->create_test_film;
  17
  18 {
  19   ok my $bt = Film->retrieve('Bad Taste'), "Get Film";
  20   isa_ok $bt, "Film";
  21   is $bt->info, undef, "No blurb yet";
  22   # bug where we couldn't write a class with a might_have that didn't_have
  23   $bt->rating(16);
  24   eval { $bt->update };
  25   is $@, '', "No problems updating when don't have";
  26   is $bt->rating, 16, "Updated OK";
  27
  28   is $bt->blurb, undef, "Bad taste has no blurb";
  29   $bt->blurb("Wibble bar");
  30   $bt->update;
  31   is $bt->blurb, "Wibble bar", "And we can write the info";
  32 }
  33
  34 {
  35   my $bt   = Film->retrieve('Bad Taste');
  36   my $info = $bt->info;
  37   isa_ok $info, 'Blurb';
  38
  39   is $bt->blurb, $info->blurb, "Blurb is the same as fetching the long way";
  40   ok $bt->blurb("New blurb"), "We can set the blurb";
  41   $bt->update;
  42   is $bt->blurb, $info->blurb, "Blurb has been set";
  43
  44   $bt->rating(18);
  45   eval { $bt->update };
  46   is $@, '', "No problems updating when do have";
  47   is $bt->rating, 18, "Updated OK";
  48
  49   # cascade delete?
  50   {
  51     my $blurb = Blurb->retrieve('Bad Taste');
  52     isa_ok $blurb => "Blurb";
  53     $bt->delete;
  54     $blurb = Blurb->retrieve('Bad Taste');
  55     is $blurb, undef, "Blurb has gone";
  56   }
  57
  58 }
  59
  60 {
  61     my $host = Film->create({ title => "Gwoemul" });
  62     $host->blurb("Monsters are real.");
  63     my $info = $host->info;
  64     is $info->blurb, "Monsters are real.";
  65
  66     $host->discard_changes;
  67     is $host->info->id, $info->id,
  68         'relationships still valid after discard_changes';
  69
  70     ok $host->info->delete;
  71     $host->discard_changes;
  72     ok !$host->info, 'relationships rechecked after discard_changes';
  73 }
  74
  75 done_testing;