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