Commit | Line | Data |
66afce69 |
1 | use strict; |
2 | use warnings; |
3 | use Test::More; |
b24cb177 |
4 | use Test::Exception; |
a0e0a56a |
5 | use File::Path qw/rmtree make_path/; |
66afce69 |
6 | use Class::Unload; |
ffc705f3 |
7 | use File::Temp qw/tempfile tempdir/; |
8 | use IO::File; |
68d49e50 |
9 | use DBIx::Class::Schema::Loader (); |
a79e1189 |
10 | use DBIx::Class::Schema::Loader::Utils 'slurp_file'; |
08e80fda |
11 | use Lingua::EN::Inflect::Number (); |
66afce69 |
12 | use lib qw(t/lib); |
c496748b |
13 | use make_dbictest_db_with_unique; |
c213fd3d |
14 | use dbixcsl_test_dir qw/$tdir/; |
66afce69 |
15 | |
c213fd3d |
16 | my $DUMP_DIR = "$tdir/common_dump"; |
66afce69 |
17 | rmtree $DUMP_DIR; |
a0e0a56a |
18 | my $SCHEMA_CLASS = 'DBIXCSL_Test::Schema'; |
66afce69 |
19 | |
9990e58f |
20 | my $RESULT_COUNT = 7; |
21 | |
7c304e59 |
22 | sub class_content_contains; |
23 | sub contains; |
08e80fda |
24 | |
66afce69 |
25 | # test dynamic schema in 0.04006 mode |
26 | { |
27 | my $res = run_loader(); |
a0e0a56a |
28 | my $warning = $res->{warnings}[0]; |
66afce69 |
29 | |
7c304e59 |
30 | contains $warning, 'Dynamic schema', |
66afce69 |
31 | 'dynamic schema in backcompat mode detected'; |
7c304e59 |
32 | contains $warning, 'run in 0.04006 mode', |
66afce69 |
33 | 'dynamic schema in 0.04006 mode warning'; |
7c304e59 |
34 | contains $warning, 'DBIx::Class::Schema::Loader::Manual::UpgradingFromV4', |
a0e0a56a |
35 | 'warning refers to upgrading doc'; |
494e0205 |
36 | |
a0e0a56a |
37 | run_v4_tests($res); |
38 | } |
66afce69 |
39 | |
a0e0a56a |
40 | # setting naming accessor on dynamic schema should disable warning (even when |
41 | # we're setting it to 'v4' .) |
42 | { |
43 | my $res = run_loader(naming => 'v4'); |
a0e0a56a |
44 | is_deeply $res->{warnings}, [], 'no warnings with naming attribute set'; |
f53dcdf0 |
45 | run_v4_tests($res); |
a0e0a56a |
46 | } |
47 | |
48 | # test upgraded dynamic schema |
49 | { |
50 | my $res = run_loader(naming => 'current'); |
a0e0a56a |
51 | is_deeply $res->{warnings}, [], 'no warnings with naming attribute set'; |
9990e58f |
52 | run_v7_tests($res); |
a0e0a56a |
53 | } |
54 | |
ffc705f3 |
55 | # test upgraded dynamic schema with external content loaded |
56 | { |
08e80fda |
57 | my $temp_dir = setup_load_external({ |
58 | Quuxs => 'Bazs', |
59 | Bar => 'Foos', |
60 | }); |
ffc705f3 |
61 | |
42ea7b88 |
62 | my $res = run_loader(naming => 'current', use_namespaces => 0); |
ffc705f3 |
63 | my $schema = $res->{schema}; |
64 | |
65 | is scalar @{ $res->{warnings} }, 1, |
66 | 'correct nummber of warnings for upgraded dynamic schema with external ' . |
67 | 'content for unsingularized Result.'; |
68 | |
69 | my $warning = $res->{warnings}[0]; |
7c304e59 |
70 | contains $warning, 'Detected external content', |
ffc705f3 |
71 | 'detected external content warning'; |
72 | |
b24cb177 |
73 | lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'hlagh' } |
ffc705f3 |
74 | 'external custom content for unsingularized Result was loaded by upgraded ' . |
75 | 'dynamic Schema'; |
76 | |
b24cb177 |
77 | lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel, |
78 | $res->{classes}{bazs} } |
79 | 'unsingularized class names in external content are translated'; |
80 | |
08e80fda |
81 | lives_and { is $schema->resultset('Bar')->find(1)->a_method, 'hlagh' } |
82 | 'external content from unchanged Result class'; |
83 | |
b24cb177 |
84 | lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel, |
85 | $res->{classes}{foos} } |
86 | 'unsingularized class names in external content from unchanged Result class ' . |
87 | 'names are translated'; |
88 | |
9990e58f |
89 | run_v7_tests($res); |
ffc705f3 |
90 | } |
91 | |
805dbe0a |
92 | # test upgraded dynamic schema with use_namespaces with external content loaded |
93 | { |
08e80fda |
94 | my $temp_dir = setup_load_external({ |
95 | Quuxs => 'Bazs', |
96 | Bar => 'Foos', |
97 | }); |
805dbe0a |
98 | |
99 | my $res = run_loader(naming => 'current', use_namespaces => 1); |
100 | my $schema = $res->{schema}; |
101 | |
102 | is scalar @{ $res->{warnings} }, 2, |
103 | 'correct nummber of warnings for upgraded dynamic schema with external ' . |
104 | 'content for unsingularized Result with use_namespaces.'; |
105 | |
106 | my $warning = $res->{warnings}[0]; |
7c304e59 |
107 | contains $warning, "Detected external content", |
805dbe0a |
108 | 'detected external content warning'; |
109 | |
110 | lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'hlagh' } |
111 | 'external custom content for unsingularized Result was loaded by upgraded ' . |
112 | 'dynamic Schema'; |
113 | |
08e80fda |
114 | lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel, |
805dbe0a |
115 | $res->{classes}{bazs} } |
116 | 'unsingularized class names in external content are translated'; |
117 | |
08e80fda |
118 | lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel, |
805dbe0a |
119 | $res->{classes}{foos} } |
120 | 'unsingularized class names in external content from unchanged Result class ' . |
121 | 'names are translated'; |
122 | |
9990e58f |
123 | run_v7_tests($res); |
805dbe0a |
124 | } |
125 | |
30a4c064 |
126 | # test upgraded static schema with external content loaded |
127 | { |
08e80fda |
128 | clean_dumpdir(); |
b24cb177 |
129 | |
08e80fda |
130 | my $temp_dir = setup_load_external({ |
131 | Quuxs => 'Bazs', |
132 | Bar => 'Foos', |
133 | }); |
30a4c064 |
134 | |
135 | write_v4_schema_pm(); |
136 | |
08e80fda |
137 | my $res = run_loader(static => 1, naming => 'current'); |
30a4c064 |
138 | my $schema = $res->{schema}; |
139 | |
9990e58f |
140 | run_v7_tests($res); |
30a4c064 |
141 | |
08e80fda |
142 | lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'hlagh' } |
30a4c064 |
143 | 'external custom content for unsingularized Result was loaded by upgraded ' . |
144 | 'static Schema'; |
145 | |
08e80fda |
146 | lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel, |
b24cb177 |
147 | $res->{classes}{bazs} } |
148 | 'unsingularized class names in external content are translated'; |
149 | |
08e80fda |
150 | lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel, |
b24cb177 |
151 | $res->{classes}{foos} } |
152 | 'unsingularized class names in external content from unchanged Result class ' . |
153 | 'names are translated in static schema'; |
154 | |
7c304e59 |
155 | class_content_contains $schema, $res->{classes}{quuxs}, "package ${SCHEMA_CLASS}::Quux;", |
30a4c064 |
156 | 'package line translated correctly from external custom content in static dump'; |
157 | |
7c304e59 |
158 | class_content_contains $schema, $res->{classes}{quuxs}, "sub a_method { 'hlagh' }", |
30a4c064 |
159 | 'external custom content loaded into static dump correctly'; |
30a4c064 |
160 | } |
161 | |
b24cb177 |
162 | # test running against v4 schema without upgrade, twice, then upgrade |
a0e0a56a |
163 | { |
08e80fda |
164 | clean_dumpdir(); |
30a4c064 |
165 | write_v4_schema_pm(); |
08e80fda |
166 | my $res = run_loader(static => 1); |
a1a91c42 |
167 | my $warning = $res->{warnings}[1]; |
a0e0a56a |
168 | |
7c304e59 |
169 | contains $warning, "static schema", |
a0e0a56a |
170 | 'static schema in backcompat mode detected'; |
7c304e59 |
171 | contains $warning, "0.04006", |
a0e0a56a |
172 | 'correct version detected'; |
7c304e59 |
173 | contains $warning, "DBIx::Class::Schema::Loader::Manual::UpgradingFromV4", |
a0e0a56a |
174 | 'refers to upgrading doc'; |
175 | |
a1a91c42 |
176 | is scalar @{ $res->{warnings} }, 4, |
ffc705f3 |
177 | 'correct number of warnings for static schema in backcompat mode'; |
178 | |
a0e0a56a |
179 | run_v4_tests($res); |
180 | |
08e80fda |
181 | add_custom_content($res->{schema}, { |
182 | Quuxs => 'Bazs' |
183 | }); |
a0e0a56a |
184 | |
b24cb177 |
185 | # Rerun the loader in backcompat mode to make sure it's still in backcompat |
186 | # mode. |
08e80fda |
187 | $res = run_loader(static => 1); |
b24cb177 |
188 | run_v4_tests($res); |
189 | |
a0e0a56a |
190 | # now upgrade the schema |
a1a91c42 |
191 | $res = run_loader( |
08e80fda |
192 | static => 1, |
a1a91c42 |
193 | naming => 'current', |
194 | use_namespaces => 1 |
195 | ); |
08e80fda |
196 | my $schema = $res->{schema}; |
a0e0a56a |
197 | |
7c304e59 |
198 | contains $res->{warnings}[0], "Dumping manual schema", |
a0e0a56a |
199 | 'correct warnings on upgrading static schema (with "naming" set)'; |
200 | |
7c304e59 |
201 | contains $res->{warnings}[1], "dump completed", |
a0e0a56a |
202 | 'correct warnings on upgrading static schema (with "naming" set)'; |
203 | |
204 | is scalar @{ $res->{warnings} }, 2, |
f53dcdf0 |
205 | 'correct number of warnings on upgrading static schema (with "naming" set)' |
206 | or diag @{ $res->{warnings} }; |
a0e0a56a |
207 | |
9990e58f |
208 | run_v7_tests($res); |
a0e0a56a |
209 | |
9990e58f |
210 | is result_count('Result'), $RESULT_COUNT, |
a1a91c42 |
211 | 'un-singularized results were replaced during upgrade'; |
212 | |
213 | # check that custom content was preserved |
08e80fda |
214 | lives_and { is $schema->resultset('Quux')->find(1)->b_method, 'dongs' } |
a1a91c42 |
215 | 'custom content was carried over from un-singularized Result'; |
216 | |
08e80fda |
217 | lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel, |
a1a91c42 |
218 | $res->{classes}{bazs} } |
219 | 'unsingularized class names in custom content are translated'; |
220 | |
7c304e59 |
221 | class_content_contains $schema, $res->{classes}{quuxs}, "sub b_method { 'dongs' }", |
a1a91c42 |
222 | 'custom content from unsingularized Result loaded into static dump correctly'; |
223 | } |
224 | |
225 | # test running against v4 schema without upgrade, then upgrade with |
226 | # use_namespaces not explicitly set |
227 | { |
08e80fda |
228 | clean_dumpdir(); |
a1a91c42 |
229 | write_v4_schema_pm(); |
08e80fda |
230 | my $res = run_loader(static => 1); |
a1a91c42 |
231 | my $warning = $res->{warnings}[1]; |
232 | |
7c304e59 |
233 | contains $warning, "static schema", |
a1a91c42 |
234 | 'static schema in backcompat mode detected'; |
7c304e59 |
235 | contains $warning, "0.04006", |
a1a91c42 |
236 | 'correct version detected'; |
7c304e59 |
237 | contains $warning, "DBIx::Class::Schema::Loader::Manual::UpgradingFromV4", |
a1a91c42 |
238 | 'refers to upgrading doc'; |
239 | |
240 | is scalar @{ $res->{warnings} }, 4, |
241 | 'correct number of warnings for static schema in backcompat mode'; |
242 | |
243 | run_v4_tests($res); |
244 | |
08e80fda |
245 | add_custom_content($res->{schema}, { |
246 | Quuxs => 'Bazs' |
247 | }); |
a1a91c42 |
248 | |
249 | # now upgrade the schema |
250 | $res = run_loader( |
08e80fda |
251 | static => 1, |
a1a91c42 |
252 | naming => 'current' |
253 | ); |
08e80fda |
254 | my $schema = $res->{schema}; |
a1a91c42 |
255 | |
7c304e59 |
256 | contains $res->{warnings}[0], "load_classes", |
a1a91c42 |
257 | 'correct warnings on upgrading static schema (with "naming" set and ' . |
258 | 'use_namespaces not set)'; |
259 | |
7c304e59 |
260 | contains $res->{warnings}[1], "Dumping manual schema", |
a1a91c42 |
261 | 'correct warnings on upgrading static schema (with "naming" set and ' . |
262 | 'use_namespaces not set)'; |
263 | |
7c304e59 |
264 | contains $res->{warnings}[2], "dump completed", |
a1a91c42 |
265 | 'correct warnings on upgrading static schema (with "naming" set and ' . |
266 | 'use_namespaces not set)'; |
267 | |
268 | is scalar @{ $res->{warnings} }, 3, |
269 | 'correct number of warnings on upgrading static schema (with "naming" set)' |
270 | or diag @{ $res->{warnings} }; |
271 | |
9990e58f |
272 | run_v7_tests($res); |
a1a91c42 |
273 | |
9990e58f |
274 | is result_count(), $RESULT_COUNT, |
a0e0a56a |
275 | 'un-singularized results were replaced during upgrade'; |
276 | |
277 | # check that custom content was preserved |
08e80fda |
278 | lives_and { is $schema->resultset('Quux')->find(1)->b_method, 'dongs' } |
a0e0a56a |
279 | 'custom content was carried over from un-singularized Result'; |
b24cb177 |
280 | |
08e80fda |
281 | lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel, |
a4b94090 |
282 | $res->{classes}{bazs} } |
283 | 'unsingularized class names in custom content are translated'; |
284 | |
7c304e59 |
285 | class_content_contains $schema, $res->{classes}{quuxs}, "sub b_method { 'dongs' }", |
a4b94090 |
286 | 'custom content from unsingularized Result loaded into static dump correctly'; |
287 | } |
288 | |
ecf930e6 |
289 | # test running against v4 schema with load_namespaces, upgrade to current but |
77bf4429 |
290 | # downgrade to load_classes, with external content |
a4b94090 |
291 | { |
08e80fda |
292 | clean_dumpdir(); |
77bf4429 |
293 | |
08e80fda |
294 | my $temp_dir = setup_load_external({ |
295 | Quuxs => 'Bazs', |
296 | Bar => 'Foos', |
297 | }, { result_namespace => 'Result' }); |
77bf4429 |
298 | |
a4b94090 |
299 | write_v4_schema_pm(use_namespaces => 1); |
77bf4429 |
300 | |
08e80fda |
301 | my $res = run_loader(static => 1); |
a4b94090 |
302 | my $warning = $res->{warnings}[0]; |
303 | |
7c304e59 |
304 | contains $warning, "static schema", |
a4b94090 |
305 | 'static schema in backcompat mode detected'; |
7c304e59 |
306 | contains $warning, "0.04006", |
a4b94090 |
307 | 'correct version detected'; |
7c304e59 |
308 | contains $warning, "DBIx::Class::Schema::Loader::Manual::UpgradingFromV4", |
a4b94090 |
309 | 'refers to upgrading doc'; |
310 | |
311 | is scalar @{ $res->{warnings} }, 3, |
312 | 'correct number of warnings for static schema in backcompat mode'; |
313 | |
314 | run_v4_tests($res); |
315 | |
77bf4429 |
316 | is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quuxs', |
317 | 'use_namespaces in backcompat mode'; |
318 | |
08e80fda |
319 | add_custom_content($res->{schema}, { |
320 | Quuxs => 'Bazs', |
321 | }, { |
322 | result_namespace => 'Result', |
323 | rel_name_map => { QuuxBaz => 'bazrel2' }, |
324 | }); |
a4b94090 |
325 | |
ecf930e6 |
326 | # now upgrade the schema to current but downgrade to load_classes |
a4b94090 |
327 | $res = run_loader( |
08e80fda |
328 | static => 1, |
a4b94090 |
329 | naming => 'current', |
330 | use_namespaces => 0, |
331 | ); |
08e80fda |
332 | my $schema = $res->{schema}; |
a4b94090 |
333 | |
7c304e59 |
334 | contains $res->{warnings}[0], "Dumping manual schema", |
a4b94090 |
335 | 'correct warnings on upgrading static schema (with "naming" set and ' . |
336 | 'use_namespaces => 0)'; |
337 | |
7c304e59 |
338 | contains $res->{warnings}[1], "dump completed", |
a4b94090 |
339 | 'correct warnings on upgrading static schema (with "naming" set and ' . |
340 | 'use_namespaces => 0)'; |
341 | |
342 | is scalar @{ $res->{warnings} }, 2, |
343 | 'correct number of warnings on upgrading static schema (with "naming" set)' |
344 | or diag @{ $res->{warnings} }; |
345 | |
9990e58f |
346 | run_v7_tests($res); |
a4b94090 |
347 | |
9990e58f |
348 | is result_count(), $RESULT_COUNT, |
a4b94090 |
349 | 'un-singularized results were replaced during upgrade and Result dir removed'; |
350 | |
08e80fda |
351 | ok ((not -d result_dir('Result')), |
a4b94090 |
352 | 'Result dir was removed for load_classes downgrade'); |
353 | |
540a8149 |
354 | is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux', |
355 | 'load_classes in upgraded mode'; |
356 | |
77bf4429 |
357 | # check that custom and external content was preserved |
08e80fda |
358 | lives_and { is $schema->resultset('Quux')->find(1)->b_method, 'dongs' } |
a4b94090 |
359 | 'custom content was carried over from un-singularized Result'; |
360 | |
08e80fda |
361 | lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'hlagh' } |
77bf4429 |
362 | 'external content was carried over from un-singularized Result'; |
363 | |
08e80fda |
364 | lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel2, |
b24cb177 |
365 | $res->{classes}{bazs} } |
366 | 'unsingularized class names in custom content are translated'; |
367 | |
08e80fda |
368 | lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel, |
77bf4429 |
369 | $res->{classes}{bazs} } |
370 | 'unsingularized class names in external content are translated'; |
371 | |
08e80fda |
372 | lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel, |
77bf4429 |
373 | $res->{classes}{foos} } |
374 | 'unsingularized class names in external content from unchanged Result class ' . |
375 | 'names are translated in static schema'; |
376 | |
7c304e59 |
377 | class_content_contains $schema, $res->{classes}{quuxs}, "sub a_method { 'hlagh' }", |
77bf4429 |
378 | 'external content from unsingularized Result loaded into static dump correctly'; |
379 | |
7c304e59 |
380 | class_content_contains $schema, $res->{classes}{quuxs}, "sub b_method { 'dongs' }", |
08e80fda |
381 | 'custom content from unsingularized Result loaded into static dump correctly'; |
b24cb177 |
382 | } |
383 | |
540a8149 |
384 | # test a regular schema with use_namespaces => 0 upgraded to |
385 | # use_namespaces => 1 |
386 | { |
540a8149 |
387 | my $res = run_loader( |
08e80fda |
388 | clean_dumpdir => 1, |
389 | static => 1, |
540a8149 |
390 | use_namespaces => 0, |
b08ea624 |
391 | naming => 'current', |
540a8149 |
392 | ); |
393 | |
7c304e59 |
394 | contains $res->{warnings}[0], "Dumping manual schema", |
540a8149 |
395 | 'correct warnings on dumping static schema with use_namespaces => 0'; |
396 | |
7c304e59 |
397 | contains $res->{warnings}[1], "dump completed", |
540a8149 |
398 | 'correct warnings on dumping static schema with use_namespaces => 0'; |
399 | |
400 | is scalar @{ $res->{warnings} }, 2, |
401 | 'correct number of warnings on dumping static schema with use_namespaces => 0' |
402 | or diag @{ $res->{warnings} }; |
403 | |
9990e58f |
404 | run_v7_tests($res); |
540a8149 |
405 | |
540a8149 |
406 | my $schema = $res->{schema}; |
08e80fda |
407 | add_custom_content($res->{schema}, { |
408 | Quux => 'Baz' |
409 | }); |
540a8149 |
410 | |
411 | # test that with no use_namespaces option, there is a warning and |
412 | # load_classes is preserved |
b08ea624 |
413 | $res = run_loader(static => 1, naming => 'current'); |
540a8149 |
414 | |
7c304e59 |
415 | contains $res->{warnings}[0], "load_classes", |
540a8149 |
416 | 'correct warnings on re-dumping static schema with load_classes'; |
417 | |
7c304e59 |
418 | contains $res->{warnings}[1], "Dumping manual schema", |
540a8149 |
419 | 'correct warnings on re-dumping static schema with load_classes'; |
420 | |
7c304e59 |
421 | contains $res->{warnings}[2], "dump completed", |
540a8149 |
422 | 'correct warnings on re-dumping static schema with load_classes'; |
423 | |
424 | is scalar @{ $res->{warnings} }, 3, |
425 | 'correct number of warnings on re-dumping static schema with load_classes' |
426 | or diag @{ $res->{warnings} }; |
427 | |
428 | is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux', |
429 | 'load_classes preserved on re-dump'; |
430 | |
9990e58f |
431 | run_v7_tests($res); |
540a8149 |
432 | |
433 | # now upgrade the schema to use_namespaces |
434 | $res = run_loader( |
08e80fda |
435 | static => 1, |
540a8149 |
436 | use_namespaces => 1, |
b08ea624 |
437 | naming => 'current', |
540a8149 |
438 | ); |
439 | $schema = $res->{schema}; |
440 | |
7c304e59 |
441 | contains $res->{warnings}[0], "Dumping manual schema", |
540a8149 |
442 | 'correct warnings on upgrading to use_namespaces'; |
443 | |
7c304e59 |
444 | contains $res->{warnings}[1], "dump completed", |
540a8149 |
445 | 'correct warnings on upgrading to use_namespaces'; |
446 | |
447 | is scalar @{ $res->{warnings} }, 2, |
448 | 'correct number of warnings on upgrading to use_namespaces' |
449 | or diag @{ $res->{warnings} }; |
450 | |
9990e58f |
451 | run_v7_tests($res); |
540a8149 |
452 | |
08e80fda |
453 | my @schema_files = schema_files(); |
540a8149 |
454 | |
455 | is 1, (scalar @schema_files), |
08e80fda |
456 | "schema dir contains only 1 entry"; |
540a8149 |
457 | |
458 | like $schema_files[0], qr{/Result\z}, |
459 | "schema dir contains only a Result/ directory"; |
460 | |
461 | # check that custom content was preserved |
08e80fda |
462 | lives_and { is $schema->resultset('Quux')->find(1)->b_method, 'dongs' } |
540a8149 |
463 | 'custom content was carried over during use_namespaces upgrade'; |
464 | |
08e80fda |
465 | lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel, |
540a8149 |
466 | $res->{classes}{bazs} } |
467 | 'un-namespaced class names in custom content are translated'; |
468 | |
7c304e59 |
469 | class_content_contains $schema, $res->{classes}{quuxs}, "sub b_method { 'dongs' }", |
540a8149 |
470 | 'custom content from un-namespaced Result loaded into static dump correctly'; |
471 | } |
472 | |
473 | # test a regular schema with default use_namespaces => 1, redump, and downgrade |
474 | # to load_classes |
475 | { |
b08ea624 |
476 | my $res = run_loader(clean_dumpdir => 1, static => 1, naming => 'current'); |
540a8149 |
477 | |
7c304e59 |
478 | contains $res->{warnings}[0], "Dumping manual schema", |
540a8149 |
479 | 'correct warnings on dumping static schema'; |
480 | |
7c304e59 |
481 | contains $res->{warnings}[1], "dump completed", |
540a8149 |
482 | 'correct warnings on dumping static schema'; |
483 | |
484 | is scalar @{ $res->{warnings} }, 2, |
485 | 'correct number of warnings on dumping static schema' |
486 | or diag @{ $res->{warnings} }; |
487 | |
9990e58f |
488 | run_v7_tests($res); |
540a8149 |
489 | |
490 | is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quux', |
491 | 'defaults to use_namespaces on regular dump'; |
492 | |
08e80fda |
493 | add_custom_content($res->{schema}, { Quux => 'Baz' }, { result_namespace => 'Result' }); |
540a8149 |
494 | |
495 | # test that with no use_namespaces option, use_namespaces is preserved |
b08ea624 |
496 | $res = run_loader(static => 1, naming => 'current'); |
540a8149 |
497 | |
7c304e59 |
498 | contains $res->{warnings}[0], "Dumping manual schema", |
540a8149 |
499 | 'correct warnings on re-dumping static schema'; |
500 | |
7c304e59 |
501 | contains $res->{warnings}[1], "dump completed", |
540a8149 |
502 | 'correct warnings on re-dumping static schema'; |
503 | |
504 | is scalar @{ $res->{warnings} }, 2, |
505 | 'correct number of warnings on re-dumping static schema' |
506 | or diag @{ $res->{warnings} }; |
507 | |
508 | is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quux', |
509 | 'use_namespaces preserved on re-dump'; |
510 | |
9990e58f |
511 | run_v7_tests($res); |
540a8149 |
512 | |
513 | # now downgrade the schema to load_classes |
514 | $res = run_loader( |
08e80fda |
515 | static => 1, |
540a8149 |
516 | use_namespaces => 0, |
b08ea624 |
517 | naming => 'current', |
540a8149 |
518 | ); |
08e80fda |
519 | my $schema = $res->{schema}; |
540a8149 |
520 | |
7c304e59 |
521 | contains $res->{warnings}[0], "Dumping manual schema", |
540a8149 |
522 | 'correct warnings on downgrading to load_classes'; |
523 | |
7c304e59 |
524 | contains $res->{warnings}[1], "dump completed", |
540a8149 |
525 | 'correct warnings on downgrading to load_classes'; |
526 | |
527 | is scalar @{ $res->{warnings} }, 2, |
528 | 'correct number of warnings on downgrading to load_classes' |
529 | or diag @{ $res->{warnings} }; |
530 | |
9990e58f |
531 | run_v7_tests($res); |
540a8149 |
532 | |
533 | is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux', |
534 | 'load_classes downgrade correct'; |
535 | |
9990e58f |
536 | is result_count(), $RESULT_COUNT, |
540a8149 |
537 | 'correct number of Results after upgrade and Result dir removed'; |
538 | |
08e80fda |
539 | ok ((not -d result_dir('Result')), |
540a8149 |
540 | 'Result dir was removed for load_classes downgrade'); |
541 | |
542 | # check that custom content was preserved |
08e80fda |
543 | lives_and { is $schema->resultset('Quux')->find(1)->b_method, 'dongs' } |
540a8149 |
544 | 'custom content was carried over during load_classes downgrade'; |
545 | |
08e80fda |
546 | lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel, |
540a8149 |
547 | $res->{classes}{bazs} } |
548 | 'namespaced class names in custom content are translated during load_classes '. |
549 | 'downgrade'; |
550 | |
7c304e59 |
551 | class_content_contains $schema, $res->{classes}{quuxs}, "sub b_method { 'dongs' }", |
540a8149 |
552 | 'custom content from namespaced Result loaded into static dump correctly '. |
553 | 'during load_classes downgrade'; |
554 | } |
555 | |
556 | # test a regular schema with use_namespaces => 1 and a custom result_namespace |
557 | # downgraded to load_classes |
558 | { |
540a8149 |
559 | my $res = run_loader( |
08e80fda |
560 | clean_dumpdir => 1, |
561 | static => 1, |
540a8149 |
562 | result_namespace => 'MyResult', |
b08ea624 |
563 | naming => 'current', |
540a8149 |
564 | ); |
565 | |
7c304e59 |
566 | contains $res->{warnings}[0], "Dumping manual schema", |
540a8149 |
567 | 'correct warnings on dumping static schema'; |
568 | |
7c304e59 |
569 | contains $res->{warnings}[1], "dump completed", |
540a8149 |
570 | 'correct warnings on dumping static schema'; |
571 | |
572 | is scalar @{ $res->{warnings} }, 2, |
573 | 'correct number of warnings on dumping static schema' |
574 | or diag @{ $res->{warnings} }; |
575 | |
9990e58f |
576 | run_v7_tests($res); |
540a8149 |
577 | |
578 | is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux', |
579 | 'defaults to use_namespaces and uses custom result_namespace'; |
580 | |
08e80fda |
581 | add_custom_content($res->{schema}, { Quux => 'Baz' }, { result_namespace => 'MyResult' }); |
540a8149 |
582 | |
583 | # test that with no use_namespaces option, use_namespaces is preserved, and |
584 | # the custom result_namespace is preserved |
b08ea624 |
585 | $res = run_loader(static => 1, naming => 'current'); |
540a8149 |
586 | |
7c304e59 |
587 | contains $res->{warnings}[0], "Dumping manual schema", |
540a8149 |
588 | 'correct warnings on re-dumping static schema'; |
589 | |
7c304e59 |
590 | contains $res->{warnings}[1], "dump completed", |
540a8149 |
591 | 'correct warnings on re-dumping static schema'; |
592 | |
593 | is scalar @{ $res->{warnings} }, 2, |
594 | 'correct number of warnings on re-dumping static schema' |
595 | or diag @{ $res->{warnings} }; |
596 | |
597 | is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux', |
598 | 'use_namespaces and custom result_namespace preserved on re-dump'; |
599 | |
9990e58f |
600 | run_v7_tests($res); |
540a8149 |
601 | |
602 | # now downgrade the schema to load_classes |
603 | $res = run_loader( |
08e80fda |
604 | static => 1, |
540a8149 |
605 | use_namespaces => 0, |
b08ea624 |
606 | naming => 'current', |
540a8149 |
607 | ); |
08e80fda |
608 | my $schema = $res->{schema}; |
540a8149 |
609 | |
7c304e59 |
610 | contains $res->{warnings}[0], "Dumping manual schema", |
540a8149 |
611 | 'correct warnings on downgrading to load_classes'; |
612 | |
7c304e59 |
613 | contains $res->{warnings}[1], "dump completed", |
540a8149 |
614 | 'correct warnings on downgrading to load_classes'; |
615 | |
616 | is scalar @{ $res->{warnings} }, 2, |
617 | 'correct number of warnings on downgrading to load_classes' |
618 | or diag @{ $res->{warnings} }; |
619 | |
9990e58f |
620 | run_v7_tests($res); |
540a8149 |
621 | |
622 | is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux', |
623 | 'load_classes downgrade correct'; |
624 | |
9990e58f |
625 | is result_count(), $RESULT_COUNT, |
540a8149 |
626 | 'correct number of Results after upgrade and Result dir removed'; |
627 | |
08e80fda |
628 | ok ((not -d result_dir('MyResult')), |
540a8149 |
629 | 'Result dir was removed for load_classes downgrade'); |
630 | |
631 | # check that custom content was preserved |
08e80fda |
632 | lives_and { is $schema->resultset('Quux')->find(1)->b_method, 'dongs' } |
540a8149 |
633 | 'custom content was carried over during load_classes downgrade'; |
634 | |
08e80fda |
635 | lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel, |
540a8149 |
636 | $res->{classes}{bazs} } |
637 | 'namespaced class names in custom content are translated during load_classes '. |
638 | 'downgrade'; |
639 | |
7c304e59 |
640 | class_content_contains $schema, $res->{classes}{quuxs}, "sub b_method { 'dongs' }", |
540a8149 |
641 | 'custom content from namespaced Result loaded into static dump correctly '. |
642 | 'during load_classes downgrade'; |
643 | } |
644 | |
77bf4429 |
645 | # rewrite from one result_namespace to another, with external content |
540a8149 |
646 | { |
08e80fda |
647 | clean_dumpdir(); |
648 | my $temp_dir = setup_load_external({ Quux => 'Baz', Bar => 'Foo' }, { result_namespace => 'Result' }); |
77bf4429 |
649 | |
b08ea624 |
650 | my $res = run_loader(static => 1, naming => 'current'); |
540a8149 |
651 | |
652 | # add some custom content to a Result that will be replaced |
08e80fda |
653 | add_custom_content($res->{schema}, { Quux => 'Baz' }, { result_namespace => 'Result', rel_name_map => { QuuxBaz => 'bazrel2' } }); |
540a8149 |
654 | |
655 | # Rewrite implicit 'Result' to 'MyResult' |
656 | $res = run_loader( |
08e80fda |
657 | static => 1, |
540a8149 |
658 | result_namespace => 'MyResult', |
b08ea624 |
659 | naming => 'current', |
540a8149 |
660 | ); |
08e80fda |
661 | my $schema = $res->{schema}; |
540a8149 |
662 | |
663 | is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux', |
664 | 'using new result_namespace'; |
665 | |
9990e58f |
666 | is result_count('MyResult'), $RESULT_COUNT, |
540a8149 |
667 | 'correct number of Results after rewritten result_namespace'; |
668 | |
08e80fda |
669 | ok ((not -d schema_dir('Result')), |
540a8149 |
670 | 'original Result dir was removed when rewriting result_namespace'); |
671 | |
672 | # check that custom content was preserved |
08e80fda |
673 | lives_and { is $schema->resultset('Quux')->find(1)->b_method, 'dongs' } |
540a8149 |
674 | 'custom content was carried over when rewriting result_namespace'; |
675 | |
08e80fda |
676 | lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel2, |
540a8149 |
677 | $res->{classes}{bazs} } |
678 | 'class names in custom content are translated when rewriting result_namespace'; |
679 | |
7c304e59 |
680 | class_content_contains $schema, $res->{classes}{quuxs}, "sub b_method { 'dongs' }", |
540a8149 |
681 | 'custom content from namespaced Result loaded into static dump correctly '. |
682 | 'when rewriting result_namespace'; |
683 | |
684 | # Now rewrite 'MyResult' to 'Mtfnpy' |
685 | $res = run_loader( |
08e80fda |
686 | static => 1, |
540a8149 |
687 | result_namespace => 'Mtfnpy', |
b08ea624 |
688 | naming => 'current', |
540a8149 |
689 | ); |
690 | $schema = $res->{schema}; |
691 | |
692 | is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Mtfnpy::Quux', |
693 | 'using new result_namespace'; |
694 | |
9990e58f |
695 | is result_count('Mtfnpy'), $RESULT_COUNT, |
540a8149 |
696 | 'correct number of Results after rewritten result_namespace'; |
697 | |
08e80fda |
698 | ok ((not -d result_dir('MyResult')), |
540a8149 |
699 | 'original Result dir was removed when rewriting result_namespace'); |
700 | |
77bf4429 |
701 | # check that custom and external content was preserved |
08e80fda |
702 | lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'hlagh' } |
703 | 'external content was carried over when rewriting result_namespace'; |
540a8149 |
704 | |
08e80fda |
705 | lives_and { is $schema->resultset('Quux')->find(1)->b_method, 'dongs' } |
77bf4429 |
706 | 'custom content was carried over when rewriting result_namespace'; |
707 | |
08e80fda |
708 | lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel2, |
540a8149 |
709 | $res->{classes}{bazs} } |
710 | 'class names in custom content are translated when rewriting result_namespace'; |
711 | |
08e80fda |
712 | lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel, |
77bf4429 |
713 | $res->{classes}{bazs} } |
714 | 'class names in external content are translated when rewriting '. |
715 | 'result_namespace'; |
716 | |
08e80fda |
717 | lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel, |
77bf4429 |
718 | $res->{classes}{foos} } |
719 | 'class names in external content are translated when rewriting '. |
720 | 'result_namespace'; |
721 | |
7c304e59 |
722 | class_content_contains $schema, $res->{classes}{quuxs}, "sub b_method { 'dongs' }", |
540a8149 |
723 | 'custom content from namespaced Result loaded into static dump correctly '. |
724 | 'when rewriting result_namespace'; |
77bf4429 |
725 | |
7c304e59 |
726 | class_content_contains $schema, $res->{classes}{quuxs}, "sub a_method { 'hlagh' }", |
77bf4429 |
727 | 'external content from unsingularized Result loaded into static dump correctly'; |
540a8149 |
728 | } |
729 | |
08e80fda |
730 | # test upgrading a v4 schema, then check that the version string is correct |
68d49e50 |
731 | { |
08e80fda |
732 | clean_dumpdir(); |
68d49e50 |
733 | write_v4_schema_pm(); |
08e80fda |
734 | run_loader(static => 1); |
735 | my $res = run_loader(static => 1, naming => 'current'); |
68d49e50 |
736 | my $schema = $res->{schema}; |
737 | |
c4a69b87 |
738 | my $file = $schema->loader->get_dump_filename($SCHEMA_CLASS); |
a79e1189 |
739 | my $code = slurp_file $file; |
68d49e50 |
740 | |
741 | my ($dumped_ver) = |
742 | $code =~ /^# Created by DBIx::Class::Schema::Loader v(\S+)/m; |
743 | |
744 | is $dumped_ver, $DBIx::Class::Schema::Loader::VERSION, |
745 | 'correct version dumped after upgrade of v4 static schema'; |
746 | } |
747 | |
b24cb177 |
748 | # Test upgrading an already singular result with custom content that refers to |
749 | # old class names. |
750 | { |
08e80fda |
751 | clean_dumpdir(); |
b24cb177 |
752 | write_v4_schema_pm(); |
08e80fda |
753 | my $res = run_loader(static => 1); |
754 | my $schema = $res->{schema}; |
b24cb177 |
755 | run_v4_tests($res); |
756 | |
757 | # add some custom content to a Result that will be replaced |
08e80fda |
758 | add_custom_content($schema, { Bar => 'Foos' }); |
b24cb177 |
759 | |
760 | # now upgrade the schema |
08e80fda |
761 | $res = run_loader(static => 1, naming => 'current'); |
b24cb177 |
762 | $schema = $res->{schema}; |
9990e58f |
763 | run_v7_tests($res); |
b24cb177 |
764 | |
765 | # check that custom content was preserved |
08e80fda |
766 | lives_and { is $schema->resultset('Bar')->find(1)->b_method, 'dongs' } |
b24cb177 |
767 | 'custom content was preserved from Result pre-upgrade'; |
768 | |
08e80fda |
769 | lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel, |
b24cb177 |
770 | $res->{classes}{foos} } |
771 | 'unsingularized class names in custom content from Result with unchanged ' . |
772 | 'name are translated'; |
773 | |
7c304e59 |
774 | class_content_contains $schema, $res->{classes}{bar}, "sub b_method { 'dongs' }", |
b24cb177 |
775 | 'custom content from Result with unchanged name loaded into static dump ' . |
776 | 'correctly'; |
66afce69 |
777 | } |
778 | |
40914006 |
779 | # test creating static schema in v5 mode then upgrade to current with external |
780 | # content loaded |
40914006 |
781 | { |
782 | clean_dumpdir(); |
783 | |
784 | write_v5_schema_pm(); |
785 | |
786 | my $res = run_loader(static => 1); |
787 | |
7c304e59 |
788 | contains $res->{warnings}[0], "0.05003 static schema", 'backcompat warning'; |
40914006 |
789 | |
790 | run_v5_tests($res); |
791 | |
792 | my $temp_dir = setup_load_external({ |
793 | Baz => 'StationsVisited', |
794 | StationsVisited => 'Quux', |
795 | }, { result_namespace => 'Result' }); |
796 | |
797 | add_custom_content($res->{schema}, { |
798 | Baz => 'StationsVisited', |
799 | }, { |
800 | result_namespace => 'Result', |
801 | rel_name_map => { BazStationsvisited => 'custom_content_rel' }, |
802 | }); |
803 | |
804 | $res = run_loader(static => 1, naming => 'current'); |
805 | my $schema = $res->{schema}; |
806 | |
9990e58f |
807 | run_v7_tests($res); |
40914006 |
808 | |
809 | lives_and { is $schema->resultset('Baz')->find(1)->a_method, 'hlagh' } |
810 | 'external custom content loaded for v5 -> v6'; |
811 | |
812 | lives_and { isa_ok $schema->resultset('Baz')->find(1)->stationsvisitedrel, |
813 | $res->{classes}{stations_visited} } |
814 | 'external content rewritten for v5 -> v6'; |
815 | |
816 | lives_and { isa_ok $schema->resultset('Baz')->find(1)->custom_content_rel, |
817 | $res->{classes}{stations_visited} } |
818 | 'custom content rewritten for v5 -> v6'; |
819 | |
820 | lives_and { isa_ok $schema->resultset('StationVisited')->find(1)->quuxrel, |
821 | $res->{classes}{quuxs} } |
822 | 'external content rewritten for v5 -> v6 for upgraded Result class names'; |
823 | } |
824 | |
9990e58f |
825 | # test creating static schema in v6 mode then upgrade to current with external |
826 | # content loaded |
827 | { |
828 | clean_dumpdir(); |
829 | |
830 | write_v6_schema_pm(); |
831 | |
832 | my $res = run_loader(static => 1); |
833 | |
7c304e59 |
834 | contains $res->{warnings}[0], "0.06001 static schema", 'backcompat warning'; |
9990e58f |
835 | |
836 | run_v6_tests($res); |
837 | |
838 | my $temp_dir = setup_load_external({ |
839 | Routechange => 'Quux', |
840 | }, { result_namespace => 'Result' }); |
841 | |
842 | add_custom_content($res->{schema}, { |
843 | Routechange => 'Quux', |
844 | }, { |
845 | result_namespace => 'Result', |
846 | rel_name_map => { RoutechangeQuux => 'custom_content_rel' }, |
847 | }); |
848 | |
849 | $res = run_loader(static => 1, naming => 'current'); |
850 | my $schema = $res->{schema}; |
851 | |
852 | run_v7_tests($res); |
853 | |
854 | lives_and { is $schema->resultset('RouteChange')->find(1)->a_method, 'hlagh' } |
855 | 'external custom content loaded for v6 -> v7'; |
856 | |
857 | lives_and { isa_ok $schema->resultset('RouteChange')->find(1)->quuxrel, |
858 | $res->{classes}{quuxs} } |
859 | 'external content rewritten for v6 -> v7'; |
860 | |
861 | lives_and { isa_ok $schema->resultset('RouteChange')->find(1)->custom_content_rel, |
862 | $res->{classes}{quuxs} } |
863 | 'custom content rewritten for v6 -> v7'; |
864 | } |
865 | |
66afce69 |
866 | done_testing; |
867 | |
ffc705f3 |
868 | END { |
869 | rmtree $DUMP_DIR unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}; |
870 | } |
a0e0a56a |
871 | |
08e80fda |
872 | sub clean_dumpdir { |
873 | rmtree $DUMP_DIR; |
874 | make_path $DUMP_DIR; |
875 | } |
876 | |
dbe9e0f7 |
877 | sub run_loader { |
878 | my %loader_opts = @_; |
879 | |
08e80fda |
880 | $loader_opts{dump_directory} = $DUMP_DIR if delete $loader_opts{static}; |
b08ea624 |
881 | $loader_opts{preserve_case} = 1 if $loader_opts{naming} && $loader_opts{naming} eq 'current'; |
08e80fda |
882 | |
883 | clean_dumpdir() if delete $loader_opts{clean_dumpdir}; |
884 | |
dbe9e0f7 |
885 | eval { |
886 | foreach my $source_name ($SCHEMA_CLASS->clone->sources) { |
887 | Class::Unload->unload("${SCHEMA_CLASS}::${source_name}"); |
888 | } |
889 | |
890 | Class::Unload->unload($SCHEMA_CLASS); |
891 | }; |
892 | undef $@; |
893 | |
c496748b |
894 | my @connect_info = $make_dbictest_db_with_unique::dsn; |
dbe9e0f7 |
895 | my @loader_warnings; |
c38ec663 |
896 | local $SIG{__WARN__} = sub { push(@loader_warnings, @_); }; |
dbe9e0f7 |
897 | eval qq{ |
898 | package $SCHEMA_CLASS; |
899 | use base qw/DBIx::Class::Schema::Loader/; |
900 | |
901 | __PACKAGE__->loader_options(\%loader_opts); |
902 | __PACKAGE__->connection(\@connect_info); |
903 | }; |
904 | |
905 | ok(!$@, "Loader initialization") or diag $@; |
906 | |
907 | my $schema = $SCHEMA_CLASS->clone; |
908 | my (%monikers, %classes); |
909 | foreach my $source_name ($schema->sources) { |
910 | my $table_name = $schema->source($source_name)->from; |
911 | $monikers{$table_name} = $source_name; |
d073740e |
912 | $classes{$table_name} = $schema->source($source_name)->result_class; |
dbe9e0f7 |
913 | } |
914 | |
915 | return { |
916 | schema => $schema, |
917 | warnings => \@loader_warnings, |
918 | monikers => \%monikers, |
919 | classes => \%classes, |
920 | }; |
921 | } |
922 | |
30a4c064 |
923 | sub write_v4_schema_pm { |
a4b94090 |
924 | my %opts = @_; |
925 | |
30a4c064 |
926 | (my $schema_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s/::[^:]+\z//; |
927 | rmtree $schema_dir; |
928 | make_path $schema_dir; |
929 | my $schema_pm = "$schema_dir/Schema.pm"; |
930 | open my $fh, '>', $schema_pm or die $!; |
a4b94090 |
931 | if (not $opts{use_namespaces}) { |
932 | print $fh <<'EOF'; |
30a4c064 |
933 | package DBIXCSL_Test::Schema; |
934 | |
935 | use strict; |
936 | use warnings; |
937 | |
938 | use base 'DBIx::Class::Schema'; |
939 | |
940 | __PACKAGE__->load_classes; |
941 | |
942 | |
943 | # Created by DBIx::Class::Schema::Loader v0.04006 @ 2009-12-25 01:49:25 |
944 | # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:ibIJTbfM1ji4pyD/lgSEog |
945 | |
946 | |
947 | # You can replace this text with custom content, and it will be preserved on regeneration |
948 | 1; |
949 | EOF |
a4b94090 |
950 | } |
951 | else { |
952 | print $fh <<'EOF'; |
953 | package DBIXCSL_Test::Schema; |
954 | |
955 | use strict; |
956 | use warnings; |
957 | |
958 | use base 'DBIx::Class::Schema'; |
959 | |
960 | __PACKAGE__->load_namespaces; |
961 | |
962 | |
963 | # Created by DBIx::Class::Schema::Loader v0.04006 @ 2010-01-12 16:04:12 |
964 | # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:d3wRVsHBNisyhxeaWJZcZQ |
965 | |
966 | |
967 | # You can replace this text with custom content, and it will be preserved on |
968 | # regeneration |
969 | 1; |
970 | EOF |
971 | } |
30a4c064 |
972 | } |
973 | |
ecf930e6 |
974 | sub write_v5_schema_pm { |
975 | my %opts = @_; |
976 | |
977 | (my $schema_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s/::[^:]+\z//; |
978 | rmtree $schema_dir; |
979 | make_path $schema_dir; |
980 | my $schema_pm = "$schema_dir/Schema.pm"; |
981 | open my $fh, '>', $schema_pm or die $!; |
982 | if (exists $opts{use_namespaces} && $opts{use_namespaces} == 0) { |
983 | print $fh <<'EOF'; |
984 | package DBIXCSL_Test::Schema; |
985 | |
986 | # Created by DBIx::Class::Schema::Loader |
987 | # DO NOT MODIFY THE FIRST PART OF THIS FILE |
988 | |
989 | use strict; |
990 | use warnings; |
991 | |
992 | use base 'DBIx::Class::Schema'; |
993 | |
994 | __PACKAGE__->load_classes; |
995 | |
996 | |
997 | # Created by DBIx::Class::Schema::Loader v0.05003 @ 2010-03-27 17:07:37 |
998 | # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:LIzC/LT5IYvWpgusfbqMrg |
999 | |
1000 | |
1001 | # You can replace this text with custom content, and it will be preserved on regeneration |
1002 | 1; |
1003 | EOF |
1004 | } |
1005 | else { |
1006 | print $fh <<'EOF'; |
1007 | package DBIXCSL_Test::Schema; |
1008 | |
1009 | # Created by DBIx::Class::Schema::Loader |
1010 | # DO NOT MODIFY THE FIRST PART OF THIS FILE |
1011 | |
1012 | use strict; |
1013 | use warnings; |
1014 | |
1015 | use base 'DBIx::Class::Schema'; |
1016 | |
40914006 |
1017 | __PACKAGE__->load_namespaces; |
ecf930e6 |
1018 | |
1019 | |
40914006 |
1020 | # Created by DBIx::Class::Schema::Loader v0.05003 @ 2010-03-29 19:44:52 |
1021 | # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:D+MYxtGxz97Ghvido5DTEg |
ecf930e6 |
1022 | |
1023 | |
1024 | # You can replace this text with custom content, and it will be preserved on regeneration |
1025 | 1; |
1026 | EOF |
1027 | } |
1028 | } |
1029 | |
9990e58f |
1030 | sub write_v6_schema_pm { |
1031 | my %opts = @_; |
1032 | |
1033 | (my $schema_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s/::[^:]+\z//; |
1034 | rmtree $schema_dir; |
1035 | make_path $schema_dir; |
1036 | my $schema_pm = "$schema_dir/Schema.pm"; |
1037 | open my $fh, '>', $schema_pm or die $!; |
1038 | if (exists $opts{use_namespaces} && $opts{use_namespaces} == 0) { |
1039 | print $fh <<'EOF'; |
1040 | package DBIXCSL_Test::Schema; |
1041 | |
1042 | # Created by DBIx::Class::Schema::Loader |
1043 | # DO NOT MODIFY THE FIRST PART OF THIS FILE |
1044 | |
1045 | use strict; |
1046 | use warnings; |
1047 | |
1048 | use base 'DBIx::Class::Schema'; |
1049 | |
1050 | __PACKAGE__->load_classes; |
1051 | |
1052 | |
1053 | # Created by DBIx::Class::Schema::Loader v0.06001 @ 2010-04-21 19:56:03 |
1054 | # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:/fqZCb95hsGIe1g5qyQQZg |
1055 | |
1056 | |
1057 | # You can replace this text with custom content, and it will be preserved on regeneration |
1058 | 1; |
1059 | EOF |
1060 | } |
1061 | else { |
1062 | print $fh <<'EOF'; |
1063 | package DBIXCSL_Test::Schema; |
1064 | |
1065 | # Created by DBIx::Class::Schema::Loader |
1066 | # DO NOT MODIFY THE FIRST PART OF THIS FILE |
1067 | |
1068 | use strict; |
1069 | use warnings; |
1070 | |
1071 | use base 'DBIx::Class::Schema'; |
1072 | |
1073 | __PACKAGE__->load_namespaces; |
1074 | |
1075 | |
1076 | # Created by DBIx::Class::Schema::Loader v0.06001 @ 2010-04-21 19:54:31 |
1077 | # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:nwO5Vi47kl0X9SpEoiVO5w |
1078 | |
1079 | |
1080 | # You can replace this text with custom content, and it will be preserved on regeneration |
1081 | 1; |
1082 | EOF |
1083 | } |
1084 | } |
1085 | |
dbe9e0f7 |
1086 | sub run_v4_tests { |
1087 | my $res = shift; |
1088 | my $schema = $res->{schema}; |
1089 | |
9990e58f |
1090 | is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs stations_visited RouteChange email/} ], |
1091 | [qw/Foos Bar Bazs Quuxs StationsVisited Routechange Email/], |
dbe9e0f7 |
1092 | 'correct monikers in 0.04006 mode'; |
1093 | |
1094 | isa_ok ((my $bar = eval { $schema->resultset('Bar')->find(1) }), |
1095 | $res->{classes}{bar}, |
1096 | 'found a bar'); |
1097 | |
1098 | isa_ok eval { $bar->foo_id }, $res->{classes}{foos}, |
1099 | 'correct rel name in 0.04006 mode'; |
1100 | |
1101 | ok my $baz = eval { $schema->resultset('Bazs')->find(1) }; |
1102 | |
1103 | isa_ok eval { $baz->quux }, 'DBIx::Class::ResultSet', |
1104 | 'correct rel type and name for UNIQUE FK in 0.04006 mode'; |
ecf930e6 |
1105 | |
1106 | ok my $foo = eval { $schema->resultset('Foos')->find(1) }; |
1107 | |
1108 | isa_ok eval { $foo->email_to_ids }, 'DBIx::Class::ResultSet', |
1109 | 'correct rel name inflection in 0.04006 mode'; |
f3a657ef |
1110 | |
1111 | ok (($schema->resultset('Routechange')->find(1)->can('quuxsid')), |
1112 | 'correct column accessor in 0.04006 mode'); |
a9a6e6bb |
1113 | |
1114 | is $schema->resultset('Routechange')->find(1)->foo2bar, 3, |
1115 | 'correct column accessor for column with word ending with digit in v4 mode'; |
dbe9e0f7 |
1116 | } |
1117 | |
1118 | sub run_v5_tests { |
1119 | my $res = shift; |
1120 | my $schema = $res->{schema}; |
1121 | |
9990e58f |
1122 | is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs stations_visited RouteChange email/} ], |
1123 | [qw/Foo Bar Baz Quux StationsVisited Routechange Email/], |
40914006 |
1124 | 'correct monikers in v5 mode'; |
ecf930e6 |
1125 | |
1126 | ok my $bar = eval { $schema->resultset('Bar')->find(1) }; |
1127 | |
1128 | isa_ok eval { $bar->foo }, $res->{classes}{foos}, |
1129 | 'correct rel name in v5 mode'; |
1130 | |
1131 | ok my $baz = eval { $schema->resultset('Baz')->find(1) }; |
1132 | |
1133 | isa_ok eval { $baz->quux }, $res->{classes}{quuxs}, |
1134 | 'correct rel type and name for UNIQUE FK in v5 mode'; |
1135 | |
1136 | ok my $foo = eval { $schema->resultset('Foo')->find(1) }; |
1137 | |
1138 | isa_ok eval { $foo->email_to_ids }, 'DBIx::Class::ResultSet', |
1139 | 'correct rel name inflection in v5 mode'; |
f3a657ef |
1140 | |
1141 | ok (($schema->resultset('Routechange')->find(1)->can('quuxsid')), |
1142 | 'correct column accessor in v5 mode'); |
a9a6e6bb |
1143 | |
1144 | is $schema->resultset('Routechange')->find(1)->foo2bar, 3, |
1145 | 'correct column accessor for column with word ending with digit in v5 mode'; |
ecf930e6 |
1146 | } |
1147 | |
1148 | sub run_v6_tests { |
1149 | my $res = shift; |
1150 | my $schema = $res->{schema}; |
1151 | |
9990e58f |
1152 | is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs stations_visited RouteChange email/} ], |
1153 | [qw/Foo Bar Baz Quux StationVisited Routechange Email/], |
1154 | 'correct monikers in v6 mode'; |
1155 | |
1156 | ok my $bar = eval { $schema->resultset('Bar')->find(1) }; |
1157 | |
1158 | isa_ok eval { $bar->foo }, $res->{classes}{foos}, |
1159 | 'correct rel name in v6 mode'; |
1160 | |
1161 | ok my $baz = eval { $schema->resultset('Baz')->find(1) }; |
1162 | |
1163 | isa_ok eval { $baz->quux }, $res->{classes}{quuxs}, |
1164 | 'correct rel type and name for UNIQUE FK in v6 mode'; |
1165 | |
1166 | ok my $foo = eval { $schema->resultset('Foo')->find(1) }; |
1167 | |
1168 | isa_ok eval { $foo->emails_to }, 'DBIx::Class::ResultSet', |
1169 | 'correct rel name inflection in v6 mode'; |
b08ea624 |
1170 | |
1171 | ok my $route_change = eval { $schema->resultset('Routechange')->find(1) }; |
1172 | |
1173 | isa_ok eval { $route_change->quuxsid }, $res->{classes}{quuxs}, |
1174 | 'correct rel name in v6 mode'; |
f3a657ef |
1175 | |
1176 | ok (($schema->resultset('Routechange')->find(1)->can('quuxsid')), |
1177 | 'correct column accessor in v6 mode'); |
a9a6e6bb |
1178 | |
1179 | is $schema->resultset('Routechange')->find(1)->foo2bar, 3, |
1180 | 'correct column accessor for column with word ending with digit in v6 mode'; |
9990e58f |
1181 | } |
1182 | |
1183 | sub run_v7_tests { |
1184 | my $res = shift; |
1185 | my $schema = $res->{schema}; |
1186 | |
1187 | is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs stations_visited RouteChange email/} ], |
1188 | [qw/Foo Bar Baz Quux StationVisited RouteChange Email/], |
dbe9e0f7 |
1189 | 'correct monikers in current mode'; |
1190 | |
1191 | ok my $bar = eval { $schema->resultset('Bar')->find(1) }; |
1192 | |
1193 | isa_ok eval { $bar->foo }, $res->{classes}{foos}, |
1194 | 'correct rel name in current mode'; |
1195 | |
1196 | ok my $baz = eval { $schema->resultset('Baz')->find(1) }; |
1197 | |
1198 | isa_ok eval { $baz->quux }, $res->{classes}{quuxs}, |
1199 | 'correct rel type and name for UNIQUE FK in current mode'; |
ecf930e6 |
1200 | |
1201 | ok my $foo = eval { $schema->resultset('Foo')->find(1) }; |
1202 | |
1203 | isa_ok eval { $foo->emails_to }, 'DBIx::Class::ResultSet', |
1204 | 'correct rel name inflection in current mode'; |
b08ea624 |
1205 | |
1206 | ok my $route_change = eval { $schema->resultset('RouteChange')->find(1) }; |
1207 | |
1208 | isa_ok eval { $route_change->quux }, $res->{classes}{quuxs}, |
1209 | 'correct rel name based on mixed-case column name in current mode'; |
f3a657ef |
1210 | |
1211 | ok (($schema->resultset('RouteChange')->find(1)->can('quuxs_id')), |
1212 | 'correct column accessor in current mode'); |
a9a6e6bb |
1213 | |
1214 | is $schema->resultset('RouteChange')->find(1)->foo2_bar, 3, |
1215 | 'correct column accessor for column with word ending with digit in current mode'; |
dbe9e0f7 |
1216 | } |
08e80fda |
1217 | |
1218 | { |
1219 | package DBICSL::Test::TempExtDir; |
1220 | |
1221 | use overload '""' => sub { ${$_[0]} }; |
1222 | |
1223 | sub DESTROY { |
1224 | pop @INC; |
ca12f6c9 |
1225 | File::Path::rmtree ${$_[0]}; |
08e80fda |
1226 | } |
1227 | } |
1228 | |
1229 | sub setup_load_external { |
1230 | my ($rels, $opts) = @_; |
1231 | |
1232 | my $temp_dir = tempdir(CLEANUP => 1); |
1233 | push @INC, $temp_dir; |
1234 | |
1235 | my $external_result_dir = join '/', $temp_dir, (split /::/, $SCHEMA_CLASS), |
1236 | ($opts->{result_namespace} || ()); |
1237 | |
1238 | make_path $external_result_dir; |
1239 | |
1240 | while (my ($from, $to) = each %$rels) { |
1241 | write_ext_result($external_result_dir, $from, $to, $opts); |
1242 | } |
1243 | |
1244 | my $guard = bless \$temp_dir, 'DBICSL::Test::TempExtDir'; |
1245 | |
1246 | return $guard; |
1247 | } |
1248 | |
1249 | sub write_ext_result { |
1250 | my ($result_dir, $from, $to, $opts) = @_; |
1251 | |
1252 | my $relname = $opts->{rel_name_map}{_rel_key($from, $to)} || _relname($to); |
1253 | my $from_class = _qualify_class($from, $opts->{result_namespace}); |
1254 | my $to_class = _qualify_class($to, $opts->{result_namespace}); |
1255 | my $condition = _rel_condition($from, $to); |
1256 | |
1257 | IO::File->new(">$result_dir/${from}.pm")->print(<<"EOF"); |
1258 | package ${from_class}; |
1259 | sub a_method { 'hlagh' } |
1260 | |
1261 | __PACKAGE__->has_one('$relname', '$to_class', |
1262 | { $condition }); |
1263 | |
1264 | 1; |
1265 | EOF |
1266 | |
1267 | return $relname; |
1268 | } |
1269 | |
1270 | sub _relname { |
1271 | my $to = shift; |
1272 | |
1273 | return Lingua::EN::Inflect::Number::to_S(lc $to) . 'rel'; |
1274 | } |
1275 | |
1276 | sub _qualify_class { |
1277 | my ($class, $result_namespace) = @_; |
1278 | |
1279 | return $SCHEMA_CLASS . '::' |
1280 | . ($result_namespace ? $result_namespace . '::' : '') |
1281 | . $class; |
1282 | } |
1283 | |
1284 | sub _rel_key { |
1285 | my ($from, $to) = @_; |
1286 | |
1287 | return join '', map ucfirst(Lingua::EN::Inflect::Number::to_S(lc($_))), $from, $to; |
1288 | } |
1289 | |
1290 | sub _rel_condition { |
1291 | my ($from, $to) = @_; |
1292 | |
1293 | return +{ |
1294 | QuuxBaz => q{'foreign.baz_num' => 'self.baz_id'}, |
1295 | BarFoo => q{'foreign.fooid' => 'self.foo_id'}, |
40914006 |
1296 | BazStationsvisited => q{'foreign.id' => 'self.stations_visited_id'}, |
1297 | StationsvisitedQuux => q{'foreign.quuxid' => 'self.quuxs_id'}, |
b08ea624 |
1298 | RoutechangeQuux => q{'foreign.quuxid' => 'self.QuuxsId'}, |
08e80fda |
1299 | }->{_rel_key($from, $to)}; |
1300 | } |
1301 | |
7c304e59 |
1302 | sub class_content_contains { |
1303 | my ($schema, $class, $substr, $test_name) = @_; |
08e80fda |
1304 | |
c4a69b87 |
1305 | my $file = $schema->loader->get_dump_filename($class); |
a79e1189 |
1306 | my $code = slurp_file $file; |
08e80fda |
1307 | |
7c304e59 |
1308 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
1309 | |
1310 | contains $code, $substr, $test_name; |
1311 | } |
1312 | |
1313 | sub contains { |
1314 | my ($haystack, $needle, $test_name) = @_; |
1315 | |
1316 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
1317 | |
1318 | like $haystack, qr/\Q$needle\E/, $test_name; |
08e80fda |
1319 | } |
1320 | |
1321 | sub add_custom_content { |
1322 | my ($schema, $rels, $opts) = @_; |
1323 | |
1324 | while (my ($from, $to) = each %$rels) { |
1325 | my $relname = $opts->{rel_name_map}{_rel_key($from, $to)} || _relname($to); |
1326 | my $from_class = _qualify_class($from, $opts->{result_namespace}); |
1327 | my $to_class = _qualify_class($to, $opts->{result_namespace}); |
1328 | my $condition = _rel_condition($from, $to); |
1329 | |
1330 | my $content = <<"EOF"; |
1331 | package ${from_class}; |
1332 | sub b_method { 'dongs' } |
1333 | |
1334 | __PACKAGE__->has_one('$relname', '$to_class', |
1335 | { $condition }); |
1336 | |
1337 | 1; |
1338 | EOF |
1339 | |
1340 | _write_custom_content($schema, $from_class, $content); |
1341 | } |
1342 | } |
1343 | |
1344 | sub _write_custom_content { |
1345 | my ($schema, $class, $content) = @_; |
1346 | |
c4a69b87 |
1347 | my $pm = $schema->loader->get_dump_filename($class); |
08e80fda |
1348 | { |
1349 | local ($^I, @ARGV) = ('.bak', $pm); |
1350 | while (<>) { |
1351 | if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) { |
1352 | print; |
1353 | print $content; |
1354 | } |
1355 | else { |
1356 | print; |
1357 | } |
1358 | } |
1359 | close ARGV; |
1360 | unlink "${pm}.bak" or die $^E; |
1361 | } |
1362 | } |
1363 | |
1364 | sub result_count { |
1365 | my $path = shift || ''; |
1366 | |
1367 | my $dir = result_dir($path); |
1368 | |
1369 | my $file_count =()= glob "$dir/*"; |
1370 | |
1371 | return $file_count; |
1372 | } |
1373 | |
1374 | sub result_files { |
1375 | my $path = shift || ''; |
1376 | |
1377 | my $dir = result_dir($path); |
1378 | |
1379 | return glob "$dir/*"; |
1380 | } |
1381 | |
1382 | sub schema_files { result_files(@_) } |
1383 | |
1384 | sub result_dir { |
1385 | my $path = shift || ''; |
1386 | |
1387 | (my $dir = "$DUMP_DIR/$SCHEMA_CLASS/$path") =~ s{::}{/}g; |
1388 | $dir =~ s{/+\z}{}; |
1389 | |
1390 | return $dir; |
1391 | } |
1392 | |
1393 | sub schema_dir { result_dir(@_) } |
ecf930e6 |
1394 | |
1395 | # vim:et sts=4 sw=4 tw=0: |