view release on metacpan or  search on metacpan

t/50.sqlite-real.t  view on Meta::CPAN

use warnings;
use strict;
use lib '.';
use Test::More;
use DBIx::Perlish qw/:all/;
use t::test_utils;

eval "use DBD::SQLite;";
plan skip_all => "DBD::SQLite cannot be loaded" if $@;

eval "use PadWalker;";
plan skip_all => "PadWalker cannot be loaded" if $@;

plan tests => 104;

my $dbh = DBI->connect("dbi:SQLite:");
ok($dbh, "db connection");
ok($dbh->do("create table names (id integer, name text)"), "table create");
is(DBIx::Perlish::_get_flavor($dbh), "sqlite", "correct flavor");

my $o = DBIx::Perlish->new(dbh => $dbh);

ok((db_insert 'names', { id => 1, name => "hello" }), "insert one");
ok((db_insert 'names', { id => 33, name => "smth/xx" }), "insert one more");
ok($o->insert('names', { id => 3, name => "ehlo" }), "obj: insert one");
is(scalar (db_fetch { my $t : names; $t->id == 1; return $t->name; }), "hello", "fetch inserted");
is(scalar (db_fetch { my $t : names; $t->name =~ /^h/; return $t->name; }), "hello", "fetch anchored regex");
is(scalar (db_fetch { my $t : names; $t->name =~ /\//; return $t->name; }), "smth/xx", "fetch regex with /");
ok((db_delete { names->id == 33 }), "delete one now");

my $h = db_fetch { my $t : names; $t->id == 1; return -k $t->id, $t; };
ok($h, "fetch all hashref");
is($h->{1}{id},   1, "fetch all hashref key id");
is($h->{1}{name}, "hello", "fetch all hashref key name");
ok(!exists $h->{1}{'$kf-1'}, "fetch all hashref key kf not present");

my %h = db_fetch { my $t : names; $t->id == 1; return -k $t->id, $t; };
ok(%h, "fetch all hash");
ok($h{1},   "fetch all hash 1 present");
ok(!$h{3},  "fetch all hash 3 not present");
is($h{1}{id},   1, "fetch all hash key id");
is($h{1}{name}, "hello", "fetch all hash key name");
ok(!exists $h{1}{'$kf-1'}, "fetch all hash key kf not present");

%h = db_fetch { my $t : names; return -k $t->id, $t; };
ok(%h, "fetch all hash unfiltered");
ok($h{1},   "fetch all hash 1 present");
ok($h{3},   "fetch all hash 3 present");
ok(!$h{2},  "fetch all hash 2 not present");
is($h{1}{id},   1, "fetch all hash unfiltered 1 key id");
is($h{1}{name}, "hello", "fetch all hash unfiltered 1 key name");
is($h{3}{id},   3, "fetch all hash unfiltered 3 key id");
is($h{3}{name}, "ehlo", "fetch all hash unfiltered 3 key name");
ok(!exists $h{1}{'$kf-1'}, "fetch all hash unfiltered 1 kf not present");
ok(!exists $h{3}{'$kf-1'}, "fetch all hash unfiltered 1 kf not present");

%h = db_fetch { my $t : names; return -k $t->id, -k $t->name, $t; };
ok(%h, "fetch multi-key");
ok($h{1},   "multi-key 1 present");
ok($h{3},   "multi-key 3 present");
ok(!$h{2},  "multi-key 2 not present");
ok(!$h{hello},  "multi-key hello not present");
ok(!$h{ehlo},  "multi-key ehlo not present");
ok($h{1}{hello},   "multi-key 1/hello present");
ok($h{3}{ehlo},   "multi-key 3/ehlo present");
ok(!$h{1}{ehlo},   "multi-key 1/ehlo not present");
ok(!$h{3}{hello},   "multi-key 3/hello not present");
is($h{1}{hello}{id},   1, "multi-key 1/hello key id");
is($h{1}{hello}{name}, "hello", "multi-key 1/hello key name");
is($h{3}{ehlo}{id},   3, "multi-key 3/ehlo key id");
is($h{3}{ehlo}{name}, "ehlo", "multi-key 3/ehlo key name");
ok(!exists $h{1}{'$kf-1'}, "multi-key no key field");