Commit | Line | Data |
e4dc89b3 |
1 | use strict; |
2 | use warnings; |
3 | use lib qw(t/lib); |
e4dc89b3 |
4 | use Test::More; |
2bf79155 |
5 | use Data::Dump qw/dump/; |
8f7986d6 |
6 | |
86583fa7 |
7 | BEGIN { |
2bf79155 |
8 | eval "use Moose"; |
86583fa7 |
9 | plan $@ |
2bf79155 |
10 | ? ( skip_all => 'needs Moose for testing' ) |
11 | : ( tests => 2 ); |
0f83441a |
12 | } |
13 | |
14 | ## ---------------------------------------------------------------------------- |
15 | ## Build a class to hold all our required testing data and methods. |
16 | ## ---------------------------------------------------------------------------- |
17 | |
18 | TESTSCHEMACLASS: { |
2bf79155 |
19 | |
20 | package DBIx::Class::DBI::Replicated::TestReplication; |
21 | |
22 | use DBICTest; |
23 | use base qw/Class::Accessor::Fast/; |
24 | |
25 | __PACKAGE__->mk_accessors( qw/schema/ ); |
26 | |
27 | ## Initialize the object |
28 | |
29 | sub new { |
30 | my $proto = shift; |
31 | my $class = ref( $proto ) || $proto; |
32 | my $self = {}; |
33 | |
34 | bless( $self, $class ); |
35 | |
36 | $self->schema( $self->init_schema ); |
37 | |
38 | return $self; |
39 | } |
40 | |
41 | ## get the Schema and set the replication storage type |
42 | |
43 | sub init_schema { |
44 | my $class = shift @_; |
45 | my $schema = DBICTest->init_schema(storage_type=>'::DBI::Replicated'); |
46 | return $schema; |
47 | } |
48 | } |
49 | |
50 | ## ---------------------------------------------------------------------------- |
51 | ## Create an object and run some tests |
52 | ## ---------------------------------------------------------------------------- |
53 | |
54 | my %params = ( |
55 | db_paths => [ |
56 | "t/var/DBIxClass.db", |
57 | "t/var/DBIxClass_slave1.db", |
58 | "t/var/DBIxClass_slave2.db", |
59 | ], |
60 | ); |
61 | |
62 | ok my $replicate = DBIx::Class::DBI::Replicated::TestReplication->new() |
63 | => 'Created a replication object'; |
64 | |
65 | isa_ok $replicate->schema |
66 | => 'DBIx::Class::Schema'; |
67 | |
68 | |
69 | warn dump $replicate->schema->storage->meta; |
70 | |
71 | warn dump $replicate->schema->storage->master; |
72 | |
73 | |
74 | __END__ |
75 | |
76 | ## ---------------------------------------------------------------------------- |
77 | ## Build a class to hold all our required testing data and methods. |
78 | ## ---------------------------------------------------------------------------- |
79 | |
80 | TESTSCHEMACLASS: { |
0f83441a |
81 | |
2156bbdd |
82 | package DBIx::Class::DBI::Replicated::TestReplication; |
0f83441a |
83 | |
84 | use DBI; |
85 | use DBICTest; |
86 | use File::Copy; |
87 | |
88 | ## Create a constructor |
89 | |
90 | sub new { |
91 | my $class = shift @_; |
92 | my %params = @_; |
93 | |
94 | my $self = bless { |
95 | db_paths => $params{db_paths}, |
96 | dsns => $class->init_dsns(%params), |
97 | schema=>$class->init_schema, |
98 | }, $class; |
99 | |
100 | $self->connect; |
101 | return $self; |
102 | } |
103 | |
104 | ## get the DSNs. We build this up from the list of file paths |
105 | |
106 | sub init_dsns { |
107 | my $class = shift @_; |
108 | my %params = @_; |
109 | my $db_paths = $params{db_paths}; |
110 | |
111 | my @dsn = map { |
112 | "dbi:SQLite:${_}"; |
113 | } @$db_paths; |
114 | |
115 | return \@dsn; |
116 | } |
117 | |
118 | ## get the Schema and set the replication storage type |
119 | |
120 | sub init_schema { |
121 | my $class = shift @_; |
122 | my $schema = DBICTest->init_schema(); |
2156bbdd |
123 | $schema->storage_type( '::DBI::Replicated' ); |
0f83441a |
124 | |
125 | return $schema; |
126 | } |
127 | |
128 | ## connect the Schema |
129 | |
130 | sub connect { |
131 | my $self = shift @_; |
132 | my ($master, @slaves) = @{$self->{dsns}}; |
2156bbdd |
133 | my $master_connect_info = [$master, '','', {AutoCommit=>1, PrintError=>0}]; |
0f83441a |
134 | |
2156bbdd |
135 | my @slavesob; |
0f83441a |
136 | foreach my $slave (@slaves) |
137 | { |
138 | my $dbh = shift @{$self->{slaves}} |
139 | || DBI->connect($slave,"","",{PrintError=>0, PrintWarn=>0}); |
140 | |
2156bbdd |
141 | push @{$master_connect_info->[-1]->{slaves_connect_info}}, |
0f83441a |
142 | [$dbh, '','',{priority=>10}]; |
143 | |
144 | push @slavesob, |
145 | $dbh; |
146 | } |
147 | |
148 | ## Keep track of the created slave databases |
149 | $self->{slaves} = \@slavesob; |
150 | |
151 | $self |
152 | ->{schema} |
2156bbdd |
153 | ->connect(@$master_connect_info); |
0f83441a |
154 | } |
155 | |
156 | ## replication |
157 | |
158 | sub replicate { |
159 | my $self = shift @_; |
160 | my ($master, @slaves) = @{$self->{db_paths}}; |
161 | |
162 | foreach my $slave (@slaves) { |
163 | copy($master, $slave); |
164 | } |
165 | } |
166 | |
167 | ## Cleanup afer ourselves. |
168 | |
169 | sub cleanup { |
170 | my $self = shift @_; |
171 | my ($master, @slaves) = @{$self->{db_paths}}; |
172 | |
173 | foreach my $slave (@slaves) { |
174 | unlink $slave; |
175 | } |
176 | } |
177 | |
178 | ## Force a reconnection |
179 | |
180 | sub reconnect { |
181 | my $self = shift @_; |
182 | my $schema = $self->connect; |
183 | $self->{schema} = $schema; |
184 | return $schema; |
185 | } |
86583fa7 |
186 | } |
e4dc89b3 |
187 | |
0f83441a |
188 | ## ---------------------------------------------------------------------------- |
189 | ## Create an object and run some tests |
190 | ## ---------------------------------------------------------------------------- |
191 | |
192 | my %params = ( |
193 | db_paths => [ |
194 | "t/var/DBIxClass.db", |
195 | "t/var/DBIxClass_slave1.db", |
196 | "t/var/DBIxClass_slave2.db", |
197 | ], |
198 | ); |
199 | |
2156bbdd |
200 | ok my $replicate = DBIx::Class::DBI::Replicated::TestReplication->new(%params) |
0f83441a |
201 | => 'Created a replication object'; |
202 | |
203 | isa_ok $replicate->{schema} |
204 | => 'DBIx::Class::Schema'; |
205 | |
206 | ## Add some info to the database |
207 | |
208 | $replicate |
209 | ->{schema} |
210 | ->populate('Artist', [ |
211 | [ qw/artistid name/ ], |
212 | [ 4, "Ozric Tentacles"], |
213 | ]); |
214 | |
215 | ## Make sure all the slaves have the table definitions |
216 | |
217 | $replicate->replicate; |
218 | |
219 | ## Make sure we can read the data. |
220 | |
221 | ok my $artist1 = $replicate->{schema}->resultset('Artist')->find(4) |
222 | => 'Created Result'; |
223 | |
224 | isa_ok $artist1 |
225 | => 'DBICTest::Artist'; |
226 | |
227 | is $artist1->name, 'Ozric Tentacles' |
228 | => 'Found expected name for first result'; |
229 | |
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 |
232 | ## database. |
233 | |
0f83441a |
234 | $replicate |
235 | ->{schema} |
236 | ->populate('Artist', [ |
237 | [ qw/artistid name/ ], |
238 | [ 5, "Doom's Children"], |
239 | [ 6, "Dead On Arrival"], |
240 | [ 7, "Watergate"], |
241 | ]); |
242 | |
243 | ## Reconnect the database |
244 | $replicate->reconnect; |
245 | |
246 | ## Alright, the database 'cluster' is not in a consistent state. When we do |
247 | ## a read now we expect bad news |
248 | |
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'; |
251 | |
252 | ## Make sure all the slaves have the table definitions |
253 | $replicate->replicate; |
254 | |
255 | ## Should find some data now |
256 | |
257 | ok my $artist2 = $replicate->{schema}->resultset('Artist')->find(5) |
258 | => 'Sync succeed'; |
259 | |
260 | isa_ok $artist2 |
261 | => 'DBICTest::Artist'; |
262 | |
263 | is $artist2->name, "Doom's Children" |
264 | => 'Found expected name for first result'; |
265 | |
266 | ## What happens when we delete one of the slaves? |
267 | |
268 | ok my $slave1 = @{$replicate->{slaves}}[0] |
269 | => 'Got Slave1'; |
270 | |
271 | ok $slave1->disconnect |
272 | => 'disconnected slave1'; |
273 | |
274 | $replicate->reconnect; |
275 | |
276 | ok my $artist3 = $replicate->{schema}->resultset('Artist')->find(6) |
277 | => 'Still finding stuff.'; |
278 | |
279 | isa_ok $artist3 |
280 | => 'DBICTest::Artist'; |
281 | |
282 | is $artist3->name, "Dead On Arrival" |
283 | => 'Found expected name for first result'; |
284 | |
285 | ## Let's delete all the slaves |
286 | |
287 | ok my $slave2 = @{$replicate->{slaves}}[1] |
288 | => 'Got Slave2'; |
289 | |
290 | ok $slave2->disconnect |
291 | => 'Disconnected slave2'; |
292 | |
293 | $replicate->reconnect; |
294 | |
295 | ## We expect an error now, since all the slaves are dead |
296 | |
297 | eval { |
298 | $replicate->{schema}->resultset('Artist')->find(4)->name; |
299 | }; |
300 | |
301 | ok $@ => 'Got error when trying to find artistid 4'; |
302 | |
303 | ## This should also be an error |
304 | |
305 | eval { |
306 | my $artist4 = $replicate->{schema}->resultset('Artist')->find(7); |
307 | }; |
308 | |
309 | ok $@ => 'Got read errors after everything failed'; |
310 | |
2156bbdd |
311 | ## make sure ->connect_info returns something sane |
312 | |
313 | ok $replicate->{schema}->storage->connect_info |
314 | => 'got something out of ->connect_info'; |
315 | |
316 | ## Force a connection to the write source for testing. |
317 | |
318 | $replicate->{schema}->storage($replicate->{schema}->storage->write_source); |
319 | |
320 | ## What happens when we do a find for something that doesn't exist? |
321 | |
322 | ok ! $replicate->{schema}->resultset('Artist')->find(666) |
323 | => 'Correctly did not find a bad artist id'; |
324 | |
0f83441a |
325 | ## Delete the old database files |
326 | $replicate->cleanup; |
327 | |
328 | |
329 | |
330 | |
331 | |
332 | |