t/cdbi/14-might_have.t

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