imacat/DbFramework
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Initial commit.

Browse Source
This commit is contained in:
依瑪貓
2021-02-08 00:21:11 +08:00
commit ca4eef314f
38 changed files with 7647 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

38
t/10base.t Executable file
View File

@@ -0,0 +1,38 @@
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
use strict;
use Test;
use DBI 1.06;
use DbFramework::Util;
use DbFramework::Catalog;
use t::Config;
require "t/util.pl";
BEGIN {
plan tests => 1;
}
package Foo;
use strict;
use base qw(DbFramework::Util);
my %fields = (
NAME => undef,
CONTAINS_H => undef,
);
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = bless { _PERMITTED => \%fields, %fields, }, $class;
$self->name(shift);
$self->contains_h(shift);
return $self;
}
package main;
my $foo = new Foo('foo',['foo','oof','bar','rab','baz','zab']);
my @names = $foo->contains_h_byname('foo','bar');
ok("@names",'oof rab');

156
t/15catalog.t Executable file
View File

@@ -0,0 +1,156 @@
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
use strict;
use Test;
use t::Config;
BEGIN { plan tests => scalar(@t::Config::drivers) * 5 }
require 't/util.pl';
use DbFramework::Catalog;
use DbFramework::Util;
use DbFramework::DataModel;
use DbFramework::Table;
my($t1,$t2);
for my $driver ( @t::Config::drivers ) {
if ( $driver eq 'mSQL' ) {
$t1 = qq{CREATE TABLE foo (foo integer not null,
bar char(10) not null,
baz char(10),
quux integer,
foobar text(10)
)};
$t2 = qq{CREATE TABLE bar (foo integer not null,
# foreign key (foo)
foo_foo integer,
foo_bar char(10),
bar integer
)};
} elsif ( $driver eq 'mysql' ) {
$t1 = qq{CREATE TABLE foo (foo integer not null auto_increment,
bar varchar(10) not null,
baz varchar(10) not null,
quux integer not null,
foobar text,
KEY foo(bar,baz),
KEY bar(baz,quux),
PRIMARY KEY (foo,bar)
)};
$t2 = qq{CREATE TABLE bar (foo integer not null auto_increment,
# foreign key (foo)
foo_foo integer not null,
foo_bar varchar(10) not null,
bar integer,
KEY f_foo(foo_foo,foo_bar),
PRIMARY KEY (foo)
)};
} elsif ( $driver eq 'Pg' ) {
$t1 = qq{CREATE TABLE foo (foo integer not null,
bar varchar(10) not null,
baz varchar(10) not null,
quux integer not null,
foobar text,
UNIQUE(bar,baz),
UNIQUE(baz,quux),
PRIMARY KEY (foo,bar)
)};
$t2 = qq{CREATE TABLE bar (foo integer not null,
-- foreign key (foo)
foo_foo integer not null,
foo_bar varchar(10) not null,
bar integer,
UNIQUE(foo_foo,foo_bar),
PRIMARY KEY (foo)
)};
} elsif ( $driver eq 'Sybase' ) {
$t1 = qq{CREATE TABLE foo (foo numeric(10,0) identity not null,
bar varchar(10) not null,
baz varchar(10) not null,
quux integer not null,
foobar text,
UNIQUE (bar,baz),
UNIQUE (baz,quux),
PRIMARY KEY (foo,bar)
)};
$t2 = qq{CREATE TABLE bar (foo numeric(10,0) identity not null,
-- foreign key (foo)
foo_foo integer not null,
foo_bar varchar(10) not null,
bar integer,
UNIQUE (foo_foo,foo_bar),
PRIMARY KEY (foo)
)};
} elsif ( $driver eq 'CSV' ) {
$t1 = qq{CREATE TABLE foo (foo integer,
bar varchar(10),
baz varchar(10),
quux integer,
foobar varchar(255)
)};
$t2 = qq{CREATE TABLE bar (foo integer,
foo_foo integer,
foo_bar varchar(10),
bar integer
)};
} else { # ODBC syntax for auto increment is IDENTITY(seed,increment)
$t1 = qq{CREATE TABLE foo (foo integer not null identity(0,1),
bar varchar(10) not null,
baz varchar(10) not null,
quux integer not null,
foobar text,
KEY foo(bar,baz),
KEY bar(baz,quux),
PRIMARY KEY (foo,bar)
)};
$t2 = qq{CREATE TABLE bar (foo integer not null identity(0,1),
# foreign key (foo)
foo_foo integer not null,
foo_bar varchar(10) not null,
bar integer,
KEY f_foo(foo_foo,foo_bar),
PRIMARY KEY (foo)
)};
}
foo($driver,'foo',$t1,'bar',$t2);
}
sub foo($$$$$) {
my($driver,$t1,$t1_sql,$t2,$t2_sql) = @_;
my($catalog_db,$c_dsn,$c_u,$c_p) = connect_args($driver,'catalog');
my($test_db,$dsn,$u,$p) = connect_args($driver,'test');
my $c = new DbFramework::Catalog($c_dsn,$c_u,$c_p);
ok(1);
my $dbh = DbFramework::Util::get_dbh($dsn,$u,$p);
$dbh->{PrintError} = 0; # don't warn about dropping non-existent tables
drop_create($test_db,$t1,undef,$t1_sql,$dbh);
drop_create($test_db,$t2,undef,$t2_sql,$dbh);
my $dm = new DbFramework::DataModel($test_db,$dsn,$u,$p);
$dm->init_db_metadata($c_dsn,$c_u,$c_p);
# test primary keys
my $foo_table = $dm->collects_table_h_byname('foo');
ok($foo_table->is_identified_by->as_sql,'PRIMARY KEY (foo,bar)');
# test keys
my @keys = @{$foo_table->is_accessed_using_l};
my($bar,$foo);
if ( $driver eq 'mSQL' ) {
($bar,$foo) = (1,0);
} else {
($bar,$foo) = (0,1);
}
ok($keys[$bar]->as_sql,'KEY bar (baz,quux)');
ok($keys[$foo]->as_sql,'KEY foo (bar,baz)');
# test foreign keys
my $bar_table = $dm->collects_table_h_byname('bar');
my $fk = $bar_table->has_foreign_keys_h_byname('f_foo');
ok($fk->as_sql,'KEY f_foo (foo_foo,foo_bar)');
$dbh->disconnect;
}

70
t/17datatype.t Executable file
View File

@@ -0,0 +1,70 @@
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
use strict;
use Test;
use t::Config;
BEGIN {
my $tests;
my %tests = ( 'mSQL' => 1, 'mysql' => 3, 'Pg' => 0 );
for ( @t::Config::drivers ) { $tests += $tests{$_}; }
plan tests => $tests;
}
require 't/util.pl';
use DbFramework::DataType::ANSII;
use DbFramework::DataType::Mysql;
use DbFramework::Util;
use DbFramework::DataModel;
for ( @t::Config::drivers ) { foo($_) }
sub foo($) {
my $driver = shift;
my($catalog_db,$c_dsn,$c_u,$c_p) = connect_args($driver,'catalog');
my($test_db,$dsn,$u,$p) = connect_args($driver,'test');
my $dm = new DbFramework::DataModel($test_db,$dsn,$u,$p);
$dm->init_db_metadata($c_dsn,$c_u,$c_p);
my $dbh = $dm->dbh; $dbh->{PrintError} = 0;
my $t = $dm->collects_table_h_byname('foo');
my $dt;
if ( $driver eq 'mSQL' ) {
# mapping of mSQL => ANSII types
ok($t->as_sql,'CREATE TABLE foo (
foo INT(4) NOT NULL,
bar CHAR(10) NOT NULL,
baz CHAR(10),
quux INT(4),
foobar TEXT(10),
PRIMARY KEY (foo,bar),
KEY foo (bar,baz),
KEY bar (baz,quux)
)');
} elsif ( $driver eq 'mysql' ) {
# mapping of Mysql => ANSII types
ok($t->as_sql,'CREATE TABLE foo (
foo INTEGER UNSIGNED(11) NOT NULL AUTO_INCREMENT,
bar VARCHAR(10) NOT NULL,
baz VARCHAR(10) NOT NULL,
quux INTEGER UNSIGNED(11) NOT NULL,
foobar TEXT(65535),
PRIMARY KEY (foo,bar),
KEY bar (baz,quux),
KEY foo (bar,baz)
)');
# valid Mysql type
my $mdt = new DbFramework::DataType::Mysql($dm,253,12,50);
ok($mdt->name,'VARCHAR');
# invalid Mysql type
$mdt = eval { new DbFramework::DataType::Mysql($dm,69,12,undef) };
ok($@,'Invalid Mysql data type: 69
');
}
$dbh->disconnect;
}

171
t/20table.t Executable file
View File

@@ -0,0 +1,171 @@
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
use strict;
use Test;
use t::Config;
BEGIN {
my $tests;
for ( @t::Config::drivers ) {
$tests += ($_ ne 'mysql') ? 27 : 28;
}
plan tests => $tests;
}
require 't/util.pl';
use DbFramework::Attribute;
use DbFramework::Table;
use DbFramework::Util;
use DbFramework::DataModel;
use DbFramework::Catalog;
for ( @t::Config::drivers ) { foo($_) }
sub foo($) {
my $driver = shift;
my($catalog_db,$c_dsn,$c_u,$c_p) = connect_args($driver,'catalog');
my($test_db,$dsn,$u,$p) = connect_args($driver,'test');
my $dm = new DbFramework::DataModel($test_db,$dsn,$u,$p);
my $dbh = $dm->dbh; $dbh->{PrintError} = 0;
my $c = new DbFramework::Catalog($c_dsn,$c_u,$c_p);
$dm->init_db_metadata($c_dsn,$c_u,$c_p);
my $foo_table = $dm->collects_table_h_byname('foo');
# as_string()
my $ok_string;
if ( $driver eq 'mSQL' ) { # doesn't support auto_increment
$ok_string = <<EOF;
Table: foo
foo(INT (4) NOT NULL)
bar(CHAR (10) NOT NULL)
baz(CHAR (10))
quux(INT (4))
foobar(TEXT (10))
EOF
} elsif ( $driver eq 'mysql' ) {
$ok_string = <<EOF;
Table: foo
foo(INTEGER UNSIGNED (11) NOT NULL AUTO_INCREMENT)
bar(VARCHAR (10) NOT NULL)
baz(VARCHAR (10) NOT NULL)
quux(INTEGER UNSIGNED (11) NOT NULL)
foobar(TEXT (65535))
EOF
} elsif ( $driver eq 'Pg' ) {
$ok_string = <<EOF;
Table: foo
foo(INT4)
bar(VARCHAR)
baz(VARCHAR)
quux(INT4)
foobar(TEXT)
EOF
} else {
$ok_string = <<EOF;
Table: foo
foo(INTEGER UNSIGNED (11) NOT NULL IDENTITY(0,1))
bar(VARCHAR (10) NOT NULL)
baz(VARCHAR (10) NOT NULL)
quux(INTEGER UNSIGNED (11) NOT NULL)
foobar(TEXT (65535))
EOF
}
ok($foo_table->as_string,$ok_string);
# as_html_form()
$ok_string = <<EOF;
<tr><td><INPUT NAME="foo" VALUE="" SIZE=10 TYPE="text"></td></tr>
<tr><td><INPUT NAME="bar" VALUE='' SIZE=30 TYPE="text" MAXLENGTH=10></td></tr>
<tr><td><INPUT NAME="baz" VALUE='' SIZE=30 TYPE="text" MAXLENGTH=10></td></tr>
<tr><td><INPUT NAME="quux" VALUE="" SIZE=10 TYPE="text"></td></tr>
<tr><td><TEXTAREA COLS=60 NAME="foobar" ROWS=4></TEXTAREA></td></tr>
EOF
ok($foo_table->as_html_form,$ok_string);
# delete()
$foo_table->delete;
ok(1);
# insert()
my(@rows,$pk);
my $i = 0;
for ('foo','bar','baz','quux') {
push(@rows,{ foo => 0, bar => $_, baz => 'foo', quux => $i });
$i++;
}
for ( @rows ) { $pk = $foo_table->insert($_) }
if ( $driver =~ /(mSQL|Pg)/ ) { # no auto_increment
ok(1);
} else {
ok($pk,$#rows + 1);
}
# select()
my @lol = $foo_table->select(['foo']);
ok(@lol,4);
if ( $driver eq 'mysql' ) {
# apply a function to a column in a 'SELECT...'
my @loh = $foo_table->select_loh([q[lpad(foo,2,'0')]]);
ok($loh[0]->{q[lpad(foo,2,'0')]},'01');
}
# mSQL doesn't return # rows modified
my $rows = ( $driver eq 'mSQL' ) ? -1 : 2;
ok($foo_table->delete(q{bar LIKE 'b%'}),$rows);
# update()
my $new_bar = 'bar';
$rows = ( $driver eq 'mSQL' ) ? -1 : 1;
ok($foo_table->update({bar => $new_bar },q{bar = 'foo'}),$rows);
@lol = $foo_table->select(['bar'],undef,'bar');
ok($lol[0]->[0],$new_bar);
my @loh = $foo_table->select_loh(['bar'],undef,'bar');
ok($loh[0]->{bar},$new_bar);
# data model
ok($dm->collects_table_h_byname('foo')->name,'foo');
ok($dm->collects_table_h_byname('foo')->is_identified_by->as_sql,"PRIMARY KEY (foo,bar)");
# foreign keys
$foo_table = $dm->collects_table_h_byname('foo');
ok($foo_table->is_identified_by->incorporates->name,'f_foo');
my $bar_table = $dm->collects_table_h_byname('bar');
ok($bar_table->has_foreign_keys_h_byname('f_foo')->name,'f_foo');
my @fk = @{$bar_table->has_foreign_keys_l};
my %fk = %{$bar_table->has_foreign_keys_h};
my @keys = keys(%fk);
ok(scalar(@fk),scalar(@keys));
@fk = $dm->collects_table_h_byname('foo')->is_identified_by->incorporates;
ok(scalar(@fk),scalar(@keys));
ok($fk[0],$fk{f_foo});
# keys
ok($foo_table->in_key($foo_table->get_attributes('bar')),1);
ok($foo_table->in_key($foo_table->get_attributes('foo')),0);
# primary keys
ok($foo_table->is_identified_by->belongs_to($foo_table),$foo_table);
ok($foo_table->in_primary_key($foo_table->get_attributes('foo')),1);
ok($foo_table->in_primary_key($foo_table->get_attributes('baz')),0);
# foreign key
my @fks = @{$bar_table->has_foreign_keys_l};
ok(@fks,1);
ok($bar_table->in_foreign_key($bar_table->get_attributes('foo_foo')),1);
ok($bar_table->in_foreign_key($bar_table->get_attributes('foo')),0);
# non-keys
ok($foo_table->in_any_key($foo_table->get_attributes('foo')),1);
ok($bar_table->in_any_key($bar_table->get_attributes('bar')),0);
my @nka = $bar_table->non_key_attributes;
ok($nka[0]->name,'bar');
$dm->dbh->disconnect;
$dbh->disconnect;
}

82
t/30persistent.t Executable file
View File

@@ -0,0 +1,82 @@
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
use strict;
use Test;
use t::Config;
BEGIN { plan tests => scalar(@t::Config::drivers) * 12 }
require 't/util.pl';
use DbFramework::Persistent;
use DbFramework::DataModel;
use DbFramework::Table;
use DbFramework::Util;
package Foo;
use base qw(DbFramework::Persistent);
package main;
for ( @t::Config::drivers ) { foo($_) }
sub foo($) {
my($driver) = @_;
my($catalog_db,$c_dsn,$c_u,$c_p) = connect_args($driver,'catalog');
my($test_db,$dsn,$u,$p) = connect_args($driver,'test');
my $dm = new DbFramework::DataModel($test_db,$dsn,$u,$p);
$dm->init_db_metadata($c_dsn,$c_u,$c_p);
my $dbh = $dm->dbh; $dbh->{PrintError} = 0;
my $catalog = new DbFramework::Catalog($c_dsn);
my $foo = new Foo($dm->collects_table_h_byname('foo'),$dbh,$catalog);
ok(1);
# init
$foo->table->delete;
ok(1);
# insert
$foo->attributes_h(['foo',0,'bar','bar','baz','baz','quux',0]);
my $pk = ($driver =~ /(mSQL|Pg)/ ) ? -1 : 1;
ok($foo->insert,$pk);
my %foo = ( foo => 0, bar => 'baz', baz => 'baz', quux => 1 );
$foo->attributes_h([ %foo ]);
$pk = ($driver =~ /(mSQL|Pg)/ ) ? -1 : 2;
ok($foo->insert,$pk);
my @foo = $foo->attributes_h_byname('foo','bar');
ok($foo[1],$foo{bar});
# update
$pk = ($driver =~ /(mSQL|Pg)/ ) ? 0 : 2;
$foo->attributes_h(['foo',$pk,'bar','baz','baz','quux']);
my $rows = ($driver =~ /mSQL/ ) ? -1 : 1;
ok($foo->update,$rows);
# select
$foo->attributes_h([]);
@foo = $foo->select(undef,'bar');
my @a = $foo[0]->attributes_h_byname('foo','bar');
$pk = ($driver =~ /(mSQL|Pg)/ ) ? 0 : 1;
ok("@a","$pk bar");
@a = $foo[1]->attributes_h_byname('foo','bar');
$pk = ($driver =~ /(mSQL|Pg)/ ) ? 0 : 2;
ok("@a","$pk baz");
@foo = $foo->select(q{bar like 'b%'},'foo,bar');
ok(@foo,2);
# delete
$rows = ($driver =~ /mSQL/ ) ? -1 : 1;
ok($foo[0]->delete,$rows);
# make persistent (sub)class
my($class,$table) = ('Bar','bar');
my $ok = qq{package $class;
use strict;
use base qw(DbFramework::Persistent);
};
ok(DbFramework::Persistent->make_class($class),$ok);
eval $ok;
my $bar = $class->new($dm->collects_table_h_byname($table),$dbh,$catalog);
ok($bar->table->name,$table);
}

54
t/40template.t Executable file
View File

@@ -0,0 +1,54 @@
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
use strict;
use Test;
use t::Config;
require 't/util.pl';
BEGIN { plan tests => scalar(@t::Config::drivers) * 4 + 1 }
use DbFramework::Template;
ok(1);
use DbFramework::DataModel;
for ( @t::Config::drivers ) { foo($_) }
sub foo($) {
my $driver = shift;
my($catalog_db,$c_dsn,$c_u,$c_p) = connect_args($driver,'catalog');
my($test_db,$dsn,$u,$p) = connect_args($driver,'test');
my $dm = new DbFramework::DataModel($test_db,$dsn,$u,$p);
$dm->init_db_metadata($c_dsn,$c_u,$c_p);
my $dbh = $dm->dbh; $dbh->{PrintError} = 0;
my $t = new DbFramework::Template("(:&db_value(foo.bar):)",
$dm->collects_table_l);
ok(1);
my $filling = 'bar';
ok($t->fill({'foo.bar' => $filling}),$filling);
$t->template->text("(:&db_html_form_field(foo.bar,,int):)");
my $ok = '<INPUT NAME="bar" VALUE="" SIZE=10 TYPE="text">';
ok($t->fill,$ok);
$t->template->text("(:&db_fk_html_form_field(bar.f_foo):)");
if ( $driver =~ /(mSQL|Pg)/ ) {
$ok = qq{<SELECT NAME="foo_foo,foo_bar">
<OPTION VALUE="">** Any Value **
<OPTION VALUE="NULL">NULL
<OPTION VALUE="0,baz">baz
</SELECT>
};
} else {
$ok = qq{<SELECT NAME="foo_foo,foo_bar">
<OPTION VALUE="">** Any Value **
<OPTION VALUE="NULL">NULL
<OPTION VALUE="2,baz">baz
</SELECT>
};
}
ok($t->fill,$ok);
}

20
t/Config.pm Normal file
View File

@@ -0,0 +1,20 @@
package t::Config;
$test_db = 'test';
@drivers = qw/mysql Pg/;
%driver = (mysql => {
test => {
p => '',u => '',dsn => 'DBI:mysql:database=test',},
dbframework_catalog => {
p => '',u => '',dsn => 'DBI:mysql:database=dbframework_catalog',},
},
Pg => {
test => {
p => '',u => '',dsn => 'DBI:Pg:dbname=test',},
dbframework_catalog => {
p => '',u => '',dsn => 'DBI:Pg:dbname=dbframework_catalog',},
},
);
1;

3
t/template Normal file
View File

@@ -0,0 +1,3 @@
<DbField foo.foo>
<DbField foo.bar value=www.motorbase.com>
<DbField foo.baz value=1 type=INT>

6
t/test/foo/foo.form Normal file
View File

@@ -0,0 +1,6 @@
(
foo => qq{<DbField foo.foo>
<DbField foo.bar value=www.motorbase.com>
<DbField foo.baz value=1 type=INT>},
bar => q{bar},
)

54
t/util.pl Normal file
View File

@@ -0,0 +1,54 @@
sub drop_create {
my($db,$table,$c,$sql,$dbh) = @_;
my $rv = $dbh->do("DROP TABLE $table");
## init catalog
if ( defined $c ) {
my $c_sql = qq{
DELETE FROM c_key
WHERE db_name = '$db'
AND ( table_name = '$table' )
};
my $sth = do_sql($c->dbh,$c_sql); $sth->finish;
$c_sql = qq{
DELETE FROM c_relationship
WHERE db_name = '$db'
AND ( fk_table = '$table' )
};
$sth = do_sql($c->dbh,$c_sql); $sth->finish;
}
return $dbh->do($sql) || die $dbh->errstr;
}
sub do_sql {
my($dbh,$sql) = @_;
#print STDERR "$sql\n";
my $sth = $dbh->prepare($sql) || die($dbh->errstr);
my $rv = $sth->execute || die($sth->errstr);
return $sth;
}
sub connect_args($$) {
my %driver = %t::Config::driver;
my($driver,$db) = @_;
my $catalog_db = $DbFramework::Catalog::db;
my($db_name,$dsn,$u,$p);
SWITCH: {
($db eq 'catalog') && do {
$db_name = $catalog_db;
};
($db eq 'test') && do {
delete $driver{$driver}->{$catalog_db};
($db_name) = keys %{$driver{$driver}};
};
}
$dsn = $driver{$driver}->{$db_name}->{dsn};
$u = $driver{$driver}->{$db_name}->{u};
$p = $driver{$driver}->{$db_name}->{p};
return($db_name,$dsn,$u,$p);
}
1;