cvs commit: p5ee/App-Repository/t DBI-expr.t DBI-repobjectdom.t DBI-repobjects.t DBI-repobjectset.t
[email protected] (Stephen Adkins)
| Newsgroups | perl.cvs.p5ee |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 05/11/15 08:49:11
Added: App-Repository/t DBI-expr.t DBI-repobjectdom.t
DBI-repobjects.t DBI-repobjectset.t
Log:
new
Revision Changes Path
1.1 p5ee/App-Repository/t/DBI-expr.t
Index: DBI-expr.t
===================================================================
#!/usr/local/bin/perl -w
use App::Options (
options => [qw(dbdriver dbclass dbhost dbname dbuser dbpass)],
option => {
dbclass => { default => "App::Repository::MySQL", },
dbdriver => { default => "mysql", },
dbhost => { default => "localhost", },
dbname => { default => "test", },
dbuser => { default => "", },
dbpass => { default => "", },
},
);
use Test::More qw(no_plan);
use lib "../App-Context/lib";
use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
use App;
use App::Repository;
use strict;
if (!$App::options{dbuser}) {
ok(1, "No dbuser given. Tests assumed OK. (add dbuser=xxx and dbpass=yyy to app.conf in 't' directory)");
exit(0);
}
my $context = App->context(
conf_file => "",
conf => {
Repository => {
default => {
class => $App::options{dbclass},
dbdriver => $App::options{dbdriver},
dbhost => $App::options{dbhost},
dbname => $App::options{dbname},
dbuser => $App::options{dbuser},
dbpass => $App::options{dbpass},
table => {
test_person => {
primary_key => ["person_id"],
column => {
age_sq => {
expr => "{age}*{age}",
},
public_age => {
expr => "{age}-10",
},
wisdom_score => {
expr => "{age_sq}/20", # an expression of expressions
},
},
},
},
},
},
},
#debug_sql => 1,
);
my $rep = $context->repository();
{
#cheating... I know its a DBI, but I have to set up the test somehow
my $dbh = $rep->{dbh};
eval { $dbh->do("drop table test_person"); };
my $ddl = <<EOF;
create table test_person (
person_id integer not null auto_increment primary key,
first_name varchar(99) null,
last_name varchar(99) null,
address varchar(99) null,
city varchar(99) null,
state varchar(99) null,
zip varchar(10) null,
country char(2) null,
home_phone varchar(99) null,
work_phone varchar(99) null,
email_address varchar(99) null,
gender char(1) null,
birth_dt date null,
age integer null,
index person_ie1 (last_name, first_name)
)
EOF
$dbh->do($ddl);
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (1,40,'stephen', 'M','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (2,37,'susan', 'F','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (3, 6,'maryalice','F','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (4, 3,'paul', 'M','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (5, 1,'christine','F','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (6,45,'tim', 'M','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (7,39,'keith', 'M','GA')");
}
###########################################################################
# DATA ACCESS TESTS
###########################################################################
my ($person_id, $first_name, $last_name, $address, $city, $state, $zip, $country);
my ($home_phone, $work_phone, $email_address, $gender, $birth_dt, $age);
my $columns = [ "person_id", "age", "first_name", "gender", "state" ];
my $rows = [
[ 1, 40, "stephen", "M", "GA", ],
[ 2, 37, "susan", "F", "GA", ],
[ 3, 6, "maryalice", "F", "GA", ],
[ 4, 3, "paul", "M", "GA", ],
[ 5, 1, "christine", "F", "GA", ],
[ 6, 45, "tim", "M", "GA", ],
[ 7, 39, "keith", "M", "GA", ],
];
#####################################################################
# $value = $rep->get ($table, $key, $col, \%options);
# $rep->set($table, $key, $col, $value, \%options);
#####################################################################
{
my ($row, $rows, $hash, $hashes, $objects, $object, $nrows);
my ($age, $age_sq, $wisdom_score, $public_age);
$age = $rep->get("test_person",1,"age");
is($age, 40, "get(age)");
$age_sq = $rep->get("test_person",1,"age_sq");
is($age_sq, 1600, "get(age_sq)");
$wisdom_score = $rep->get("test_person",1,"wisdom_score");
is($wisdom_score, 80, "get(wisdom_score)");
my @cols = ("wisdom_score");
$rows = $rep->get_rows("test_person",1,\@cols);
$row = $rows->[0];
is($row->[0], 80, "get_rows(wisdom_score)");
$hashes = $rep->get_hashes("test_person",1,\@cols);
$hash = $hashes->[0];
is($hash->{wisdom_score}, 80, "get_hashes(wisdom_score)");
$objects = $rep->get_objects("test_person",1,\@cols);
$object = $objects->[0];
is($object->{wisdom_score}, 80, "get_objects(wisdom_score)");
}
1.1 p5ee/App-Repository/t/DBI-repobjectdom.t
Index: DBI-repobjectdom.t
===================================================================
#!/usr/local/bin/perl -w
use App::Options (
options => [qw(dbdriver dbclass dbhost dbname dbuser dbpass)],
option => {
dbclass => { default => "App::Repository::MySQL", },
dbdriver => { default => "mysql", },
dbhost => { default => "localhost", },
dbname => { default => "test", },
dbuser => { default => "", },
dbpass => { default => "", },
},
);
use Test::More qw(no_plan);
use lib "../App-Context/lib";
use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
use App;
use App::Repository;
use strict;
if (!$App::options{dbuser}) {
ok(1, "No dbuser given. Tests assumed OK. (add dbuser=xxx and dbpass=yyy to app.conf in 't' directory)");
exit(0);
}
my $context = App->context(
conf_file => "",
conf => {
Repository => {
default => {
class => $App::options{dbclass},
dbdriver => $App::options{dbdriver},
dbhost => $App::options{dbhost},
dbname => $App::options{dbname},
dbuser => $App::options{dbuser},
dbpass => $App::options{dbpass},
table => {
test_person => {
primary_key => ["person_id"],
},
},
},
},
SessionObject => {
adults => {
class => "App::SessionObject::RepositoryObjectDomain",
params => {
"age.ge" => 18,
},
#object_set => {
# test_person => {
# name => "foo",
# args => {
# params => {
# "age.ge" => 1,
# },
# },
# },
#},
},
},
},
);
my $rep = $context->repository();
{
#cheating... I know its a DBI, but I have to set up the test somehow
my $dbh = $rep->{dbh};
eval { $dbh->do("drop table test_person"); };
my $ddl = <<EOF;
create table test_person (
person_id integer not null auto_increment primary key,
first_name varchar(99) null,
last_name varchar(99) null,
address varchar(99) null,
city varchar(99) null,
state varchar(99) null,
zip varchar(10) null,
country char(2) null,
home_phone varchar(99) null,
work_phone varchar(99) null,
email_address varchar(99) null,
gender char(1) null,
birth_dt date null,
age integer null,
index person_ie1 (last_name, first_name)
)
EOF
$dbh->do($ddl);
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (1,39,'stephen', 'M','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (2,37,'susan', 'F','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (3, 6,'maryalice','F','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (4, 3,'paul', 'M','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (5, 1,'christine','F','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (6,45,'tim', 'M','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (7,39,'keith', 'M','GA')");
}
###########################################################################
# DATA ACCESS TESTS
###########################################################################
my ($person_id, $first_name, $last_name, $address, $city, $state, $zip, $country);
my ($home_phone, $work_phone, $email_address, $gender, $birth_dt, $age);
my $columns = [ "person_id", "age", "first_name", "gender", "state" ];
my $rows = [
[ 1, 39, "stephen", "M", "GA", ],
[ 2, 37, "susan", "F", "GA", ],
[ 3, 6, "maryalice", "F", "GA", ],
[ 4, 3, "paul", "M", "GA", ],
[ 5, 1, "christine", "F", "GA", ],
[ 6, 45, "tim", "M", "GA", ],
[ 7, 39, "keith", "M", "GA", ],
];
my ($row, $nrows);
#####################################################################
# $value = $rep->get ($table, $key, $col, \%options);
# $rep->set($table, $key, $col, $value, \%options);
#####################################################################
{
my $objdom = $context->session_object("adults");
my $objset = $objdom->get_object_set("test_person");
ok(1, "looks good");
my ($objects, $index);
eval {
$objects = $objset->get_objects();
};
ok(! $@, "table defined implicitly [$@]");
#$objset->set_table("test_person");
$objects = $objset->get_objects();
ok($#$objects == 3, "got 4 objects");
$objset->set_params({});
$objects = $objset->get_objects("F",["gender"]);
ok($#$objects == 2, "got 3 female objects");
$objects = $objset->get_objects("M");
ok($#$objects == 3, "got 4 male objects");
$index = $objset->get_index();
ok(ref($index) eq "HASH", "got a hashref for an index");
ok(defined $index->{M}, "M part of index found");
ok(defined $index->{F}, "F part of index found");
ok(ref($index->{M}) eq "ARRAY", "M part of index ARRAY ref");
ok(ref($index->{F}) eq "ARRAY", "F part of index ARRAY ref");
my $values = $objset->get_column_values("gender");
is_deeply($values, ["M","F"], "gender values");
$index = $objset->get_unique_index("ak1", ["first_name"]);
is($index->{stephen}{age}, 39, "get_unique_index worked on stephen");
$objset->set_params({ "age.ge" => 1 });
$objset->update_params({ "age.ge" => 18, first_name => "stephen"});
$objects = $objset->get_objects();
ok($#$objects == 3, "got 4 objects");
$objset->get_unique_index(["first_name"]);
my $object = $objset->get_object("stephen");
ok($object->{age} == 39, "got stephen object (age 39)");
}
{
my $dbh = $rep->{dbh};
$dbh->do("drop table test_person");
}
exit 0;
1.1 p5ee/App-Repository/t/DBI-repobjects.t
Index: DBI-repobjects.t
===================================================================
#!/usr/local/bin/perl -w
use App::Options (
options => [qw(dbdriver dbclass dbhost dbname dbuser dbpass)],
option => {
dbclass => { default => "App::Repository::MySQL", },
dbdriver => { default => "mysql", },
dbhost => { default => "localhost", },
dbname => { default => "test", },
dbuser => { default => "", },
dbpass => { default => "", },
},
);
use Test::More qw(no_plan);
use lib "../App-Context/lib";
use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
use App;
use App::Repository;
use strict;
if (!$App::options{dbuser}) {
ok(1, "No dbuser given. Tests assumed OK. (add dbuser=xxx and dbpass=yyy to app.conf in 't' directory)");
exit(0);
}
my $context = App->context(
conf_file => "",
conf => {
Repository => {
default => {
class => $App::options{dbclass},
dbdriver => $App::options{dbdriver},
dbhost => $App::options{dbhost},
dbname => $App::options{dbname},
dbuser => $App::options{dbuser},
dbpass => $App::options{dbpass},
table => {
test_person => {
primary_key => ["person_id"],
},
},
},
},
},
);
my $rep = $context->repository();
{
#cheating... I know its a DBI, but I have to set up the test somehow
my $dbh = $rep->{dbh};
eval { $dbh->do("drop table test_person"); };
my $ddl = <<EOF;
create table test_person (
person_id integer not null auto_increment primary key,
first_name varchar(99) null,
last_name varchar(99) null,
address varchar(99) null,
city varchar(99) null,
state varchar(99) null,
zip varchar(10) null,
country char(2) null,
home_phone varchar(99) null,
work_phone varchar(99) null,
email_address varchar(99) null,
gender char(1) null,
birth_dt date null,
age integer null,
index person_ie1 (last_name, first_name)
)
EOF
$dbh->do($ddl);
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (1,39,'stephen', 'M','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (2,37,'susan', 'F','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (3, 6,'maryalice','F','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (4, 3,'paul', 'M','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (5, 1,'christine','F','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (6,45,'tim', 'M','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (7,39,'keith', 'M','GA')");
}
###########################################################################
# DATA ACCESS TESTS
###########################################################################
my ($person_id, $first_name, $last_name, $address, $city, $state, $zip, $country);
my ($home_phone, $work_phone, $email_address, $gender, $birth_dt, $age);
my $columns = [ "person_id", "age", "first_name", "gender", "state" ];
my $rows = [
[ 1, 39, "stephen", "M", "GA", ],
[ 2, 37, "susan", "F", "GA", ],
[ 3, 6, "maryalice", "F", "GA", ],
[ 4, 3, "paul", "M", "GA", ],
[ 5, 1, "christine", "F", "GA", ],
[ 6, 45, "tim", "M", "GA", ],
[ 7, 39, "keith", "M", "GA", ],
];
my ($row, $nrows);
#####################################################################
# $value = $rep->get ($table, $key, $col, \%options);
# $rep->set($table, $key, $col, $value, \%options);
#####################################################################
{
my $obj = $rep->get_object("test_person", 1);
$first_name = $obj->get("first_name");
is($first_name, "stephen", "get() first_name [$first_name]");
is($obj->set("first_name", "steve"),1,"set() first name [steve]");
}
{
my $obj = $rep->get_object("test_person", 1);
$first_name = $obj->get("first_name");
is($first_name, "steve", "get() modified first_name [$first_name]");
$age = $obj->get("age");
is($age, 39, "get() age");
}
{
my $obj = $rep->get_object("test_person", 1, []);
$first_name = $obj->get("first_name");
is($first_name, "steve", "get() modified first_name [$first_name] from uninit object");
$age = $obj->get("age");
is($age, 39, "get() age from uninit object");
}
{
my $obj = $rep->get_object("test_person", 2, []);
ok($obj->set(["first_name","age"], ["sue",38]), "set() 2 values");
($first_name, $age) = $obj->get(["first_name","age"]);
is($first_name, "sue", "get() 2 values (checking 1 of 2)");
is($age, 38, "get() 2 values (checking 2 of 2)");
}
{
my $objs = $rep->get_objects("test_person", {}, undef, {order_by => "person_id"});
is($objs->[0]{_key}, 1, "get_objects() automatically set the _key");
}
{
my $obj = $rep->get_object("test_person", {}, undef, {order_by => "person_id"});
is($obj->{_key}, 1, "get_object() automatically set the _key");
}
{
ok($rep->set_row("test_person", {first_name=>'paul'}, ["age", "state"], [5, "CA"]),"set_row() 2 values w/ %crit");
my $obj = $rep->get_object("test_person", {first_name=>'paul'}, ["age", "state","person_id"]);
is($obj->{age}, 5, "get_object() 3 values w/ %crit (checking 1 of 3)");
is($obj->{state}, "CA", "get_object() 3 values w/ %crit (checking 2 of 3)");
is($obj->{person_id}, 4, "get_object() 3 values w/ %crit (checking 3 of 3)");
}
{
my $obj = $rep->get_object("test_person", 1);
is($obj->{_key}, 1, "get_object() by key");
my $retval = $obj->delete();
ok($retval, "delete() seems to have worked");
my $obj2 = $rep->get_object("test_person", 1);
ok(! defined $obj2, "delete() yep, it's really gone");
$obj2 = $rep->new_object("test_person", $obj);
is($obj2->{first_name},$obj->{first_name}, "new.first_name seems ok");
is($obj2->{age},$obj->{age}, "new.age seems ok");
is($obj2->{_key},$obj->{_key}, "new._key seems ok");
my $obj3 = $rep->get_object("test_person", 1);
ok(defined $obj2, "new() it's back");
is($obj3->{first_name},$obj->{first_name}, "new.first_name seems ok");
is($obj3->{age},$obj->{age}, "new.age seems ok");
is($obj3->{_key},$obj->{_key}, "new._key seems ok");
my $obj4 = $rep->new_object("test_person",{first_name => "christine"});
is($obj4->{first_name},"christine", "new.first_name (2) seems ok");
is($obj4->{_key},8, "new._key is ok");
is($obj4->{person_id},8, "new.person_id is ok");
}
{
my $dbh = $rep->{dbh};
$dbh->do("drop table test_person");
}
exit 0;
1.1 p5ee/App-Repository/t/DBI-repobjectset.t
Index: DBI-repobjectset.t
===================================================================
#!/usr/local/bin/perl -w
use App::Options (
options => [qw(dbdriver dbclass dbhost dbname dbuser dbpass)],
option => {
dbclass => { default => "App::Repository::MySQL", },
dbdriver => { default => "mysql", },
dbhost => { default => "localhost", },
dbname => { default => "test", },
dbuser => { default => "", },
dbpass => { default => "", },
},
);
use Test::More qw(no_plan);
use lib "../App-Context/lib";
use lib "../../App-Context/lib";
use lib "lib";
use lib "../lib";
use App;
use App::Repository;
use strict;
if (!$App::options{dbuser}) {
ok(1, "No dbuser given. Tests assumed OK. (add dbuser=xxx and dbpass=yyy to app.conf in 't' directory)");
exit(0);
}
my $context = App->context(
conf_file => "",
conf => {
Repository => {
default => {
class => $App::options{dbclass},
dbdriver => $App::options{dbdriver},
dbhost => $App::options{dbhost},
dbname => $App::options{dbname},
dbuser => $App::options{dbuser},
dbpass => $App::options{dbpass},
table => {
test_person => {
primary_key => ["person_id"],
},
},
},
},
SessionObject => {
adults => {
class => "App::SessionObject::RepositoryObjectSet",
#repository => "default",
table => "test_person",
#params => {
# "age.ge" => 18,
#},
},
},
},
);
my $rep = $context->repository();
{
#cheating... I know its a DBI, but I have to set up the test somehow
my $dbh = $rep->{dbh};
eval { $dbh->do("drop table test_person"); };
my $ddl = <<EOF;
create table test_person (
person_id integer not null auto_increment primary key,
first_name varchar(99) null,
last_name varchar(99) null,
address varchar(99) null,
city varchar(99) null,
state varchar(99) null,
zip varchar(10) null,
country char(2) null,
home_phone varchar(99) null,
work_phone varchar(99) null,
email_address varchar(99) null,
gender char(1) null,
birth_dt date null,
age integer null,
index person_ie1 (last_name, first_name)
)
EOF
$dbh->do($ddl);
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (1,39,'stephen', 'M','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (2,37,'susan', 'F','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (3, 6,'maryalice','F','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (4, 3,'paul', 'M','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (5, 1,'christine','F','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (6,45,'tim', 'M','GA')");
$dbh->do("insert into test_person (person_id,age,first_name,gender,state) values (7,39,'keith', 'M','GA')");
}
###########################################################################
# DATA ACCESS TESTS
###########################################################################
my ($person_id, $first_name, $last_name, $address, $city, $state, $zip, $country);
my ($home_phone, $work_phone, $email_address, $gender, $birth_dt, $age);
my $columns = [ "person_id", "age", "first_name", "gender", "state" ];
my $rows = [
[ 1, 39, "stephen", "M", "GA", ],
[ 2, 37, "susan", "F", "GA", ],
[ 3, 6, "maryalice", "F", "GA", ],
[ 4, 3, "paul", "M", "GA", ],
[ 5, 1, "christine", "F", "GA", ],
[ 6, 45, "tim", "M", "GA", ],
[ 7, 39, "keith", "M", "GA", ],
];
my ($row, $nrows);
#####################################################################
# $value = $rep->get ($table, $key, $col, \%options);
# $rep->set($table, $key, $col, $value, \%options);
#####################################################################
{
my $objset = $context->session_object("adults");
ok(1, "looks good");
my ($objects, $index);
#eval {
# $objects = $objset->get_objects();
#};
#ok($@ =~ /table not defined/, "table not defined");
#$objset->set_table("test_person");
$objects = $objset->get_objects();
ok($#$objects == 6, "got all 7 objects");
$objset->set_params({ "age.ge" => 18 });
$objects = $objset->get_objects();
ok($#$objects == 3, "got 4 objects");
$objset->set_params({});
$objects = $objset->get_objects("F",["gender"]);
ok($#$objects == 2, "got 3 female objects");
$objects = $objset->get_objects("M");
ok($#$objects == 3, "got 4 male objects");
$index = $objset->get_index();
ok(ref($index) eq "HASH", "got a hashref for an index");
ok(defined $index->{M}, "M part of index found");
ok(defined $index->{F}, "F part of index found");
ok(ref($index->{M}) eq "ARRAY", "M part of index ARRAY ref");
ok(ref($index->{F}) eq "ARRAY", "F part of index ARRAY ref");
my $values = $objset->get_column_values("gender");
is_deeply($values, ["M","F"], "gender values");
$index = $objset->get_unique_index("ak1", ["first_name"]);
is($index->{stephen}{age}, 39, "get_unique_index worked on stephen");
$objset->set_params({ "age.ge" => 1 });
$objset->update_params({ "age.ge" => 18, first_name => "stephen"});
$objects = $objset->get_objects();
ok($#$objects == 3, "got 4 objects");
$objset->get_unique_index(["first_name"]);
my $object = $objset->get_object("stephen");
ok($object->{age} == 39, "got stephen object (age 39)");
}
{
my $dbh = $rep->{dbh};
$dbh->do("drop table test_person");
}
exit 0;