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