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