t/cdbi/04-lazy.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Test::More;
   5 use Test::Warn;
   6
   7 #----------------------------------------------------------------------
   8 # Test lazy loading
   9 #----------------------------------------------------------------------
  10
  11 BEGIN {
  12   eval "use DBIx::Class::CDBICompat;";
  13   if ($@) {
  14     plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
  15     next;
  16   }
  17         eval "use DBD::SQLite";
  18         plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 36);
  19 }
  20
  21 INIT {
  22         use lib 't/cdbi/testlib';
  23         use Lazy;
  24 }
  25
  26 is_deeply [ Lazy->columns('Primary') ],        [qw/this/],      "Pri";
  27 is_deeply [ sort Lazy->columns('Essential') ], [qw/opop this/], "Essential";
  28 is_deeply [ sort Lazy->columns('things') ],    [qw/that this/], "things";
  29 is_deeply [ sort Lazy->columns('horizon') ],   [qw/eep orp/],   "horizon";
  30 is_deeply [ sort Lazy->columns('vertical') ],  [qw/oop opop/],  "vertical";
  31 is_deeply [ sort Lazy->columns('All') ], [qw/eep oop opop orp that this/], "All";
  32
  33 {
  34         my @groups = Lazy->__grouper->groups_for(Lazy->find_column('this'));
  35         is_deeply [ sort @groups ], [sort qw/things Essential Primary/], "this (@groups)";
  36 }
  37
  38 {
  39         my @groups = Lazy->__grouper->groups_for(Lazy->find_column('that'));
  40         is_deeply \@groups, [qw/things/], "that (@groups)";
  41 }
  42
  43 Lazy->create({ this => 1, that => 2, oop => 3, opop => 4, eep => 5 });
  44
  45 ok(my $obj = Lazy->retrieve(1), 'Retrieve by Primary');
  46 ok($obj->_attribute_exists('this'),  "Gets primary");
  47 ok($obj->_attribute_exists('opop'),  "Gets other essential");
  48 ok(!$obj->_attribute_exists('that'), "But other things");
  49 ok(!$obj->_attribute_exists('eep'),  " nor eep");
  50 ok(!$obj->_attribute_exists('orp'),  " nor orp");
  51 ok(!$obj->_attribute_exists('oop'),  " nor oop");
  52
  53 ok(my $val = $obj->eep, 'Fetch eep');
  54 ok($obj->_attribute_exists('orp'),   'Gets orp too');
  55 ok(!$obj->_attribute_exists('oop'),  'But still not oop');
  56 ok(!$obj->_attribute_exists('that'), 'nor that');
  57
  58 {
  59         Lazy->columns(All => qw/this that eep orp oop opop/);
  60         ok(my $obj = Lazy->retrieve(1), 'Retrieve by Primary');
  61         ok !$obj->_attribute_exists('oop'), " Don't have oop";
  62         my $null = $obj->eep;
  63         ok !$obj->_attribute_exists('oop'),
  64                 " Don't have oop - even after getting eep";
  65 }
  66
  67 # Test contructor breaking.
  68
  69 eval {    # Need a hashref
  70         Lazy->create(this => 10, that => 20, oop => 30, opop => 40, eep => 50);
  71 };
  72 ok($@, $@);
  73
  74 eval {    # False column
  75         Lazy->create({ this => 10, that => 20, theother => 30 });
  76 };
  77 ok($@, $@);
  78
  79 eval {    # Multiple false columns
  80         Lazy->create({ this => 10, that => 20, theother => 30, andanother => 40 });
  81 };
  82 ok($@, $@);
  83
  84
  85 warning_is {
  86     Lazy->columns( TEMP => qw(that) );
  87 } "Declaring column that as TEMP but it already exists";
  88
  89 # Test that create() and update() throws out columns that changed
  90 {
  91     my $l = Lazy->create({
  92         this => 99,
  93         that => 2,
  94         oop  => 3,
  95         opop => 4,
  96     });
  97
  98     ok $l->db_Main->do(qq{
  99         UPDATE @{[ $l->table ]}
 100         SET    oop  = ?
 101         WHERE  this = ?
 102     }, undef, 87, $l->this);
 103
 104     is $l->oop, 87;
 105
 106     $l->oop(32);
 107     $l->update;
 108
 109     ok $l->db_Main->do(qq{
 110         UPDATE @{[ $l->table ]}
 111         SET    oop  = ?
 112         WHERE  this = ?
 113     }, undef, 23, $l->this);
 114
 115     is $l->oop, 23;
 116
 117     $l->delete;
 118 }
 119
 120
 121 # Now again for inflated values
 122 SKIP: {
 123     skip "Requires Date::Simple", 5 unless eval "use Date::Simple; 1; ";
 124     Lazy->has_a(
 125         orp     => 'Date::Simple',
 126         inflate => sub { Date::Simple->new($_[0] . '-01-01') },
 127         deflate => 'format'
 128     );
 129
 130     my $l = Lazy->create({
 131         this => 89,
 132         that => 2,
 133         orp  => 1998,
 134     });
 135
 136     ok $l->db_Main->do(qq{
 137         UPDATE @{[ $l->table ]}
 138         SET    orp  = ?
 139         WHERE  this = ?
 140     }, undef, 1987, $l->this);
 141
 142     is $l->orp, '1987-01-01';
 143
 144     $l->orp(2007);
 145     is $l->orp, '2007-01-01';   # make sure it's inflated
 146     $l->update;
 147
 148     ok $l->db_Main->do(qq{
 149         UPDATE @{[ $l->table ]}
 150         SET    orp  = ?
 151         WHERE  this = ?
 152     }, undef, 1942, $l->this);
 153
 154     is $l->orp, '1942-01-01';
 155
 156     $l->delete;
 157 }
 158
 159
 160 # Test that a deleted object works
 161 {
 162     Lazy->search()->delete_all;
 163     my $l = Lazy->create({
 164         this => 99,
 165         that => 2,
 166         oop  => 3,
 167         opop => 4,
 168     });
 169
 170     # Delete the object without it knowing.
 171     Lazy->db_Main->do(qq[
 172         DELETE
 173         FROM   @{[ Lazy->table ]}
 174         WHERE  this = 99
 175     ]);
 176
 177     $l->eep;
 178
 179     # The problem was when an object had an inflated object
 180     # loaded.  _flesh() would set _column_data to undef and
 181     # get_column() would think nothing was there.
 182     # I'm too lazy to set up the proper inflation test.
 183     ok !exists $l->{_column_data}{orp};
 184 }