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