[Bast-commits] r4365 - in
DBIx-Class/0.08/branches/replication_dedux:
lib/SQL/Translator/Parser/DBIx t t/lib t/lib/DBICTest/Schema
jnapiorkowski at dev.catalyst.perl.org
jnapiorkowski at dev.catalyst.perl.org
Thu May 8 21:26:01 BST 2008
Author: jnapiorkowski
Date: 2008-05-08 21:26:01 +0100 (Thu, 08 May 2008)
New Revision: 4365
Modified:
DBIx-Class/0.08/branches/replication_dedux/lib/SQL/Translator/Parser/DBIx/Class.pm
DBIx-Class/0.08/branches/replication_dedux/t/93storage_replication.t
DBIx-Class/0.08/branches/replication_dedux/t/lib/DBICTest.pm
DBIx-Class/0.08/branches/replication_dedux/t/lib/DBICTest/Schema/ForceForeign.pm
DBIx-Class/0.08/branches/replication_dedux/t/lib/DBICTest/Schema/TreeLike.pm
DBIx-Class/0.08/branches/replication_dedux/t/lib/DBICTest/Schema/TwoKeys.pm
Log:
lots of updates to make the test suite work with databases other than sqlite
Modified: DBIx-Class/0.08/branches/replication_dedux/lib/SQL/Translator/Parser/DBIx/Class.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/lib/SQL/Translator/Parser/DBIx/Class.pm 2008-05-08 20:08:18 UTC (rev 4364)
+++ DBIx-Class/0.08/branches/replication_dedux/lib/SQL/Translator/Parser/DBIx/Class.pm 2008-05-08 20:26:01 UTC (rev 4365)
@@ -122,8 +122,15 @@
my $rel_table = $othertable->name;
# Get the key information, mapping off the foreign/self markers
- my @cond = keys(%{$rel_info->{cond}});
+ my @cond = keys(%{$rel_info->{cond}});
my @refkeys = map {/^\w+\.(\w+)$/} @cond;
+
+ # Force the order of the referenced fields to be the same as
+ # ->add_columns method.
+ my $idx;
+ my %other_columns_idx = map {$_ => $idx++} $othertable->columns;
+ @refkeys = sort { $other_columns_idx{$a} cmp $other_columns_idx{$b} } @refkeys;
+
my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
if($rel_table)
Modified: DBIx-Class/0.08/branches/replication_dedux/t/93storage_replication.t
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/t/93storage_replication.t 2008-05-08 20:08:18 UTC (rev 4364)
+++ DBIx-Class/0.08/branches/replication_dedux/t/93storage_replication.t 2008-05-08 20:26:01 UTC (rev 4365)
@@ -16,6 +16,18 @@
use_ok 'DBIx::Class::Storage::DBI::Replicated::Replicant';
use_ok 'DBIx::Class::Storage::DBI::Replicated';
+=head1 HOW TO USE
+
+ This is a test of the replicated storage system. This will work in one of
+ two ways, either it was try to fake replication with a couple of SQLite DBs
+ and creative use of copy, or if you define a couple of %ENV vars correctly
+ will try to test those. If you do that, it will assume the setup is properly
+ replicating. Your results may vary, but I have demonstrated this to work with
+ mysql native replication.
+
+=cut
+
+
## ----------------------------------------------------------------------------
## Build a class to hold all our required testing data and methods.
## ----------------------------------------------------------------------------
@@ -47,12 +59,17 @@
sub init_schema {
my $class = shift @_;
+
my $schema = DBICTest->init_schema(
storage_type=>[
'::DBI::Replicated' => {
balancer_type=>'::Random',
- }],
- );
+ }
+ ],
+ deploy_args=>{
+ add_drop_table => 1,
+ },
+ );
return $schema;
}
@@ -202,10 +219,12 @@
isa_ok $replicated_storages[1]
=> 'DBIx::Class::Storage::DBI::Replicated::Replicant';
-isa_ok $replicated->schema->storage->replicants->{"t/var/DBIxClass_slave1.db"}
+my @replicant_names = keys %{$replicated->schema->storage->replicants};
+
+isa_ok $replicated->schema->storage->replicants->{$replicant_names[0]}
=> 'DBIx::Class::Storage::DBI::Replicated::Replicant';
-isa_ok $replicated->schema->storage->replicants->{"t/var/DBIxClass_slave2.db"}
+isa_ok $replicated->schema->storage->replicants->{$replicant_names[1]}
=> 'DBIx::Class::Storage::DBI::Replicated::Replicant';
## Add some info to the database
@@ -245,12 +264,20 @@
[ 7, "Watergate"],
]);
-## Alright, the database 'cluster' is not in a consistent state. When we do
-## a read now we expect bad news
+SKIP: {
+ ## We can't do this test if we have a custom replicants, since we assume
+ ## if there are custom one that you are trying to test a real replicating
+ ## system. See docs above for more.
+
+ skip 'Cannot test inconsistent replication since you have a real replication system', 1
+ if DBICTest->has_custom_dsn && $ENV{"DBICTEST_SLAVE0_DSN"};
+
+ ## Alright, the database 'cluster' is not in a consistent state. When we do
+ ## a read now we expect bad news
+ is $replicated->schema->resultset('Artist')->find(5), undef
+ => 'read after disconnect fails because it uses a replicant which we have neglected to "replicate" yet';
+}
-is $replicated->schema->resultset('Artist')->find(5), undef
- => 'read after disconnect fails because it uses a replicant which we have neglected to "replicate" yet';
-
## Make sure all the slaves have the table definitions
$replicated->replicate;
@@ -270,8 +297,8 @@
is $replicated->schema->storage->pool->connected_replicants => 2
=> "both replicants are connected";
-$replicated->schema->storage->replicants->{"t/var/DBIxClass_slave1.db"}->disconnect;
-$replicated->schema->storage->replicants->{"t/var/DBIxClass_slave2.db"}->disconnect;
+$replicated->schema->storage->replicants->{$replicant_names[0]}->disconnect;
+$replicated->schema->storage->replicants->{$replicant_names[1]}->disconnect;
is $replicated->schema->storage->pool->connected_replicants => 0
=> "both replicants are now disconnected";
@@ -324,8 +351,8 @@
## set all the replicants to inactive, and make sure the balancer falls back to
## the master.
-$replicated->schema->storage->replicants->{"t/var/DBIxClass_slave1.db"}->active(0);
-$replicated->schema->storage->replicants->{"t/var/DBIxClass_slave2.db"}->active(0);
+$replicated->schema->storage->replicants->{$replicant_names[0]}->active(0);
+$replicated->schema->storage->replicants->{$replicant_names[1]}->active(0);
ok $replicated->schema->resultset('Artist')->find(2)
=> 'Fallback to master';
Modified: DBIx-Class/0.08/branches/replication_dedux/t/lib/DBICTest/Schema/ForceForeign.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/t/lib/DBICTest/Schema/ForceForeign.pm 2008-05-08 20:08:18 UTC (rev 4364)
+++ DBIx-Class/0.08/branches/replication_dedux/t/lib/DBICTest/Schema/ForceForeign.pm 2008-05-08 20:26:01 UTC (rev 4365)
@@ -14,7 +14,7 @@
# since it uses the PK
__PACKAGE__->might_have(
'artist_1', 'DBICTest::Schema::Artist', {
- 'foreign.artist_id' => 'self.artist',
+ 'foreign.artistid' => 'self.artist',
}, {
is_foreign_key_constraint => 1,
},
Modified: DBIx-Class/0.08/branches/replication_dedux/t/lib/DBICTest/Schema/TreeLike.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/t/lib/DBICTest/Schema/TreeLike.pm 2008-05-08 20:08:18 UTC (rev 4364)
+++ DBIx-Class/0.08/branches/replication_dedux/t/lib/DBICTest/Schema/TreeLike.pm 2008-05-08 20:26:01 UTC (rev 4365)
@@ -16,4 +16,12 @@
{ 'foreign.id' => 'self.parent' });
__PACKAGE__->has_many('children', 'TreeLike', { 'foreign.parent' => 'self.id' });
+## since this is a self referential table we need to do a post deploy hook and get
+## some data in while constraints are off
+
+ sub sqlt_deploy_hook {
+ my ($self, $sqlt_table) = @_;
+
+ $sqlt_table->add_index(name => 'idx_name', fields => ['name']);
+ }
1;
Modified: DBIx-Class/0.08/branches/replication_dedux/t/lib/DBICTest/Schema/TwoKeys.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/t/lib/DBICTest/Schema/TwoKeys.pm 2008-05-08 20:08:18 UTC (rev 4364)
+++ DBIx-Class/0.08/branches/replication_dedux/t/lib/DBICTest/Schema/TwoKeys.pm 2008-05-08 20:26:01 UTC (rev 4365)
@@ -10,7 +10,11 @@
);
__PACKAGE__->set_primary_key(qw/artist cd/);
-__PACKAGE__->belongs_to( artist => 'DBICTest::Schema::Artist' );
+__PACKAGE__->belongs_to(
+ artist => 'DBICTest::Schema::Artist',
+ {'foreign.artistid'=>'self.artist'},
+);
+
__PACKAGE__->belongs_to( cd => 'DBICTest::Schema::CD', undef, { is_deferrable => 0 } );
__PACKAGE__->has_many(
Modified: DBIx-Class/0.08/branches/replication_dedux/t/lib/DBICTest.pm
===================================================================
--- DBIx-Class/0.08/branches/replication_dedux/t/lib/DBICTest.pm 2008-05-08 20:08:18 UTC (rev 4364)
+++ DBIx-Class/0.08/branches/replication_dedux/t/lib/DBICTest.pm 2008-05-08 20:26:01 UTC (rev 4365)
@@ -89,11 +89,13 @@
}
if ( !$args{no_connect} ) {
$schema = $schema->connect($self->_database);
- $schema->storage->on_connect_do(['PRAGMA synchronous = OFF']);
+ $schema->storage->on_connect_do(['PRAGMA synchronous = OFF'])
+ unless $self->has_custom_dsn;
}
if ( !$args{no_deploy} ) {
- __PACKAGE__->deploy_schema( $schema );
- __PACKAGE__->populate_schema( $schema ) if( !$args{no_populate} );
+ __PACKAGE__->deploy_schema( $schema, $args{deploy_args} );
+ __PACKAGE__->populate_schema( $schema )
+ if( !$args{no_populate} );
}
return $schema;
}
@@ -112,10 +114,14 @@
sub deploy_schema {
my $self = shift;
- my $schema = shift;
+ my $schema = shift;
+ my $args = shift || {};
if ($ENV{"DBICTEST_SQLT_DEPLOY"}) {
- return $schema->deploy();
+
+#$schema->create_ddl_dir([qw/MySQL/], $schema->VERSION, '.', undef, $args);
+$schema->deploy($args);
+
} else {
open IN, "t/lib/sqlite.sql";
my $sql;
@@ -123,6 +129,7 @@
close IN;
($schema->storage->dbh->do($_) || print "Error on SQL: $_\n") for split(/;\n/, $sql);
}
+ return;
}
=head2 populate_schema
@@ -224,15 +231,16 @@
[ 1, 3 ],
]);
- $schema->populate('TreeLike', [
- [ qw/id parent name/ ],
- [ 1, 0, 'foo' ],
- [ 2, 1, 'bar' ],
- [ 5, 1, 'blop' ],
- [ 3, 2, 'baz' ],
- [ 4, 3, 'quux' ],
- [ 6, 2, 'fong' ],
- ]);
+ # $schema->populate('TreeLike', [
+ # [ qw/id parent name/ ],
+ # [ 0, 0, 'root' ],
+ # [ 1, 0, 'foo' ],
+ # [ 2, 1, 'bar' ],
+ # [ 5, 1, 'blop' ],
+ # [ 3, 2, 'baz' ],
+ # [ 4, 3, 'quux' ],
+ # [ 6, 2, 'fong' ],
+ # ]);
$schema->populate('Track', [
[ qw/trackid cd position title/ ],
@@ -273,7 +281,15 @@
[ 1, "Tools" ],
[ 2, "Body Parts" ],
]);
-
+
+ $schema->populate('TypedObject', [
+ [ qw/objectid type value/ ],
+ [ 1, "pointy", "Awl" ],
+ [ 2, "round", "Bearing" ],
+ [ 3, "pointy", "Knife" ],
+ [ 4, "pointy", "Tooth" ],
+ [ 5, "round", "Head" ],
+ ]);
$schema->populate('CollectionObject', [
[ qw/collection object/ ],
[ 1, 1 ],
@@ -283,15 +299,6 @@
[ 2, 5 ],
]);
- $schema->populate('TypedObject', [
- [ qw/objectid type value/ ],
- [ 1, "pointy", "Awl" ],
- [ 2, "round", "Bearing" ],
- [ 3, "pointy", "Knife" ],
- [ 4, "pointy", "Tooth" ],
- [ 5, "round", "Head" ],
- ]);
-
$schema->populate('Owners', [
[ qw/ownerid name/ ],
[ 1, "Newton" ],
More information about the Bast-commits
mailing list