view release on metacpan or  search on metacpan

t/AI/handle_builder.t  view on Meta::CPAN

use Test2::V0;
use DBI;
use File::Temp qw/tempdir/;
use Scalar::Util qw/refaddr/;

# Exercises the handle BUILDER (not the terminal fetches covered by
# t/handle/*): immutability of refiners, void-context croaks, the
# argument-shape parsing of $con->handle(...), and the where/and/or,
# order_by, limit, fields, omit, all_fields, and data_only refiners. The
# connection shortcut proxies (all/one/count/by_id/insert/update/delete)
# are also exercised to confirm they build a handle and run it.

BEGIN {
    skip_all "DBD::SQLite is required for these tests"
        unless eval { require DBD::SQLite; 1 };
}

require DBIx::QuickORM;

my $dir = tempdir(CLEANUP => 1);
my $dsn = "dbi:SQLite:dbname=$dir/handle_builder.sqlite";

{
    my $dbh = DBI->connect($dsn, '', '', {RaiseError => 1, PrintError => 0});
    $dbh->do('CREATE TABLE people (id INTEGER PRIMARY KEY, surname TEXT, first_name TEXT, bio TEXT)');
    $dbh->do(
        "INSERT INTO people (surname, first_name, bio) VALUES "
        . "('smith', 'al', 'x'), ('jones', 'bob', 'y'), ('smith', 'cy', 'z')"
    );
    $dbh->disconnect;
}

my $con  = DBIx::QuickORM->quick(credentials => {dsn => $dsn});
my $base = $con->handle('people');

isa_ok($base, ['DBIx::QuickORM::Handle'], "got a handle for the people table");

subtest immutability => sub {
    my $smiths = $base->where({surname => 'smith'});
    my $jones  = $base->where({surname => 'jones'});

    isnt(refaddr($smiths), refaddr($base), "where() returns a new handle, not the original");
    isnt(refaddr($jones),  refaddr($base), "a second where() returns yet another new handle");
    isnt(refaddr($smiths), refaddr($jones), "the two derived handles are distinct objects");

    is($base->where,   undef,                "base handle WHERE is untouched");
    is($smiths->where, {surname => 'smith'},  "first derived handle has its own WHERE");
    is($jones->where,  {surname => 'jones'},  "second derived handle has its own WHERE");

    # Refiners that need a WHERE/row to be present first operate on a
    # handle that already has one.
    my $w = $base->where({});

    isnt(refaddr($w->order_by(['surname'])), refaddr($w), "order_by() returns a new handle");
    isnt(refaddr($w->limit(5)),              refaddr($w), "limit() returns a new handle");
    isnt(refaddr($base->fields(['id'])),     refaddr($base), "fields() returns a new handle");
    isnt(refaddr($base->omit(['bio'])),      refaddr($base), "omit() returns a new handle");
    isnt(refaddr($base->all_fields),         refaddr($base), "all_fields() returns a new handle");
    isnt(refaddr($base->data_only),          refaddr($base), "data_only() returns a new handle");
    isnt(
        refaddr($base->where({surname => 'smith'})->and({first_name => 'al'})),
        refaddr($base), "and() returns a new handle",
    );
    isnt(
        refaddr($base->where({surname => 'smith'})->or({surname => 'jones'})),
        refaddr($base), "or() returns a new handle",
    );

    is($w->order_by, undef, "order_by on the source handle is still unset");
    is($w->limit,    undef, "limit on the source handle is still unset");
};

subtest void_context_croak => sub {
    # Refiners whose entire point is the returned value croak in void context.
    like(dies { $base->where({surname => 'smith'}); 1 },
        qr/Must not be called in void context/, "where() croaks in void context");

    my $w = $base->where({});
    like(dies { $w->order_by(['surname']); 1 },
        qr/Must not be called in void context/, "order_by() croaks in void context");
    like(dies { $w->limit(5); 1 },
        qr/Must not be called in void context/, "limit() croaks in void context");
    like(dies { $base->fields(['id']); 1 },
        qr/Must not be called in void context/, "fields() croaks in void context");
    like(dies { $base->omit(['bio']); 1 },
        qr/Must not be called in void context/, "omit() croaks in void context");
    like(dies { $base->data_only; 1 },
        qr/Must not be called in void context/, "data_only() croaks in void context");
    like(dies { $base->all_fields; 1 },
        qr/Must not be called in void context/, "all_fields() croaks in void context");
    like(dies { $base->sync; 1 },
        qr/Must not be called in void context/, "sync() croaks in void context");
};