validate class/component loader options
[dbsrgits/DBIx-Class-Schema-Loader.git] / t / 23dumpmore.t
CommitLineData
605fcea8 1use strict;
2use Test::More;
3use lib qw(t/lib);
4use File::Path;
ff746964 5use IPC::Open3;
605fcea8 6use make_dbictest_db;
7require DBIx::Class::Schema::Loader;
8
a4187fdf 9my $DUMP_PATH = './t/_dump';
605fcea8 10
ff746964 11sub 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
34sub 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
f1059ad4 47 use Config;
48 local $ENV{PERL5LIB} = join $Config{path_sep}, @INC, $ENV{PERL5LIB};
17ca645f 49
ff746964 50 my ($in, $out, $err);
51 my $pid = open3($in, $out, $err, @cmd);
52
53 my @warns = <$out>;
54 waitpid($pid, 0);
55
56 return @warns;
57}
58
59sub do_dump_test {
60 my %tdata = @_;
61
62 $tdata{options}{dump_directory} = $DUMP_PATH;
f22644d7 63 $tdata{options}{use_namespaces} ||= 0;
ff746964 64
65 for my $dumper (\&dump_directly, \&dump_dbicdump) {
66 test_dumps(\%tdata, $dumper->(%tdata));
67 }
68}
69
70sub test_dumps {
71 my ($tdata, @warns) = @_;
72
73 my %tdata = %{$tdata};
74
75 my $schema_class = $tdata{classname};
a4187fdf 76 my $check_warns = $tdata{warnings};
ff746964 77 is(@warns, @$check_warns, "$schema_class warning count");
a4187fdf 78 for(my $i = 0; $i <= $#$check_warns; $i++) {
ff746964 79 like($warns[$i], $check_warns->[$i], "$schema_class warning $i");
a4187fdf 80 }
81
82 my $file_regexes = $tdata{regexes};
83 my $file_neg_regexes = $tdata{neg_regexes} || {};
84 my $schema_regexes = delete $file_regexes->{schema};
85
86 my $schema_path = $DUMP_PATH . '/' . $schema_class;
87 $schema_path =~ s{::}{/}g;
88 dump_file_like($schema_path . '.pm', @$schema_regexes);
89 foreach my $src (keys %$file_regexes) {
90 my $src_file = $schema_path . '/' . $src . '.pm';
91 dump_file_like($src_file, @{$file_regexes->{$src}});
92 }
93 foreach my $src (keys %$file_neg_regexes) {
94 my $src_file = $schema_path . '/' . $src . '.pm';
95 dump_file_not_like($src_file, @{$file_neg_regexes->{$src}});
96 }
605fcea8 97}
98
a4187fdf 99sub dump_file_like {
100 my $path = shift;
101 open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
102 my $contents = do { local $/; <$dumpfh>; };
103 close($dumpfh);
ff746964 104 my $num = 1;
105 like($contents, $_, "like $path " . $num++) for @_;
a4187fdf 106}
605fcea8 107
a4187fdf 108sub dump_file_not_like {
109 my $path = shift;
110 open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
111 my $contents = do { local $/; <$dumpfh>; };
112 close($dumpfh);
ff746964 113 my $num = 1;
114 unlike($contents, $_, "unlike $path ". $num++) for @_;
605fcea8 115}
116
a4187fdf 117sub append_to_class {
118 my ($class, $string) = @_;
119 $class =~ s{::}{/}g;
120 $class = $DUMP_PATH . '/' . $class . '.pm';
121 open(my $appendfh, '>>', $class) or die "Failed to open '$class' for append: $!";
122 print $appendfh $string;
123 close($appendfh);
124}
125
126rmtree($DUMP_PATH, 1, 1);
127
6dde4613 128# test loading external content
129do_dump_test(
130 classname => 'DBICTest::Schema::13',
131 options => { },
132 error => '',
133 warnings => [
134 qr/Dumping manual schema for DBICTest::Schema::13 to directory /,
135 qr/Schema dump completed/,
136 ],
137 regexes => {
138 Foo => [
139qr/package DBICTest::Schema::13::Foo;\nour \$skip_me = "bad mojo";\n1;/
140 ],
141 },
142);
143
144# test skipping external content
145do_dump_test(
146 classname => 'DBICTest::Schema::14',
147 options => { skip_load_external => 1 },
148 error => '',
149 warnings => [
150 qr/Dumping manual schema for DBICTest::Schema::14 to directory /,
151 qr/Schema dump completed/,
152 ],
153 neg_regexes => {
154 Foo => [
155qr/package DBICTest::Schema::14::Foo;\nour \$skip_me = "bad mojo";\n1;/
156 ],
157 },
158);
159
160rmtree($DUMP_PATH, 1, 1);
161
9de8c789 162# test out the POD
163
a4187fdf 164do_dump_test(
165 classname => 'DBICTest::DumpMore::1',
166 options => { },
167 error => '',
168 warnings => [
169 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
170 qr/Schema dump completed/,
171 ],
172 regexes => {
173 schema => [
174 qr/package DBICTest::DumpMore::1;/,
175 qr/->load_classes/,
176 ],
177 Foo => [
9de8c789 178qr/package DBICTest::DumpMore::1::Foo;/,
179qr/=head1 NAME\n\nDBICTest::DumpMore::1::Foo\n\n=cut\n\n/,
180qr/=head1 ACCESSORS\n\n/,
181qr/=head2 fooid\n\n data_type: INTEGER\n default_value: undef\n is_nullable: 1\n size: undef\n\n/,
182qr/=head2 footext\n\n data_type: TEXT\n default_value: undef\n is_nullable: 1\n size: undef\n\n/,
183qr/->set_primary_key/,
184qr/=head1 RELATIONS\n\n/,
185qr/=head2 bars\n\nType: has_many\n\nRelated object: L<DBICTest::DumpMore::1::Bar>\n\n=cut\n\n/,
186qr/1;\n$/,
a4187fdf 187 ],
188 Bar => [
9de8c789 189qr/package DBICTest::DumpMore::1::Bar;/,
190qr/=head1 NAME\n\nDBICTest::DumpMore::1::Bar\n\n=cut\n\n/,
191qr/=head1 ACCESSORS\n\n/,
192qr/=head2 barid\n\n data_type: INTEGER\n default_value: undef\n is_nullable: 1\n size: undef\n\n/,
193qr/=head2 fooref\n\n data_type: INTEGER\n default_value: undef\n is_foreign_key: 1\n is_nullable: 1\n size: undef\n\n/,
194qr/->set_primary_key/,
195qr/=head1 RELATIONS\n\n/,
196qr/=head2 fooref\n\nType: belongs_to\n\nRelated object: L<DBICTest::DumpMore::1::Foo>\n\n=cut\n\n/,
197qr/1;\n$/,
a4187fdf 198 ],
199 },
200);
201
202append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX});
203
204do_dump_test(
205 classname => 'DBICTest::DumpMore::1',
206 options => { },
207 error => '',
208 warnings => [
209 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
210 qr/Schema dump completed/,
211 ],
212 regexes => {
213 schema => [
214 qr/package DBICTest::DumpMore::1;/,
215 qr/->load_classes/,
216 ],
217 Foo => [
218 qr/package DBICTest::DumpMore::1::Foo;/,
219 qr/->set_primary_key/,
220 qr/1;\n# XXX This is my custom content XXX/,
221 ],
222 Bar => [
223 qr/package DBICTest::DumpMore::1::Bar;/,
224 qr/->set_primary_key/,
225 qr/1;\n$/,
226 ],
227 },
228);
605fcea8 229
a4187fdf 230do_dump_test(
231 classname => 'DBICTest::DumpMore::1',
28b4691d 232 options => { really_erase_my_files => 1 },
a4187fdf 233 error => '',
234 warnings => [
235 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
236 qr/Deleting existing file /,
237 qr/Deleting existing file /,
238 qr/Deleting existing file /,
239 qr/Schema dump completed/,
240 ],
241 regexes => {
242 schema => [
243 qr/package DBICTest::DumpMore::1;/,
244 qr/->load_classes/,
245 ],
246 Foo => [
247 qr/package DBICTest::DumpMore::1::Foo;/,
248 qr/->set_primary_key/,
249 qr/1;\n$/,
250 ],
251 Bar => [
252 qr/package DBICTest::DumpMore::1::Bar;/,
253 qr/->set_primary_key/,
254 qr/1;\n$/,
255 ],
256 },
257 neg_regexes => {
258 Foo => [
259 qr/# XXX This is my custom content XXX/,
260 ],
492dce8d 261 },
262);
263
264do_dump_test(
265 classname => 'DBICTest::DumpMore::1',
266 options => { use_namespaces => 1, generate_pod => 0 },
267 error => '',
268 warnings => [
269 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
270 qr/Schema dump completed/,
271 ],
272 neg_regexes => {
273 'Result/Foo' => [
274 qr/^=/m,
275 ],
a4187fdf 276 },
277);
605fcea8 278
f44ecc2f 279do_dump_test(
280 classname => 'DBICTest::DumpMore::1',
281 options => { use_namespaces => 1 },
282 error => '',
283 warnings => [
284 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
285 qr/Schema dump completed/,
286 ],
287 regexes => {
288 schema => [
289 qr/package DBICTest::DumpMore::1;/,
290 qr/->load_namespaces/,
291 ],
292 'Result/Foo' => [
293 qr/package DBICTest::DumpMore::1::Result::Foo;/,
294 qr/->set_primary_key/,
295 qr/1;\n$/,
296 ],
297 'Result/Bar' => [
298 qr/package DBICTest::DumpMore::1::Result::Bar;/,
299 qr/->set_primary_key/,
300 qr/1;\n$/,
301 ],
302 },
303);
304
305do_dump_test(
306 classname => 'DBICTest::DumpMore::1',
307 options => { use_namespaces => 1,
308 result_namespace => 'Res',
309 resultset_namespace => 'RSet',
310 default_resultset_class => 'RSetBase',
311 },
312 error => '',
313 warnings => [
314 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
315 qr/Schema dump completed/,
316 ],
317 regexes => {
318 schema => [
319 qr/package DBICTest::DumpMore::1;/,
320 qr/->load_namespaces/,
321 qr/result_namespace => 'Res'/,
322 qr/resultset_namespace => 'RSet'/,
323 qr/default_resultset_class => 'RSetBase'/,
324 ],
325 'Res/Foo' => [
326 qr/package DBICTest::DumpMore::1::Res::Foo;/,
327 qr/->set_primary_key/,
328 qr/1;\n$/,
329 ],
330 'Res/Bar' => [
331 qr/package DBICTest::DumpMore::1::Res::Bar;/,
332 qr/->set_primary_key/,
333 qr/1;\n$/,
334 ],
335 },
336);
337
338do_dump_test(
339 classname => 'DBICTest::DumpMore::1',
340 options => { use_namespaces => 1,
341 result_namespace => '+DBICTest::DumpMore::1::Res',
342 resultset_namespace => 'RSet',
343 default_resultset_class => 'RSetBase',
9c9c2f2b 344 result_base_class => 'My::ResultBaseClass',
345 schema_base_class => 'My::SchemaBaseClass',
f44ecc2f 346 },
347 error => '',
348 warnings => [
349 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
350 qr/Schema dump completed/,
351 ],
352 regexes => {
353 schema => [
354 qr/package DBICTest::DumpMore::1;/,
355 qr/->load_namespaces/,
356 qr/result_namespace => '\+DBICTest::DumpMore::1::Res'/,
357 qr/resultset_namespace => 'RSet'/,
358 qr/default_resultset_class => 'RSetBase'/,
9c9c2f2b 359 qr/use base 'My::SchemaBaseClass'/,
f44ecc2f 360 ],
361 'Res/Foo' => [
362 qr/package DBICTest::DumpMore::1::Res::Foo;/,
9c9c2f2b 363 qr/use base 'My::ResultBaseClass'/,
f44ecc2f 364 qr/->set_primary_key/,
365 qr/1;\n$/,
366 ],
367 'Res/Bar' => [
368 qr/package DBICTest::DumpMore::1::Res::Bar;/,
9c9c2f2b 369 qr/use base 'My::ResultBaseClass'/,
f44ecc2f 370 qr/->set_primary_key/,
371 qr/1;\n$/,
372 ],
373 },
374);
c634fde9 375eval {
376 do_dump_test(
377 classname => 'DBICTest::DumpMore::1',
378 options => {
379 use_namespaces => 1,
380 result_base_class => 'My::MissingResultBaseClass',
381 },
382 );
383};
384ok($@, "exception thrown on bad result_base_class");
385like($@, qr/My::MissingResultBaseClass.*is not installed/, "user-friend error message on missing result_base_class" );
386
f44ecc2f 387
d27f2b7b 388done_testing;
389
9de8c789 390END { rmtree($DUMP_PATH, 1, 1) unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP} }