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