Commit | Line | Data |
605fcea8 |
1 | use strict; |
2 | use Test::More; |
3 | use lib qw(t/lib); |
4 | use File::Path; |
ff746964 |
5 | use IPC::Open3; |
605fcea8 |
6 | use make_dbictest_db; |
7 | require DBIx::Class::Schema::Loader; |
8 | |
a4187fdf |
9 | my $DUMP_PATH = './t/_dump'; |
605fcea8 |
10 | |
ff746964 |
11 | sub dump_directly { |
a4187fdf |
12 | my %tdata = @_; |
605fcea8 |
13 | |
a4187fdf |
14 | my $schema_class = $tdata{classname}; |
605fcea8 |
15 | |
16 | no strict 'refs'; |
17 | @{$schema_class . '::ISA'} = ('DBIx::Class::Schema::Loader'); |
ff746964 |
18 | $schema_class->loader_options(%{$tdata{options}}); |
605fcea8 |
19 | |
a4187fdf |
20 | my @warns; |
605fcea8 |
21 | eval { |
a4187fdf |
22 | local $SIG{__WARN__} = sub { push(@warns, @_) }; |
605fcea8 |
23 | $schema_class->connect($make_dbictest_db::dsn); |
24 | }; |
25 | my $err = $@; |
26 | $schema_class->storage->disconnect if !$err && $schema_class->storage; |
27 | undef *{$schema_class}; |
a4187fdf |
28 | |
29 | is($err, $tdata{error}); |
30 | |
ff746964 |
31 | return @warns; |
32 | } |
33 | |
34 | sub dump_dbicdump { |
35 | my %tdata = @_; |
36 | |
17ca645f |
37 | # use $^X so we execute ./script/dbicdump with the same perl binary that the tests were executed with |
38 | my @cmd = ($^X, qw(./script/dbicdump)); |
ff746964 |
39 | |
40 | while (my ($opt, $val) = each(%{ $tdata{options} })) { |
41 | push @cmd, '-o', "$opt=$val"; |
42 | } |
43 | |
44 | push @cmd, $tdata{classname}, $make_dbictest_db::dsn; |
45 | |
17ca645f |
46 | # make sure our current @INC gets used by dbicdump |
281d0f3e |
47 | foreach my $inc ($ENV{PERL5LIB}, reverse @INC) { |
48 | splice @cmd, 1, 0, '-I', $inc; |
49 | } |
17ca645f |
50 | |
ff746964 |
51 | my ($in, $out, $err); |
52 | my $pid = open3($in, $out, $err, @cmd); |
53 | |
54 | my @warns = <$out>; |
55 | waitpid($pid, 0); |
56 | |
57 | return @warns; |
58 | } |
59 | |
60 | sub do_dump_test { |
61 | my %tdata = @_; |
62 | |
63 | $tdata{options}{dump_directory} = $DUMP_PATH; |
f22644d7 |
64 | $tdata{options}{use_namespaces} ||= 0; |
ff746964 |
65 | |
66 | for my $dumper (\&dump_directly, \&dump_dbicdump) { |
67 | test_dumps(\%tdata, $dumper->(%tdata)); |
68 | } |
69 | } |
70 | |
71 | sub test_dumps { |
72 | my ($tdata, @warns) = @_; |
73 | |
74 | my %tdata = %{$tdata}; |
75 | |
76 | my $schema_class = $tdata{classname}; |
a4187fdf |
77 | my $check_warns = $tdata{warnings}; |
ff746964 |
78 | is(@warns, @$check_warns, "$schema_class warning count"); |
a4187fdf |
79 | for(my $i = 0; $i <= $#$check_warns; $i++) { |
ff746964 |
80 | like($warns[$i], $check_warns->[$i], "$schema_class warning $i"); |
a4187fdf |
81 | } |
82 | |
83 | my $file_regexes = $tdata{regexes}; |
84 | my $file_neg_regexes = $tdata{neg_regexes} || {}; |
85 | my $schema_regexes = delete $file_regexes->{schema}; |
86 | |
87 | my $schema_path = $DUMP_PATH . '/' . $schema_class; |
88 | $schema_path =~ s{::}{/}g; |
89 | dump_file_like($schema_path . '.pm', @$schema_regexes); |
90 | foreach my $src (keys %$file_regexes) { |
91 | my $src_file = $schema_path . '/' . $src . '.pm'; |
92 | dump_file_like($src_file, @{$file_regexes->{$src}}); |
93 | } |
94 | foreach my $src (keys %$file_neg_regexes) { |
95 | my $src_file = $schema_path . '/' . $src . '.pm'; |
96 | dump_file_not_like($src_file, @{$file_neg_regexes->{$src}}); |
97 | } |
605fcea8 |
98 | } |
99 | |
a4187fdf |
100 | sub dump_file_like { |
101 | my $path = shift; |
102 | open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!"; |
103 | my $contents = do { local $/; <$dumpfh>; }; |
104 | close($dumpfh); |
ff746964 |
105 | my $num = 1; |
106 | like($contents, $_, "like $path " . $num++) for @_; |
a4187fdf |
107 | } |
605fcea8 |
108 | |
a4187fdf |
109 | sub dump_file_not_like { |
110 | my $path = shift; |
111 | open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!"; |
112 | my $contents = do { local $/; <$dumpfh>; }; |
113 | close($dumpfh); |
ff746964 |
114 | my $num = 1; |
115 | unlike($contents, $_, "unlike $path ". $num++) for @_; |
605fcea8 |
116 | } |
117 | |
a4187fdf |
118 | sub append_to_class { |
119 | my ($class, $string) = @_; |
120 | $class =~ s{::}{/}g; |
121 | $class = $DUMP_PATH . '/' . $class . '.pm'; |
122 | open(my $appendfh, '>>', $class) or die "Failed to open '$class' for append: $!"; |
123 | print $appendfh $string; |
124 | close($appendfh); |
125 | } |
126 | |
127 | rmtree($DUMP_PATH, 1, 1); |
128 | |
129 | do_dump_test( |
130 | classname => 'DBICTest::DumpMore::1', |
131 | options => { }, |
132 | error => '', |
133 | warnings => [ |
134 | qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, |
135 | qr/Schema dump completed/, |
136 | ], |
137 | regexes => { |
138 | schema => [ |
139 | qr/package DBICTest::DumpMore::1;/, |
140 | qr/->load_classes/, |
141 | ], |
142 | Foo => [ |
143 | qr/package DBICTest::DumpMore::1::Foo;/, |
fbcfebdd |
144 | qr/=head1 NAME/, |
145 | qr/=head1 ACCESSORS/, |
a4187fdf |
146 | qr/->set_primary_key/, |
147 | qr/1;\n$/, |
148 | ], |
149 | Bar => [ |
150 | qr/package DBICTest::DumpMore::1::Bar;/, |
fbcfebdd |
151 | qr/=head1 NAME/, |
152 | qr/=head1 ACCESSORS/, |
a4187fdf |
153 | qr/->set_primary_key/, |
154 | qr/1;\n$/, |
155 | ], |
156 | }, |
157 | ); |
158 | |
159 | append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX}); |
160 | |
161 | do_dump_test( |
162 | classname => 'DBICTest::DumpMore::1', |
163 | options => { }, |
164 | error => '', |
165 | warnings => [ |
166 | qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, |
167 | qr/Schema dump completed/, |
168 | ], |
169 | regexes => { |
170 | schema => [ |
171 | qr/package DBICTest::DumpMore::1;/, |
172 | qr/->load_classes/, |
173 | ], |
174 | Foo => [ |
175 | qr/package DBICTest::DumpMore::1::Foo;/, |
176 | qr/->set_primary_key/, |
177 | qr/1;\n# XXX This is my custom content XXX/, |
178 | ], |
179 | Bar => [ |
180 | qr/package DBICTest::DumpMore::1::Bar;/, |
181 | qr/->set_primary_key/, |
182 | qr/1;\n$/, |
183 | ], |
184 | }, |
185 | ); |
605fcea8 |
186 | |
a4187fdf |
187 | do_dump_test( |
188 | classname => 'DBICTest::DumpMore::1', |
28b4691d |
189 | options => { really_erase_my_files => 1 }, |
a4187fdf |
190 | error => '', |
191 | warnings => [ |
192 | qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, |
193 | qr/Deleting existing file /, |
194 | qr/Deleting existing file /, |
195 | qr/Deleting existing file /, |
196 | qr/Schema dump completed/, |
197 | ], |
198 | regexes => { |
199 | schema => [ |
200 | qr/package DBICTest::DumpMore::1;/, |
201 | qr/->load_classes/, |
202 | ], |
203 | Foo => [ |
204 | qr/package DBICTest::DumpMore::1::Foo;/, |
205 | qr/->set_primary_key/, |
206 | qr/1;\n$/, |
207 | ], |
208 | Bar => [ |
209 | qr/package DBICTest::DumpMore::1::Bar;/, |
210 | qr/->set_primary_key/, |
211 | qr/1;\n$/, |
212 | ], |
213 | }, |
214 | neg_regexes => { |
215 | Foo => [ |
216 | qr/# XXX This is my custom content XXX/, |
217 | ], |
492dce8d |
218 | }, |
219 | ); |
220 | |
221 | do_dump_test( |
222 | classname => 'DBICTest::DumpMore::1', |
223 | options => { use_namespaces => 1, generate_pod => 0 }, |
224 | error => '', |
225 | warnings => [ |
226 | qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, |
227 | qr/Schema dump completed/, |
228 | ], |
229 | neg_regexes => { |
230 | 'Result/Foo' => [ |
231 | qr/^=/m, |
232 | ], |
a4187fdf |
233 | }, |
234 | ); |
605fcea8 |
235 | |
f44ecc2f |
236 | do_dump_test( |
237 | classname => 'DBICTest::DumpMore::1', |
238 | options => { use_namespaces => 1 }, |
239 | error => '', |
240 | warnings => [ |
241 | qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, |
242 | qr/Schema dump completed/, |
243 | ], |
244 | regexes => { |
245 | schema => [ |
246 | qr/package DBICTest::DumpMore::1;/, |
247 | qr/->load_namespaces/, |
248 | ], |
249 | 'Result/Foo' => [ |
250 | qr/package DBICTest::DumpMore::1::Result::Foo;/, |
251 | qr/->set_primary_key/, |
252 | qr/1;\n$/, |
253 | ], |
254 | 'Result/Bar' => [ |
255 | qr/package DBICTest::DumpMore::1::Result::Bar;/, |
256 | qr/->set_primary_key/, |
257 | qr/1;\n$/, |
258 | ], |
259 | }, |
260 | ); |
261 | |
262 | do_dump_test( |
263 | classname => 'DBICTest::DumpMore::1', |
264 | options => { use_namespaces => 1, |
265 | result_namespace => 'Res', |
266 | resultset_namespace => 'RSet', |
267 | default_resultset_class => 'RSetBase', |
268 | }, |
269 | error => '', |
270 | warnings => [ |
271 | qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, |
272 | qr/Schema dump completed/, |
273 | ], |
274 | regexes => { |
275 | schema => [ |
276 | qr/package DBICTest::DumpMore::1;/, |
277 | qr/->load_namespaces/, |
278 | qr/result_namespace => 'Res'/, |
279 | qr/resultset_namespace => 'RSet'/, |
280 | qr/default_resultset_class => 'RSetBase'/, |
281 | ], |
282 | 'Res/Foo' => [ |
283 | qr/package DBICTest::DumpMore::1::Res::Foo;/, |
284 | qr/->set_primary_key/, |
285 | qr/1;\n$/, |
286 | ], |
287 | 'Res/Bar' => [ |
288 | qr/package DBICTest::DumpMore::1::Res::Bar;/, |
289 | qr/->set_primary_key/, |
290 | qr/1;\n$/, |
291 | ], |
292 | }, |
293 | ); |
294 | |
295 | do_dump_test( |
296 | classname => 'DBICTest::DumpMore::1', |
297 | options => { use_namespaces => 1, |
298 | result_namespace => '+DBICTest::DumpMore::1::Res', |
299 | resultset_namespace => 'RSet', |
300 | default_resultset_class => 'RSetBase', |
9c9c2f2b |
301 | result_base_class => 'My::ResultBaseClass', |
302 | schema_base_class => 'My::SchemaBaseClass', |
f44ecc2f |
303 | }, |
304 | error => '', |
305 | warnings => [ |
306 | qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, |
307 | qr/Schema dump completed/, |
308 | ], |
309 | regexes => { |
310 | schema => [ |
311 | qr/package DBICTest::DumpMore::1;/, |
312 | qr/->load_namespaces/, |
313 | qr/result_namespace => '\+DBICTest::DumpMore::1::Res'/, |
314 | qr/resultset_namespace => 'RSet'/, |
315 | qr/default_resultset_class => 'RSetBase'/, |
9c9c2f2b |
316 | qr/use base 'My::SchemaBaseClass'/, |
f44ecc2f |
317 | ], |
318 | 'Res/Foo' => [ |
319 | qr/package DBICTest::DumpMore::1::Res::Foo;/, |
9c9c2f2b |
320 | qr/use base 'My::ResultBaseClass'/, |
f44ecc2f |
321 | qr/->set_primary_key/, |
322 | qr/1;\n$/, |
323 | ], |
324 | 'Res/Bar' => [ |
325 | qr/package DBICTest::DumpMore::1::Res::Bar;/, |
9c9c2f2b |
326 | qr/use base 'My::ResultBaseClass'/, |
f44ecc2f |
327 | qr/->set_primary_key/, |
328 | qr/1;\n$/, |
329 | ], |
330 | }, |
331 | ); |
332 | |
d27f2b7b |
333 | done_testing; |
334 | |
a4187fdf |
335 | END { rmtree($DUMP_PATH, 1, 1); } |