[Rt-devel] [RFC][PATCH] DBIx-SB tests on other DBs
Ruslan U. Zakirov
Ruslan.Zakirov at miet.ru
Fri May 13 11:52:33 EDT 2005
Ahh, forgot attachment :)
Ruslan U. Zakirov wrote:
> Hello.
> Ok, here is what I've done to allow us run SB tests on mysql, postgres
> and other DBs.
>
> All comments are wellcome, but some are required.
> For now I didn't finish several things:
> 1) connect_* functions in utils.pl.
> This functions should connect handle to test DBs of your RDBMS. I wrote
> only simple 'connect_mysql' that connects to DB 'test' with user 'root'
> and empty password. I use it for local testings, but for CPAN we should
> use configurable connect_* functions. Because configuration should be
> asked or entered once across all tests, I think we should use ENV
> variables or write config options into t/ dir. Please, suggest prefered
> way and if you choose ENV then suggest generic naming.
>
> 2) I wrote mysql schemas for current test suite, please, wrote schemas
> for other DBs and send them back with report about test suite success or
> fails.
>
> Wait for your comments. Best regards, Ruslan.
> _______________________________________________
> Rt-devel mailing list
> Rt-devel at lists.bestpractical.com
> http://lists.bestpractical.com/cgi-bin/mailman/listinfo/rt-devel
>
-------------- next part --------------
==== Patch <-> level 1
Source: [No source]
Target: fac90757-c5f0-0310-a953-bfb799f65e4e:/DBIx-SearchBuilder/local:1623
Log:
all tests pass with mysql
=== t/01basics.t
==================================================================
--- t/01basics.t (revision 1623)
+++ t/01basics.t (patch - level 1)
@@ -6,7 +6,9 @@
BEGIN { require "t/utils.pl" }
our (@AvailableDrivers);
-my $total = scalar(@AvailableDrivers) * 4;
+use constant TESTS_PER_DRIVER => 4;
+
+my $total = scalar(@AvailableDrivers) * TESTS_PER_DRIVER;
plan tests => $total;
foreach my $d ( @AvailableDrivers ) {
=== t/01records.t
==================================================================
--- t/01records.t (revision 1623)
+++ t/01records.t (patch - level 1)
@@ -6,105 +6,112 @@
use File::Spec;
use Test::More;
BEGIN { require "t/utils.pl" }
+our (@AvailableDrivers);
-eval "use DBD::SQLite";
-if ($@) {
-plan skip_all => "DBD::SQLite required for testing database interaction"
-} else{
-plan tests => 30;
-}
+use constant TESTS_PER_DRIVER => 30;
-my $handle = get_handle('SQLite');
-connect_handle( $handle );
-isa_ok($handle->dbh, 'DBI::db');
+my $total = scalar(@AvailableDrivers) * TESTS_PER_DRIVER;
+plan tests => $total;
-my $ret = $handle->SimpleQuery(TestApp::Address->schema);
-isa_ok($ret,'DBI::st', "Inserted the schema. got a statement handle back");
+foreach my $d ( @AvailableDrivers ) {
+SKIP: {
+ unless( has_schema( 'TestApp::Address', $d ) ) {
+ skip "No schema for '$d' driver", TESTS_PER_DRIVER;
+ }
+ my $handle = get_handle( $d );
+ connect_handle( $handle );
+ isa_ok($handle->dbh, 'DBI::db');
+ my $ret = init_schema( 'TestApp::Address', $handle );
+ isa_ok($ret,'DBI::st', "Inserted the schema. got a statement handle back");
-my $rec = TestApp::Address->new($handle);
-isa_ok($rec, 'DBIx::SearchBuilder::Record');
+ my $rec = TestApp::Address->new($handle);
+ isa_ok($rec, 'DBIx::SearchBuilder::Record');
-# _Accessible testings
-is( $rec->_Accessible('id' => 'read'), 1, 'id is accessible for read' );
-is( $rec->_Accessible('id' => 'write'), undef, 'id is not accessible for write' );
-is( $rec->_Accessible('unexpected_field' => 'read'), undef, "field doesn't exist and can't be accessible for read" );
+ # _Accessible testings
+ is( $rec->_Accessible('id' => 'read'), 1, 'id is accessible for read' );
+ is( $rec->_Accessible('id' => 'write'), undef, 'id is not accessible for write' );
+ is( $rec->_Accessible('unexpected_field' => 'read'), undef, "field doesn't exist and can't be accessible for read" );
-can_ok($rec,'Create');
+ can_ok($rec,'Create');
-my ($id) = $rec->Create( Name => 'Jesse', Phone => '617 124 567');
-ok($id,"Created record ". $id);
-ok($rec->Load($id), "Loaded the record");
+ my ($id) = $rec->Create( Name => 'Jesse', Phone => '617 124 567');
+ ok($id,"Created record ". $id);
+ ok($rec->Load($id), "Loaded the record");
-is($rec->id, $id, "The record has its id");
-is ($rec->Name, 'Jesse', "The record's name is Jesse");
+ is($rec->id, $id, "The record has its id");
+ is ($rec->Name, 'Jesse', "The record's name is Jesse");
-my ($val, $msg) = $rec->SetName('Obra');
-ok($val, $msg) ;
-is($rec->Name, 'Obra', "We did actually change the name");
+ my ($val, $msg) = $rec->SetName('Obra');
+ ok($val, $msg) ;
+ is($rec->Name, 'Obra', "We did actually change the name");
-# Validate immutability of the field id
-($val, $msg) = $rec->Setid( $rec->id + 1 );
-ok(!$val, $msg);
-is($msg, 'Immutable field', 'id is immutable field');
-is($rec->id, $id, "The record still has its id");
+ # Validate immutability of the field id
+ ($val, $msg) = $rec->Setid( $rec->id + 1 );
+ ok(!$val, $msg);
+ is($msg, 'Immutable field', 'id is immutable field');
+ is($rec->id, $id, "The record still has its id");
-# Check some non existant field
-ok( !eval{ $rec->SomeUnexpectedField }, "The record has no 'SomeUnexpectedField'");
-{
- # test produce DBI warning
- local $SIG{__WARN__} = sub {return};
- is( $rec->_Value( 'SomeUnexpectedField' ), undef, "The record has no 'SomeUnexpectedField'");
-}
-($val, $msg) = $rec->SetSomeUnexpectedField( 'foo' );
-ok(!$val, $msg);
-is($msg, 'Nonexistant field?', "Field doesn't exist");
-($val, $msg) = $rec->_Set('SomeUnexpectedField', 'foo');
-ok(!$val, "$msg");
+ # Check some non existant field
+ ok( !eval{ $rec->SomeUnexpectedField }, "The record has no 'SomeUnexpectedField'");
+ {
+ # test produce DBI warning
+ local $SIG{__WARN__} = sub {return};
+ is( $rec->_Value( 'SomeUnexpectedField' ), undef, "The record has no 'SomeUnexpectedField'");
+ }
+ ($val, $msg) = $rec->SetSomeUnexpectedField( 'foo' );
+ ok(!$val, $msg);
+ is($msg, 'Nonexistant field?', "Field doesn't exist");
+ ($val, $msg) = $rec->_Set('SomeUnexpectedField', 'foo');
+ ok(!$val, "$msg");
-# Validate truncation on update
+ # Validate truncation on update
-($val,$msg) = $rec->SetName('1234567890123456789012345678901234567890');
+ ($val,$msg) = $rec->SetName('1234567890123456789012345678901234567890');
-ok($val, $msg) ;
+ ok($val, $msg) ;
-is($rec->Name, '12345678901234', "Truncated on update");
+ is($rec->Name, '12345678901234', "Truncated on update");
-# Test unicode truncation:
-my $univalue = "這是個測試";
+ # Test unicode truncation:
+ my $univalue = "這是個測試";
-($val,$msg) = $rec->SetName($univalue.$univalue);
+ ($val,$msg) = $rec->SetName($univalue.$univalue);
-ok($val, $msg) ;
+ ok($val, $msg) ;
-is($rec->Name, '這是個測');
+ is($rec->Name, '這是個測');
-# make sure we do _not_ truncate things which should not be truncated
-($val,$msg) = $rec->SetEmployeeId('1234567890');
+ # make sure we do _not_ truncate things which should not be truncated
+ ($val,$msg) = $rec->SetEmployeeId('1234567890');
-ok($val, $msg) ;
+ ok($val, $msg) ;
-is($rec->EmployeeId, '1234567890', "Did not truncate id on create");
+ is($rec->EmployeeId, '1234567890', "Did not truncate id on create");
-# make sure we do truncation on create
-my $newrec = TestApp::Address->new($handle);
-my $newid = $newrec->Create( Name => '1234567890123456789012345678901234567890',
- EmployeeId => '1234567890' );
+ # make sure we do truncation on create
+ my $newrec = TestApp::Address->new($handle);
+ my $newid = $newrec->Create( Name => '1234567890123456789012345678901234567890',
+ EmployeeId => '1234567890' );
-$newrec->Load($newid);
+ $newrec->Load($newid);
-ok ($newid, "Created a new record");
-is($newrec->Name, '12345678901234', "Truncated on create");
-is($newrec->EmployeeId, '1234567890', "Did not truncate id on create");
+ ok ($newid, "Created a new record");
+ is($newrec->Name, '12345678901234', "Truncated on create");
+ is($newrec->EmployeeId, '1234567890', "Did not truncate id on create");
+}} # SKIP, foreach blocks
+1;
+
+
package TestApp::Address;
use base qw/DBIx::SearchBuilder::Record/;
@@ -133,9 +140,20 @@
}
+sub schema_mysql {
+<<EOF;
+CREATE TEMPORARY TABLE Address (
+ id integer AUTO_INCREMENT,
+ Name varchar(36),
+ Phone varchar(18),
+ EmployeeId int(8),
+ PRIMARY KEY (id))
+EOF
-sub schema {
+}
+sub schema_sqlite {
+
<<EOF;
CREATE TABLE Address (
id integer primary key,
=== t/02records_object.t
==================================================================
--- t/02records_object.t (revision 1623)
+++ t/02records_object.t (patch - level 1)
@@ -4,44 +4,50 @@
use strict;
use warnings;
use File::Spec;
+use Test::More;
BEGIN { require "t/utils.pl" }
+our (@AvailableDrivers);
-use Test::More;
-eval "use DBD::SQLite";
-if ($@) {
-plan skip_all => "DBD::SQLite required for testing database interaction"
-} else{
-plan tests => 9;
-}
-my $handle = get_handle('SQLite');
-connect_handle( $handle );
-isa_ok($handle->dbh, 'DBI::db');
+use constant TESTS_PER_DRIVER => 8;
-foreach( @{ TestApp->schema } ) {
- my $ret = $handle->SimpleQuery($_);
+my $total = scalar(@AvailableDrivers) * TESTS_PER_DRIVER;
+plan tests => $total;
+
+foreach my $d ( @AvailableDrivers ) {
+SKIP: {
+ unless( has_schema( 'TestApp', $d ) ) {
+ skip "No schema for '$d' driver", TESTS_PER_DRIVER;
+ }
+ my $handle = get_handle( $d );
+ connect_handle( $handle );
+ isa_ok($handle->dbh, 'DBI::db');
+
+ my $ret = init_schema( 'TestApp', $handle );
isa_ok($ret,'DBI::st', "Inserted the schema. got a statement handle back");
-}
+ my $emp = TestApp::Employee->new($handle);
+ my $e_id = $emp->Create( Name => 'RUZ' );
+ ok($e_id, "Got an ide for the new emplyee");
+ my $phone = TestApp::Phone->new($handle);
+ isa_ok( $phone, 'TestApp::Phone', "it's atestapp::phone");
+ my $p_id = $phone->Create( Employee => $e_id, Phone => '+7(903)264-03-51');
+ # XXX: test fails if next string is commented
+ is($p_id, 1, "Loaded record $p_id");
+ $phone->Load( $p_id );
-my $emp = TestApp::Employee->new($handle);
-my $e_id = $emp->Create( Name => 'RUZ' );
-ok($e_id, "Got an ide for the new emplyee");
-my $phone = TestApp::Phone->new($handle);
-isa_ok( $phone, 'TestApp::Phone', "it's atestapp::phone");
-my $p_id = $phone->Create( Employee => $e_id, Phone => '+7(903)264-03-51');
-# XXX: test fails if next string is commented
-is($p_id, 1, "Loaded record $p_id");
-$phone->Load( $p_id );
+ my $obj = $phone->EmployeeObj($handle);
+ ok($obj, "Employee #$e_id has phone #$p_id");
+ is($obj->id, $e_id);
+ is($obj->Name, 'RUZ');
-my $obj = $phone->EmployeeObj($handle);
-ok($obj, "Employee #$e_id has phone #$p_id");
-is($obj->id, $e_id);
-is($obj->Name, 'RUZ');
+}} # SKIP, foreach blocks
+1;
+
package TestApp;
-sub schema {
+sub schema_sqlite {
[
q{
CREATE TABLE Employees (
@@ -55,7 +61,21 @@
Phone varchar(18)
) }
]
+}
+sub schema_mysql {
+[ q{
+CREATE TEMPORARY TABLE Employees (
+ id integer AUTO_INCREMENT primary key,
+ Name varchar(36)
+)
+}, q{
+CREATE TEMPORARY TABLE Phones (
+ id integer AUTO_INCREMENT primary key,
+ Employee integer NOT NULL,
+ Phone varchar(18)
+)
+} ]
}
package TestApp::Employee;
=== t/utils.pl
==================================================================
--- t/utils.pl (revision 1623)
+++ t/utils.pl (patch - level 1)
@@ -15,6 +15,13 @@
our @AvailableDrivers = grep { eval "require DBD::". $_ } @SupportedDrivers;
+=head2 get_handle
+
+Returns new DB specific handle. Takes one argument DB C<$type>.
+Other arguments uses to construct handle.
+
+=cut
+
sub get_handle
{
my $type = shift;
@@ -22,19 +29,26 @@
eval "require $class";
die $@ if $@;
my $handle;
- {
-# no strict 'refs';
- $handle = $class->new( @_ );
- }
+ $handle = $class->new( @_ );
return $handle;
}
+=head2 handle_to_driver
+
+Returns driver name which gets from C<$handle> object argument.
+
+=cut
+
+sub handle_to_driver
+{
+ my $driver = ref($_[0]);
+ $driver =~ s/^.*:://;
+ return $driver;
+}
+
sub connect_handle
{
- my $class = lc ref($_[0]);
- $class =~ s/^.*:://;
- my $call = "connect_$class";
-
+ my $call = "connect_". lc handle_to_driver( $_[0] );
return unless defined &$call;
goto &$call;
}
@@ -42,8 +56,58 @@
sub connect_sqlite
{
my $handle = shift;
- return $handle->Connect( Driver => 'SQLite', Database => File::Spec->catfile(File::Spec->tmpdir(), "sb-test.$$"));
+ return $handle->Connect(
+ Driver => 'SQLite',
+ Database => File::Spec->catfile(File::Spec->tmpdir(), "sb-test.$$")
+ );
}
+sub connect_mysql
+{
+ my $handle = shift;
+ return $handle->Connect(
+ Driver => 'mysql',
+ Database => 'test',
+ User => 'root',
+ Pass => '',
+ );
+}
+=head2 had_schema
+
+Returns true if C<$class> has schema for C<$driver>.
+
+=cut
+
+sub has_schema
+{
+ my ($class, $driver) = @_;
+ my $call = $class ."::schema_". lc $driver;
+ return 1 if defined &$call;
+ return 0;
+}
+
+=head2 init_schema
+
+Takes C<$class> and C<$handle> and inits schema by calling
+C<schema_$driver> method of the C<$class>.
+Returns last C<DBI::st> on success or last return value of the
+SimpleQuery method on error.
+
+=cut
+
+sub init_schema
+{
+ my ($class, $handle) = @_;
+ my $call = "schema_". lc _handle_to_driver( $handle );
+ my $schema = $class->$call();
+ $schema = ref( $schema )? $schema : [$schema];
+ my $ret;
+ foreach my $query( @$schema ) {
+ $ret = $handle->SimpleQuery( $query );
+ return $ret unless UNIVERSAL::isa( $ret, 'DBI::st' );
+ }
+ return $ret;
+}
+
1;
==== BEGIN SVK PATCH BLOCK ====
Version: svk 1.0_01 (linux)
eJyFV/tT21YW1mTFwyYhyQItG0i5JaaYlodelmUnMSZYNuYNhmzThnWupWtwETa1ZFIaJztXDz95
pUmaydDO7C87+xf0z9uZvTZ0Bzps1jMaj3S/87hH33fuUTS/dj/MFkMhpuhhmWLi8VwwuAwNZWuI
3HnEIlIzRi7v8RU1tIc0D1/UcpseoZiFO4isGjC/iYxQiCXG0pmx3DT43YnQ8JGCRi6rewJNZ0kj
j5CHLUrhQDHMFcM8MS2yZDG3i7LJfC5nEPesyPFkMdlISdFyOko2TAk27GvAOQ8rnOHVTB4pJN6+
h+WLCQTzytajQkZTUb7p9dxT00i4yqhoXMTxjYi+84gXUWwj06YX/vdM0xkNebg/BJ2YgVlVQ+O7
O80s/59b7sxtcxXu7mr7SQP9YKhIM2AzFM8VRcUPAymfwiHBDzmOFQIM8rOSyKbJHcenPXzjpS1S
FP6tG/925zZFHSKKxv9kXf++RuF/eQ+1sHCxjs20z33DFJR4qKYUEab9koBSXJpTGVVMq2nEs5KP
pHa2ad+lTbNc0Zhg2BTUM4o+bjRLe7HQ4mU030STTefy6lVw/+WKMg04dw5P5lLfkWpdYSVdDtKw
KhgZTR/f1S5i/2fphY+W3tcsTwCqkFd5P4K8T2B8jAgFUnRJFJgUL0mixyeeld7irHTXHeo7iu7+
QOMB/NXm8nPKHMBdCqG9AbMGWJMTa4nksryajKzGH8urwpUvpRmVZSVBYjikpPyM3yeKEIkBRZBS
aR4iNZBKfzRvseFBFQW/Kgkqx4iiEIApRgpARfRJKJ3ys8SzRxR8Z4n/kvhHlxXAk1SWqtO1fJl+
56F7rNZ67KQdZ1ve3nHo9yknkTdXcDe+iZUoZmst76fsFf0dXRnGrZbbuvWzYUZMF5ZNYNL4U7v9
dJzGgZL8ykzgdbsX78vmutVn9uNB0y9bva3mhv03M5CwZinZ6otZzz3W5pw97rF7iG3g+sF2yP72
mZMVHOlrJ0s9K/0J95aUiNVLhUuvMCiH5Ar0llP0wfZI5QYOVMRo5a6nYpCnN6r9s9UJvsphbxXh
0dqNSAV21h7I1QmutpisTvTUP8OgzpOn1Er9MY6YG/0HXw4fyFTyYDti9YiH8xt1NHZ09/HxNc9R
cq6OOo5vzNdvfnJ8L3Z8jYocT67Wwqu1ldGTIdx3skJ2MnCyu3FS+PT1V+rrcNdrFVPR18+/Pin0
/bS28Tr88I078eZ+z5snBDjyJj/zzk/Nvh3ED95quPedFw+9C5PEpHeZhfc8gToRc4hktCub16qU
Pf3zpvv0q8qtU6nSfxptP1WOqOXTPfpDzon8Gi53/CLP/foXi/4QpvDdUzFXyANveGoPZrRIPrOH
8jqh3B/JZuQMqClQg3nw5f37bnc6l0dQ2VKBF4AR8MKdmIsvB8m/q5DVkK57k14wPDw64nKBwcXc
sEcdBurgqOul23Xf7XJlshnDdfH38iW4B0ZTWk7Z1t1uNrmzr3+vgRfywvLS6tTqk6n1taVkfHF6
VV6QF9dcy6vxhTn5CfBmVAK7UgVNDguMlEaSj5XSCiP6GJZPQZ+k8JBFUjoVUD+uXn9Tvem0BKEo
Mn6kqIKfURWVFyGUmJQKibJFj8DzZyp43f6WNTvxJ5PUrWdgsk7X+8u0uUb3fKAPnuC2codD11ud
hE5U0ENUoBIVuM31lhqyV4wWs+DQ5vMyXV7CreYOdp30NuXQahYwjXvt9soXNA6W5L835GC2mvvd
uCib80QRfS5r4I4Z6jB/tNcbgpiiIpY3au0MW0bU/m7IBnjMllvMH7+w99qtAcG5F3VyVMx5isdL
9/BQaYUIY48se8p/lp2pL8tBubx6u7w1W8ncrFw7J9QmIVSp9ZDqr9y2aTxGYX9lvK0+H6suOJHq
N9crLysDlftHTOXJUt3XU+3cqD+dqLKWXL9FlQeqmSupdXU3ky4xrMGrJqX+S6cGmS5ziTDpdyJd
5E+ScKLJn6vZ434JrmRM831ziONEzh9QOeRPSwzyKQLDswE/L5FOGkirH2WM1ORcQIKsIgjkFEyl
OMhIvJgKKIzCSILC8Kri8Yv+M8Y48NhtLZhDFJ6jStfxotlidf/UihNvIzhjtuBnlbjZVqWtkdIM
LpQofAvHPzPzXVZXDM8RlNPCzOKnUXugTuPFUsTsIs8aFgtmdMXuacPfxOwJfNOanXHcndazdquL
QIH1+U1LN2krtmz3kHBL89YetW13W10OFSm3U4+cHrPV+et164vWmVelr1tmVsr9mHYW5XK/2ebQ
VrTyGLfgPStS7iewuN1ZISnYtDlttlqTpWj1uh2p3iNx8JKN8Ey1oxV/Q/r7JJ5xHpY6re02a9Im
oJijx53QjCNiYnnb7muzuvB8pWjHqx1R/Gq26rHm7dlIbT9SexqvMlbEUUuxWvdMdfJotpbFcbzx
nrY/NaP1x8TQidUfHMTrvjLZ9nzt6XI1ScqwVi3ghVp3G15dKFFtpk5b12m8EatybvNH2VFwi7UW
P7xLW3Pxwz6TXFbsUMKxw0/I2aNVCBJHDnqs+GHMpM2cFTm8127n5g46CaIoH3bHHTFy1NNmdx/L
R9OkGi8idYhvWR3yoYZbnKcPtxBUOfeqDrLoOYg8AvouUjLpjALGwRrcRjrIZREgA29hB2WN6Qeh
cfeSsUV0AQo6WTRyupEvKIbb/VApkCk3l1RBY0oGz7cyypYO0vncTgiczTMPB8e9gDRTt2t4XScj
73IIDKtJXdlCO5A4QcQ52II6AKRVh3Tv6Ah4CMLJ8cFgkGUauiFDZmofZLKb7ukHYAcZWzkV5NKA
ZDOuQd0A0w8ij+LBoG6QgFmgFxQyTO1BrYDciczOroZWCii/nwUon8/lB70jk0Hw7UYenZ8L4Hsv
CIMXeWR41xcb8k5MzQeDGR16R4dfXqm/pnr8fighTvCxKUmALJSElEg6OGIZokNBlHzNOZsj4tM0
YCDd0MEu1HXwPGNsgabmCWAsFOKKHo47+5JYa35cBIPr2Wb7gdqQWCRz3S40tsh3SB7tkZtCIaM2
vE6QDf8wdnkWJy0FaueDoIcXi2moBMhI5R9TfGlmjDQHZgwGfPxYisxFgUBa9CEB/QfdIDJK
==== END SVK PATCH BLOCK ====
More information about the Rt-devel
mailing list