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