Commit | Line | Data |
9a95164d |
1 | use strict; |
2 | use Test::More; |
1c94fb11 |
3 | use lib qw(t/backcompat/0.04006/lib); |
9a95164d |
4 | use File::Path; |
5 | use make_dbictest_db; |
c213fd3d |
6 | use dbixcsl_test_dir qw/$tdir/; |
23fd9773 |
7 | use Class::Unload (); |
c213fd3d |
8 | |
9a95164d |
9 | require DBIx::Class::Schema::Loader; |
818c6a0c |
10 | |
fb3bb595 |
11 | plan skip_all => 'set SCHEMA_LOADER_TESTS_BACKCOMPAT to enable these tests' |
1c94fb11 |
12 | unless $ENV{SCHEMA_LOADER_TESTS_BACKCOMPAT}; |
13 | |
c213fd3d |
14 | my $DUMP_PATH = "$tdir/dump"; |
9a95164d |
15 | |
16 | sub do_dump_test { |
17 | my %tdata = @_; |
18 | |
19 | my $schema_class = $tdata{classname}; |
20 | |
21 | no strict 'refs'; |
22 | @{$schema_class . '::ISA'} = ('DBIx::Class::Schema::Loader'); |
f22644d7 |
23 | |
24 | $tdata{options}{use_namespaces} ||= 0; |
25 | |
9a95164d |
26 | $schema_class->loader_options(dump_directory => $DUMP_PATH, %{$tdata{options}}); |
27 | |
28 | my @warns; |
29 | eval { |
30 | local $SIG{__WARN__} = sub { push(@warns, @_) }; |
31 | $schema_class->connect($make_dbictest_db::dsn); |
32 | }; |
33 | my $err = $@; |
23fd9773 |
34 | |
35 | Class::Unload->unload($schema_class); |
9a95164d |
36 | |
37 | is($err, $tdata{error}); |
38 | |
39 | my $check_warns = $tdata{warnings}; |
40 | is(@warns, @$check_warns); |
41 | for(my $i = 0; $i <= $#$check_warns; $i++) { |
42 | like($warns[$i], $check_warns->[$i]); |
43 | } |
44 | |
45 | my $file_regexes = $tdata{regexes}; |
46 | my $file_neg_regexes = $tdata{neg_regexes} || {}; |
47 | my $schema_regexes = delete $file_regexes->{schema}; |
48 | |
49 | my $schema_path = $DUMP_PATH . '/' . $schema_class; |
50 | $schema_path =~ s{::}{/}g; |
51 | dump_file_like($schema_path . '.pm', @$schema_regexes); |
52 | foreach my $src (keys %$file_regexes) { |
53 | my $src_file = $schema_path . '/' . $src . '.pm'; |
54 | dump_file_like($src_file, @{$file_regexes->{$src}}); |
55 | } |
56 | foreach my $src (keys %$file_neg_regexes) { |
57 | my $src_file = $schema_path . '/' . $src . '.pm'; |
58 | dump_file_not_like($src_file, @{$file_neg_regexes->{$src}}); |
59 | } |
60 | } |
61 | |
62 | sub dump_file_like { |
63 | my $path = shift; |
64 | open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!"; |
65 | my $contents = do { local $/; <$dumpfh>; }; |
66 | close($dumpfh); |
67 | like($contents, $_) for @_; |
68 | } |
69 | |
70 | sub dump_file_not_like { |
71 | my $path = shift; |
72 | open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!"; |
73 | my $contents = do { local $/; <$dumpfh>; }; |
74 | close($dumpfh); |
75 | unlike($contents, $_) for @_; |
76 | } |
77 | |
78 | sub append_to_class { |
79 | my ($class, $string) = @_; |
80 | $class =~ s{::}{/}g; |
81 | $class = $DUMP_PATH . '/' . $class . '.pm'; |
82 | open(my $appendfh, '>>', $class) or die "Failed to open '$class' for append: $!"; |
83 | print $appendfh $string; |
84 | close($appendfh); |
85 | } |
86 | |
87 | rmtree($DUMP_PATH, 1, 1); |
88 | |
89 | do_dump_test( |
90 | classname => 'DBICTest::DumpMore::1', |
91 | options => { }, |
92 | error => '', |
93 | warnings => [ |
94 | qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, |
95 | qr/Schema dump completed/, |
96 | ], |
97 | regexes => { |
98 | schema => [ |
99 | qr/package DBICTest::DumpMore::1;/, |
100 | qr/->load_classes/, |
101 | ], |
102 | Foo => [ |
103 | qr/package DBICTest::DumpMore::1::Foo;/, |
104 | qr/->set_primary_key/, |
105 | qr/1;\n$/, |
106 | ], |
107 | Bar => [ |
108 | qr/package DBICTest::DumpMore::1::Bar;/, |
109 | qr/->set_primary_key/, |
110 | qr/1;\n$/, |
111 | ], |
112 | }, |
113 | ); |
114 | |
115 | append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX}); |
116 | |
117 | do_dump_test( |
118 | classname => 'DBICTest::DumpMore::1', |
119 | options => { }, |
120 | error => '', |
121 | warnings => [ |
122 | qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, |
123 | qr/Schema dump completed/, |
124 | ], |
125 | regexes => { |
126 | schema => [ |
127 | qr/package DBICTest::DumpMore::1;/, |
128 | qr/->load_classes/, |
129 | ], |
130 | Foo => [ |
131 | qr/package DBICTest::DumpMore::1::Foo;/, |
132 | qr/->set_primary_key/, |
133 | qr/1;\n# XXX This is my custom content XXX/, |
134 | ], |
135 | Bar => [ |
136 | qr/package DBICTest::DumpMore::1::Bar;/, |
137 | qr/->set_primary_key/, |
138 | qr/1;\n$/, |
139 | ], |
140 | }, |
141 | ); |
142 | |
143 | do_dump_test( |
144 | classname => 'DBICTest::DumpMore::1', |
145 | options => { really_erase_my_files => 1 }, |
146 | error => '', |
147 | warnings => [ |
148 | qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, |
149 | qr/Deleting existing file /, |
150 | qr/Deleting existing file /, |
151 | qr/Deleting existing file /, |
152 | qr/Schema dump completed/, |
153 | ], |
154 | regexes => { |
155 | schema => [ |
156 | qr/package DBICTest::DumpMore::1;/, |
157 | qr/->load_classes/, |
158 | ], |
159 | Foo => [ |
160 | qr/package DBICTest::DumpMore::1::Foo;/, |
161 | qr/->set_primary_key/, |
162 | qr/1;\n$/, |
163 | ], |
164 | Bar => [ |
165 | qr/package DBICTest::DumpMore::1::Bar;/, |
166 | qr/->set_primary_key/, |
167 | qr/1;\n$/, |
168 | ], |
169 | }, |
170 | neg_regexes => { |
171 | Foo => [ |
172 | qr/# XXX This is my custom content XXX/, |
173 | ], |
174 | }, |
175 | ); |
176 | |
177 | do_dump_test( |
178 | classname => 'DBICTest::DumpMore::1', |
179 | options => { use_namespaces => 1 }, |
180 | error => '', |
181 | warnings => [ |
182 | qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, |
183 | qr/Schema dump completed/, |
184 | ], |
185 | regexes => { |
186 | schema => [ |
187 | qr/package DBICTest::DumpMore::1;/, |
188 | qr/->load_namespaces/, |
189 | ], |
190 | 'Result/Foo' => [ |
191 | qr/package DBICTest::DumpMore::1::Result::Foo;/, |
192 | qr/->set_primary_key/, |
193 | qr/1;\n$/, |
194 | ], |
195 | 'Result/Bar' => [ |
196 | qr/package DBICTest::DumpMore::1::Result::Bar;/, |
197 | qr/->set_primary_key/, |
198 | qr/1;\n$/, |
199 | ], |
200 | }, |
201 | ); |
202 | |
203 | do_dump_test( |
204 | classname => 'DBICTest::DumpMore::1', |
205 | options => { use_namespaces => 1, |
206 | result_namespace => 'Res', |
207 | resultset_namespace => 'RSet', |
208 | default_resultset_class => 'RSetBase', |
209 | }, |
210 | error => '', |
211 | warnings => [ |
212 | qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, |
213 | qr/Schema dump completed/, |
214 | ], |
215 | regexes => { |
216 | schema => [ |
217 | qr/package DBICTest::DumpMore::1;/, |
218 | qr/->load_namespaces/, |
d16c945b |
219 | qr/result_namespace => "Res"/, |
220 | qr/resultset_namespace => "RSet"/, |
221 | qr/default_resultset_class => "RSetBase"/, |
9a95164d |
222 | ], |
223 | 'Res/Foo' => [ |
224 | qr/package DBICTest::DumpMore::1::Res::Foo;/, |
225 | qr/->set_primary_key/, |
226 | qr/1;\n$/, |
227 | ], |
228 | 'Res/Bar' => [ |
229 | qr/package DBICTest::DumpMore::1::Res::Bar;/, |
230 | qr/->set_primary_key/, |
231 | qr/1;\n$/, |
232 | ], |
233 | }, |
234 | ); |
235 | |
236 | do_dump_test( |
237 | classname => 'DBICTest::DumpMore::1', |
238 | options => { use_namespaces => 1, |
239 | result_namespace => '+DBICTest::DumpMore::1::Res', |
240 | resultset_namespace => 'RSet', |
241 | default_resultset_class => 'RSetBase', |
242 | result_base_class => 'My::ResultBaseClass', |
243 | schema_base_class => 'My::SchemaBaseClass', |
244 | }, |
245 | error => '', |
246 | warnings => [ |
247 | qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, |
248 | qr/Schema dump completed/, |
249 | ], |
250 | regexes => { |
251 | schema => [ |
252 | qr/package DBICTest::DumpMore::1;/, |
253 | qr/->load_namespaces/, |
d16c945b |
254 | qr/result_namespace => "\+DBICTest::DumpMore::1::Res"/, |
255 | qr/resultset_namespace => "RSet"/, |
256 | qr/default_resultset_class => "RSetBase"/, |
9a95164d |
257 | qr/use base 'My::SchemaBaseClass'/, |
258 | ], |
259 | 'Res/Foo' => [ |
260 | qr/package DBICTest::DumpMore::1::Res::Foo;/, |
261 | qr/use base 'My::ResultBaseClass'/, |
262 | qr/->set_primary_key/, |
263 | qr/1;\n$/, |
264 | ], |
265 | 'Res/Bar' => [ |
266 | qr/package DBICTest::DumpMore::1::Res::Bar;/, |
267 | qr/use base 'My::ResultBaseClass'/, |
268 | qr/->set_primary_key/, |
269 | qr/1;\n$/, |
270 | ], |
271 | }, |
272 | ); |
273 | |
818c6a0c |
274 | done_testing; |
275 | |
f22644d7 |
276 | END { rmtree($DUMP_PATH, 1, 1) if $ENV{SCHEMA_LOADER_TESTS_BACKCOMPAT}; } |