t/cdbi/14-might_have.t

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