Initial commit.
This commit is contained in:
38
t/10base.t
Executable file
38
t/10base.t
Executable 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
156
t/15catalog.t
Executable 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
70
t/17datatype.t
Executable 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
171
t/20table.t
Executable 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
82
t/30persistent.t
Executable 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
54
t/40template.t
Executable 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
20
t/Config.pm
Normal 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
3
t/template
Normal 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
6
t/test/foo/foo.form
Normal 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
54
t/util.pl
Normal 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;
|
||||
Reference in New Issue
Block a user