1#!/usr/bin/perl -w
2
3use strict;
4use Test::More;
5use Test::Warn;
6
7#----------------------------------------------------------------------
8# Test lazy loading
9#----------------------------------------------------------------------
10
11BEGIN {
12  eval "use DBIx::Class::CDBICompat;";
13  plan $@ 
14    ? (skip_all => 'Class::Trigger and DBIx::ContextualFetch required')
15    : (tests => 36)
16  ;
17}
18
19INIT {
20  use lib 't/cdbi/testlib';
21  use Lazy;
22}
23
24is_deeply [ Lazy->columns('Primary') ],        [qw/this/],      "Pri";
25is_deeply [ sort Lazy->columns('Essential') ], [qw/opop this/], "Essential";
26is_deeply [ sort Lazy->columns('things') ],    [qw/that this/], "things";
27is_deeply [ sort Lazy->columns('horizon') ],   [qw/eep orp/],   "horizon";
28is_deeply [ sort Lazy->columns('vertical') ],  [qw/oop opop/],  "vertical";
29is_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
41Lazy->create({ this => 1, that => 2, oop => 3, opop => 4, eep => 5 });
42
43ok(my $obj = Lazy->retrieve(1), 'Retrieve by Primary');
44ok($obj->_attribute_exists('this'),  "Gets primary");
45ok($obj->_attribute_exists('opop'),  "Gets other essential");
46ok(!$obj->_attribute_exists('that'), "But other things");
47ok(!$obj->_attribute_exists('eep'),  " nor eep");
48ok(!$obj->_attribute_exists('orp'),  " nor orp");
49ok(!$obj->_attribute_exists('oop'),  " nor oop");
50
51ok(my $val = $obj->eep, 'Fetch eep');
52ok($obj->_attribute_exists('orp'),   'Gets orp too');
53ok(!$obj->_attribute_exists('oop'),  'But still not oop');
54ok(!$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
67eval {    # Need a hashref
68  Lazy->create(this => 10, that => 20, oop => 30, opop => 40, eep => 50);
69};
70ok($@, $@);
71
72eval {    # False column
73  Lazy->create({ this => 10, that => 20, theother => 30 });
74};
75ok($@, $@);
76
77eval {    # Multiple false columns
78  Lazy->create({ this => 10, that => 20, theother => 30, andanother => 40 });
79};
80ok($@, $@);
81
82
83warning_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
120SKIP: {
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}
183