use warnings;
use lib qw(t/lib);
use Test::More;
-use Data::Dump qw/dump/;
+use DBICTest;
BEGIN {
- eval "use DBD::Multi";
+ eval "use Moose";
plan $@
- ? ( skip_all => 'needs DBD::Multi for testing' )
- : ( tests => 18 );
-}
+ ? ( skip_all => 'needs Moose for testing' )
+ : ( tests => 40 );
+}
+
+use_ok 'DBIx::Class::Storage::DBI::Replicated::Pool';
+use_ok 'DBIx::Class::Storage::DBI::Replicated::Balancer';
+use_ok 'DBIx::Class::Storage::DBI::Replicated::Replicant';
+use_ok 'DBIx::Class::Storage::DBI::Replicated';
## ----------------------------------------------------------------------------
## Build a class to hold all our required testing data and methods.
## ----------------------------------------------------------------------------
-TESTSCHEMACLASS: {
-
- package DBIx::Class::DBI::Replication::TestReplication;
-
- use DBI;
- use DBICTest;
- use File::Copy;
-
- ## Create a constructor
-
+TESTSCHEMACLASSES: {
+
+ ## --------------------------------------------------------------------- ##
+ ## Create an object to contain your replicated stuff.
+ ## --------------------------------------------------------------------- ##
+
+ package DBIx::Class::DBI::Replicated::TestReplication;
+
+ use DBICTest;
+ use base qw/Class::Accessor::Fast/;
+
+ __PACKAGE__->mk_accessors( qw/schema/ );
+
+ ## Initialize the object
+
sub new {
- my $class = shift @_;
- my %params = @_;
-
- my $self = bless {
- db_paths => $params{db_paths},
- dsns => $class->init_dsns(%params),
- schema=>$class->init_schema,
- }, $class;
-
- $self->connect;
- return $self;
- }
-
- ## get the DSNs. We build this up from the list of file paths
-
- sub init_dsns {
- my $class = shift @_;
- my %params = @_;
- my $db_paths = $params{db_paths};
-
- my @dsn = map {
- "dbi:SQLite:${_}";
- } @$db_paths;
-
- return \@dsn;
- }
-
- ## get the Schema and set the replication storage type
-
- sub init_schema {
- my $class = shift @_;
- my $schema = DBICTest->init_schema();
- $schema->storage_type( '::DBI::Replication' );
-
- return $schema;
- }
-
- ## connect the Schema
-
- sub connect {
- my $self = shift @_;
- my ($master, @slaves) = @{$self->{dsns}};
- my @connections = ([$master, '','', {AutoCommit=>1, PrintError=>0}]);
- my @slavesob;
-
- foreach my $slave (@slaves)
- {
- my $dbh = shift @{$self->{slaves}}
- || DBI->connect($slave,"","",{PrintError=>0, PrintWarn=>0});
-
- push @connections,
- [$dbh, '','',{priority=>10}];
-
- push @slavesob,
- $dbh;
- }
-
- ## Keep track of the created slave databases
- $self->{slaves} = \@slavesob;
-
- $self
- ->{schema}
- ->connect([
- @connections,
- {limit_dialect => 'LimitXY'}
- ]);
- }
-
- ## replication
-
- sub replicate {
- my $self = shift @_;
- my ($master, @slaves) = @{$self->{db_paths}};
-
- foreach my $slave (@slaves) {
- copy($master, $slave);
- }
- }
-
- ## Cleanup afer ourselves.
+ my $class = shift @_;
+ my $self = $class->SUPER::new(@_);
- sub cleanup {
- my $self = shift @_;
- my ($master, @slaves) = @{$self->{db_paths}};
-
- foreach my $slave (@slaves) {
- unlink $slave;
- }
+ $self->schema( $self->init_schema );
+ return $self;
}
+
+ ## Get the Schema and set the replication storage type
+
+ sub init_schema {
+ my $class = shift @_;
+ my $schema = DBICTest->init_schema(
+ storage_type=>[
+ '::DBI::Replicated' => {
+ balancer_type=>'::Random',
+ }],
+ );
+
+ return $schema;
+ }
+
+ sub generate_replicant_connect_info {}
+ sub replicate {}
+ sub cleanup {}
+
+
+ ## --------------------------------------------------------------------- ##
+ ## Subclass for when you are using SQLite for testing, this provides a fake
+ ## replication support.
+ ## --------------------------------------------------------------------- ##
+
+ package DBIx::Class::DBI::Replicated::TestReplication::SQLite;
+
+ use DBICTest;
+ use File::Copy;
+ use base 'DBIx::Class::DBI::Replicated::TestReplication';
+
+ __PACKAGE__->mk_accessors( qw/master_path slave_paths/ );
+
+ ## Set the mastep path from DBICTest
+
+ sub new {
+ my $class = shift @_;
+ my $self = $class->SUPER::new(@_);
- ## Force a reconnection
+ $self->master_path( DBICTest->_sqlite_dbfilename );
+ $self->slave_paths([
+ "t/var/DBIxClass_slave1.db",
+ "t/var/DBIxClass_slave2.db",
+ ]);
+
+ return $self;
+ }
- sub reconnect {
- my $self = shift @_;
- my $schema = $self->connect;
- $self->{schema} = $schema;
- return $schema;
- }
+ ## Return an Array of ArrayRefs where each ArrayRef is suitable to use for
+ ## $storage->connect_info to be used for connecting replicants.
+
+ sub generate_replicant_connect_info {
+ my $self = shift @_;
+ my @dsn = map {
+ "dbi:SQLite:${_}";
+ } @{$self->slave_paths};
+
+ return map { [$_,'','',{AutoCommit=>1}] } @dsn;
+ }
+
+ ## Do a 'good enough' replication by copying the master dbfile over each of
+ ## the slave dbfiles. If the master is SQLite we do this, otherwise we
+ ## just do a one second pause to let the slaves catch up.
+
+ sub replicate {
+ my $self = shift @_;
+ foreach my $slave (@{$self->slave_paths}) {
+ copy($self->master_path, $slave);
+ }
+ }
+
+ ## Cleanup after ourselves. Unlink all gthe slave paths.
+
+ sub cleanup {
+ my $self = shift @_;
+ foreach my $slave (@{$self->slave_paths}) {
+ unlink $slave;
+ }
+ }
+
+ ## --------------------------------------------------------------------- ##
+ ## Subclass for when you are setting the databases via custom export vars
+ ## This is for when you have a replicating database setup that you are
+ ## going to test against. You'll need to define the correct $ENV and have
+ ## two slave databases to test against, as well as a replication system
+ ## that will replicate in less than 1 second.
+ ## --------------------------------------------------------------------- ##
+
+ package DBIx::Class::DBI::Replicated::TestReplication::Custom;
+ use base 'DBIx::Class::DBI::Replicated::TestReplication';
+
+ ## Return an Array of ArrayRefs where each ArrayRef is suitable to use for
+ ## $storage->connect_info to be used for connecting replicants.
+
+ sub generate_replicant_connect_info {
+ return (
+ [$ENV{"DBICTEST_SLAVE0_DSN"}, $ENV{"DBICTEST_SLAVE0_DBUSER"}, $ENV{"DBICTEST_SLAVE0_DBPASS"}, {AutoCommit => 1}],
+ [$ENV{"DBICTEST_SLAVE1_DSN"}, $ENV{"DBICTEST_SLAVE1_DBUSER"}, $ENV{"DBICTEST_SLAVE1_DBPASS"}, {AutoCommit => 1}],
+ );
+ }
+
+ ## pause a bit to let the replication catch up
+
+ sub replicate {
+ sleep 1;
+ }
}
## ----------------------------------------------------------------------------
## Create an object and run some tests
## ----------------------------------------------------------------------------
-my %params = (
- db_paths => [
- "t/var/DBIxClass.db",
- "t/var/DBIxClass_slave1.db",
- "t/var/DBIxClass_slave2.db",
- ],
-);
-
-ok my $replicate = DBIx::Class::DBI::Replication::TestReplication->new(%params)
- => 'Created a replication object';
-
-isa_ok $replicate->{schema}
- => 'DBIx::Class::Schema';
+## Thi first bunch of tests are basic, just make sure all the bits are behaving
+
+my $replicated_class = DBICTest->has_custom_dsn ?
+ 'DBIx::Class::DBI::Replicated::TestReplication::Custom' :
+ 'DBIx::Class::DBI::Replicated::TestReplication::SQLite';
+
+ok my $replicated = $replicated_class->new
+ => 'Created a replication object';
+
+isa_ok $replicated->schema
+ => 'DBIx::Class::Schema';
+
+isa_ok $replicated->schema->storage
+ => 'DBIx::Class::Storage::DBI::Replicated';
+
+ok $replicated->schema->storage->meta
+ => 'has a meta object';
+
+isa_ok $replicated->schema->storage->master
+ => 'DBIx::Class::Storage::DBI';
+
+isa_ok $replicated->schema->storage->pool
+ => 'DBIx::Class::Storage::DBI::Replicated::Pool';
+
+isa_ok $replicated->schema->storage->balancer
+ => 'DBIx::Class::Storage::DBI::Replicated::Balancer';
+
+ok my @replicant_connects = $replicated->generate_replicant_connect_info
+ => 'got replication connect information';
+
+ok my @replicated_storages = $replicated->schema->storage->connect_replicants(@replicant_connects)
+ => 'Created some storages suitable for replicants';
+
+isa_ok $replicated->schema->storage->balancer->current_replicant
+ => 'DBIx::Class::Storage::DBI';
+
+ok $replicated->schema->storage->pool->has_replicants
+ => 'does have replicants';
+
+is $replicated->schema->storage->num_replicants => 2
+ => 'has two replicants';
+
+isa_ok $replicated_storages[0]
+ => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
+
+isa_ok $replicated_storages[1]
+ => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
+
+isa_ok $replicated->schema->storage->replicants->{"t/var/DBIxClass_slave1.db"}
+ => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
+
+isa_ok $replicated->schema->storage->replicants->{"t/var/DBIxClass_slave2.db"}
+ => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
## Add some info to the database
-$replicate
- ->{schema}
- ->populate('Artist', [
- [ qw/artistid name/ ],
- [ 4, "Ozric Tentacles"],
- ]);
-
+$replicated
+ ->schema
+ ->populate('Artist', [
+ [ qw/artistid name/ ],
+ [ 4, "Ozric Tentacles"],
+ ]);
+
## Make sure all the slaves have the table definitions
-$replicate->replicate;
+$replicated->replicate;
## Make sure we can read the data.
-ok my $artist1 = $replicate->{schema}->resultset('Artist')->find(4)
- => 'Created Result';
+ok my $artist1 = $replicated->schema->resultset('Artist')->find(4)
+ => 'Created Result';
isa_ok $artist1
- => 'DBICTest::Artist';
-
+ => 'DBICTest::Artist';
+
is $artist1->name, 'Ozric Tentacles'
- => 'Found expected name for first result';
+ => 'Found expected name for first result';
## Add some new rows that only the master will have This is because
## we overload any type of write operation so that is must hit the master
## database.
-use Fcntl qw (:flock);
-
-my $master_path = $replicate->{db_paths}->[0];
-open LOCKFILE, ">>$master_path"
- or die "Cannot open $master_path";
-flock(LOCKFILE, LOCK_EX);
-
-$replicate
- ->{schema}
- ->populate('Artist', [
- [ qw/artistid name/ ],
- [ 5, "Doom's Children"],
- [ 6, "Dead On Arrival"],
- [ 7, "Watergate"],
- ]);
-
-## Reconnect the database
-$replicate->reconnect;
+$replicated
+ ->schema
+ ->populate('Artist', [
+ [ qw/artistid name/ ],
+ [ 5, "Doom's Children"],
+ [ 6, "Dead On Arrival"],
+ [ 7, "Watergate"],
+ ]);
## Alright, the database 'cluster' is not in a consistent state. When we do
## a read now we expect bad news
-is $replicate->{schema}->resultset('Artist')->find(5), undef
- => 'read after disconnect fails because it uses slave 1 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
-$replicate->replicate;
+$replicated->replicate;
## Should find some data now
-ok my $artist2 = $replicate->{schema}->resultset('Artist')->find(5)
- => 'Sync succeed';
-
+ok my $artist2 = $replicated->schema->resultset('Artist')->find(5)
+ => 'Sync succeed';
+
isa_ok $artist2
- => 'DBICTest::Artist';
-
+ => 'DBICTest::Artist';
+
is $artist2->name, "Doom's Children"
- => 'Found expected name for first result';
-
-## What happens when we delete one of the slaves?
+ => 'Found expected name for first result';
-ok my $slave1 = @{$replicate->{slaves}}[0]
- => 'Got Slave1';
+## What happens when we disconnect all the replicants?
-ok $slave1->disconnect
- => 'disconnected slave1';
+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;
-$replicate->reconnect;
+is $replicated->schema->storage->pool->connected_replicants => 0
+ => "both replicants are now disconnected";
-ok my $artist3 = $replicate->{schema}->resultset('Artist')->find(6)
- => 'Still finding stuff.';
-
+## All these should pass, since the database should automatically reconnect
+
+ok my $artist3 = $replicated->schema->resultset('Artist')->find(6)
+ => 'Still finding stuff.';
+
isa_ok $artist3
- => 'DBICTest::Artist';
-
+ => 'DBICTest::Artist';
+
is $artist3->name, "Dead On Arrival"
- => 'Found expected name for first result';
-
-## Let's delete all the slaves
-
-ok my $slave2 = @{$replicate->{slaves}}[1]
- => 'Got Slave2';
-
-ok $slave2->disconnect
- => 'Disconnected slave2';
+ => 'Found expected name for first result';
-$replicate->reconnect;
+is $replicated->schema->storage->pool->connected_replicants => 1
+ => "One replicant reconnected to handle the job";
+
+## What happens when we try to select something that doesn't exist?
-## We expect an error now, since all the slaves are dead
+ok ! $replicated->schema->resultset('Artist')->find(666)
+ => 'Correctly failed to find something.';
+
+## test the reliable option
-eval {
- $replicate->{schema}->resultset('Artist')->find(4)->name;
-};
-
-ok $@ => 'Got error when trying to find artistid 4';
+TESTRELIABLE: {
+
+ $replicated->schema->storage->set_reliable_storage;
+
+ ok $replicated->schema->resultset('Artist')->find(2)
+ => 'Read from master 1';
+
+ ok $replicated->schema->resultset('Artist')->find(5)
+ => 'Read from master 2';
+
+ $replicated->schema->storage->set_balanced_storage;
+
+ ok $replicated->schema->resultset('Artist')->find(3)
+ => 'Read from replicant';
+}
-## This should also be an error
+## Make sure when reliable goes out of scope, we are using replicants again
-eval {
- my $artist4 = $replicate->{schema}->resultset('Artist')->find(7);
-};
+ok $replicated->schema->resultset('Artist')->find(1)
+ => 'back to replicant 1.';
+
+ok $replicated->schema->resultset('Artist')->find(2)
+ => 'back to replicant 2.';
-ok $@ => 'Got read errors after everything failed';
+## 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);
+
+ok $replicated->schema->resultset('Artist')->find(2)
+ => 'Fallback to master';
+
## Delete the old database files
-$replicate->cleanup;
+$replicated->cleanup;
projects / dbsrgits/DBIx-Class.git / blobdiff