5 use Data::Dump qw/dump/;
10 ? ( skip_all => 'needs Moose for testing' )
14 ## ----------------------------------------------------------------------------
15 ## Build a class to hold all our required testing data and methods.
16 ## ----------------------------------------------------------------------------
20 package DBIx::Class::DBI::Replicated::TestReplication;
23 use base qw/Class::Accessor::Fast/;
25 __PACKAGE__->mk_accessors( qw/schema/ );
27 ## Initialize the object
31 my $class = ref( $proto ) || $proto;
34 bless( $self, $class );
36 $self->schema( $self->init_schema );
41 ## get the Schema and set the replication storage type
45 my $schema = DBICTest->init_schema(storage_type=>'::DBI::Replicated');
50 ## ----------------------------------------------------------------------------
51 ## Create an object and run some tests
52 ## ----------------------------------------------------------------------------
57 "t/var/DBIxClass_slave1.db",
58 "t/var/DBIxClass_slave2.db",
62 ok my $replicate = DBIx::Class::DBI::Replicated::TestReplication->new()
63 => 'Created a replication object';
65 isa_ok $replicate->schema
66 => 'DBIx::Class::Schema';
69 warn dump $replicate->schema->storage->meta;
71 warn dump $replicate->schema->storage->master;
76 ## ----------------------------------------------------------------------------
77 ## Build a class to hold all our required testing data and methods.
78 ## ----------------------------------------------------------------------------
82 package DBIx::Class::DBI::Replicated::TestReplication;
88 ## Create a constructor
95 db_paths => $params{db_paths},
96 dsns => $class->init_dsns(%params),
97 schema=>$class->init_schema,
104 ## get the DSNs. We build this up from the list of file paths
107 my $class = shift @_;
109 my $db_paths = $params{db_paths};
118 ## get the Schema and set the replication storage type
121 my $class = shift @_;
122 my $schema = DBICTest->init_schema();
123 $schema->storage_type( '::DBI::Replicated' );
128 ## connect the Schema
132 my ($master, @slaves) = @{$self->{dsns}};
133 my $master_connect_info = [$master, '','', {AutoCommit=>1, PrintError=>0}];
136 foreach my $slave (@slaves)
138 my $dbh = shift @{$self->{slaves}}
139 || DBI->connect($slave,"","",{PrintError=>0, PrintWarn=>0});
141 push @{$master_connect_info->[-1]->{slaves_connect_info}},
142 [$dbh, '','',{priority=>10}];
148 ## Keep track of the created slave databases
149 $self->{slaves} = \@slavesob;
153 ->connect(@$master_connect_info);
160 my ($master, @slaves) = @{$self->{db_paths}};
162 foreach my $slave (@slaves) {
163 copy($master, $slave);
167 ## Cleanup afer ourselves.
171 my ($master, @slaves) = @{$self->{db_paths}};
173 foreach my $slave (@slaves) {
178 ## Force a reconnection
182 my $schema = $self->connect;
183 $self->{schema} = $schema;
188 ## ----------------------------------------------------------------------------
189 ## Create an object and run some tests
190 ## ----------------------------------------------------------------------------
194 "t/var/DBIxClass.db",
195 "t/var/DBIxClass_slave1.db",
196 "t/var/DBIxClass_slave2.db",
200 ok my $replicate = DBIx::Class::DBI::Replicated::TestReplication->new(%params)
201 => 'Created a replication object';
203 isa_ok $replicate->{schema}
204 => 'DBIx::Class::Schema';
206 ## Add some info to the database
210 ->populate('Artist', [
211 [ qw/artistid name/ ],
212 [ 4, "Ozric Tentacles"],
215 ## Make sure all the slaves have the table definitions
217 $replicate->replicate;
219 ## Make sure we can read the data.
221 ok my $artist1 = $replicate->{schema}->resultset('Artist')->find(4)
225 => 'DBICTest::Artist';
227 is $artist1->name, 'Ozric Tentacles'
228 => 'Found expected name for first result';
230 ## Add some new rows that only the master will have This is because
231 ## we overload any type of write operation so that is must hit the master
236 ->populate('Artist', [
237 [ qw/artistid name/ ],
238 [ 5, "Doom's Children"],
239 [ 6, "Dead On Arrival"],
243 ## Reconnect the database
244 $replicate->reconnect;
246 ## Alright, the database 'cluster' is not in a consistent state. When we do
247 ## a read now we expect bad news
249 is $replicate->{schema}->resultset('Artist')->find(5), undef
250 => 'read after disconnect fails because it uses slave 1 which we have neglected to "replicate" yet';
252 ## Make sure all the slaves have the table definitions
253 $replicate->replicate;
255 ## Should find some data now
257 ok my $artist2 = $replicate->{schema}->resultset('Artist')->find(5)
261 => 'DBICTest::Artist';
263 is $artist2->name, "Doom's Children"
264 => 'Found expected name for first result';
266 ## What happens when we delete one of the slaves?
268 ok my $slave1 = @{$replicate->{slaves}}[0]
271 ok $slave1->disconnect
272 => 'disconnected slave1';
274 $replicate->reconnect;
276 ok my $artist3 = $replicate->{schema}->resultset('Artist')->find(6)
277 => 'Still finding stuff.';
280 => 'DBICTest::Artist';
282 is $artist3->name, "Dead On Arrival"
283 => 'Found expected name for first result';
285 ## Let's delete all the slaves
287 ok my $slave2 = @{$replicate->{slaves}}[1]
290 ok $slave2->disconnect
291 => 'Disconnected slave2';
293 $replicate->reconnect;
295 ## We expect an error now, since all the slaves are dead
298 $replicate->{schema}->resultset('Artist')->find(4)->name;
301 ok $@ => 'Got error when trying to find artistid 4';
303 ## This should also be an error
306 my $artist4 = $replicate->{schema}->resultset('Artist')->find(7);
309 ok $@ => 'Got read errors after everything failed';
311 ## make sure ->connect_info returns something sane
313 ok $replicate->{schema}->storage->connect_info
314 => 'got something out of ->connect_info';
316 ## Force a connection to the write source for testing.
318 $replicate->{schema}->storage($replicate->{schema}->storage->write_source);
320 ## What happens when we do a find for something that doesn't exist?
322 ok ! $replicate->{schema}->resultset('Artist')->find(666)
323 => 'Correctly did not find a bad artist id';
325 ## Delete the old database files