From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

use strict;
#----------------------------------------------------------------------
# Test lazy loading
#----------------------------------------------------------------------
INIT {
use lib 't/cdbi/testlib';
use Lazy;
}
is_deeply [ Lazy->columns('Primary') ], [qw/this/], "Pri";
is_deeply [ sort Lazy->columns('Essential') ], [qw/opop this/], "Essential";
is_deeply [ sort Lazy->columns('things') ], [qw/that this/], "things";
is_deeply [ sort Lazy->columns('horizon') ], [qw/eep orp/], "horizon";
is_deeply [ sort Lazy->columns('vertical') ], [qw/oop opop/], "vertical";
is_deeply [ sort Lazy->columns('All') ], [qw/eep oop opop orp that this/], "All";
{
my @groups = Lazy->__grouper->groups_for(Lazy->find_column('this'));
is_deeply [ sort @groups ], [sort qw/things Essential Primary/], "this (@groups)";
}
{
my @groups = Lazy->__grouper->groups_for(Lazy->find_column('that'));
is_deeply \@groups, [qw/things/], "that (@groups)";
}
Lazy->create({ this => 1, that => 2, oop => 3, opop => 4, eep => 5 });
ok(my $obj = Lazy->retrieve(1), 'Retrieve by Primary');
ok($obj->_attribute_exists('this'), "Gets primary");
ok($obj->_attribute_exists('opop'), "Gets other essential");
ok(!$obj->_attribute_exists('that'), "But other things");
ok(!$obj->_attribute_exists('eep'), " nor eep");
ok(!$obj->_attribute_exists('orp'), " nor orp");
ok(!$obj->_attribute_exists('oop'), " nor oop");
ok(my $val = $obj->eep, 'Fetch eep');
ok($obj->_attribute_exists('orp'), 'Gets orp too');
ok(!$obj->_attribute_exists('oop'), 'But still not oop');
ok(!$obj->_attribute_exists('that'), 'nor that');
{
Lazy->columns(All => qw/this that eep orp oop opop/);
ok(my $obj = Lazy->retrieve(1), 'Retrieve by Primary');
ok !$obj->_attribute_exists('oop'), " Don't have oop";
my $null = $obj->eep;
ok !$obj->_attribute_exists('oop'),
" Don't have oop - even after getting eep";
}
# Test contructor breaking.
eval { # Need a hashref
Lazy->create(this => 10, that => 20, oop => 30, opop => 40, eep => 50);
};
ok($@, $@);
eval { # False column
Lazy->create({ this => 10, that => 20, theother => 30 });
};
ok($@, $@);
eval { # Multiple false columns
Lazy->create({ this => 10, that => 20, theother => 30, andanother => 40 });
};
ok($@, $@);
warning_like {
Lazy->columns( TEMP => qw(that) );
} qr/Declaring column that as TEMP but it already exists/;
# Test that create() and update() throws out columns that changed
{
my $l = Lazy->create({
this => 99,
that => 2,
oop => 3,
opop => 4,
});
ok $l->db_Main->do(qq{
UPDATE @{[ $l->table ]}
SET oop = ?
WHERE this = ?
}, undef, 87, $l->this);
is $l->oop, 87;
$l->oop(32);
$l->update;
ok $l->db_Main->do(qq{
UPDATE @{[ $l->table ]}
SET oop = ?
WHERE this = ?
}, undef, 23, $l->this);
is $l->oop, 23;
$l->delete;
}
# Now again for inflated values
SKIP: {
skip "Requires Date::Simple 3.03", 5 unless eval "use Date::Simple 3.03; 1; ";
Lazy->has_a(
orp => 'Date::Simple',
inflate => sub { Date::Simple->new($_[0] . '-01-01') },
deflate => 'format'
);
my $l = Lazy->create({
this => 89,
that => 2,
orp => 1998,
});
ok $l->db_Main->do(qq{
UPDATE @{[ $l->table ]}
SET orp = ?
WHERE this = ?
}, undef, 1987, $l->this);
is $l->orp, '1987-01-01';
$l->orp(2007);
is $l->orp, '2007-01-01'; # make sure it's inflated
$l->update;
ok $l->db_Main->do(qq{
UPDATE @{[ $l->table ]}
SET orp = ?
WHERE this = ?
}, undef, 1942, $l->this);
is $l->orp, '1942-01-01';
$l->delete;
}
# Test that a deleted object works
{
Lazy->search()->delete_all;
my $l = Lazy->create({
this => 99,
that => 2,
oop => 3,
opop => 4,
});
# Delete the object without it knowing.
Lazy->db_Main->do(qq[
DELETE
FROM @{[ Lazy->table ]}
WHERE this = 99
]);
$l->eep;
# The problem was when an object had an inflated object
# loaded. _flesh() would set _column_data to undef and
# get_column() would think nothing was there.
# I'm too lazy to set up the proper inflation test.
ok !exists $l->{_column_data}{orp};
}
done_testing;