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