5 use DBIx::Class::Schema::Loader::Utils 'dumper_squashed';
6 use DBIx::Class::Schema::Loader ();
7 use DBIx::Class::Schema::Loader::Optional::Dependencies ();
8 use File::Temp 'tempfile';
11 my $DUMP_PATH = './t/_dump';
13 my $TEST_DB_CLASS = 'make_dbictest_db';
18 my $schema_class = $tdata{classname};
21 @{$schema_class . '::ISA'} = ('DBIx::Class::Schema::Loader');
22 $schema_class->loader_options(%{$tdata{options}});
26 local $SIG{__WARN__} = sub { push(@warns, @_) };
27 $schema_class->connect(get_dsn(\%tdata));
30 $schema_class->storage->disconnect if !$err && $schema_class->storage;
31 undef *{$schema_class};
33 check_error($err, $tdata{error});
41 # use $^X so we execute ./script/dbicdump with the same perl binary that the tests were executed with
42 my @cmd = ($^X, qw(./script/dbicdump));
44 while (my ($opt, $val) = each(%{ $tdata{options} })) {
45 $val = dumper_squashed $val if ref $val;
46 push @cmd, '-o', "$opt=$val";
49 push @cmd, $tdata{classname}, get_dsn(\%tdata);
51 # make sure our current @INC gets used by dbicdump
53 local $ENV{PERL5LIB} = join $Config{path_sep}, @INC, ($ENV{PERL5LIB} || '');
56 my $pid = open3($in, $out, $err, @cmd);
65 check_error($error, $tdata{error});
77 my $test_db_class = $opts->{test_db_class} || $TEST_DB_CLASS;
79 eval "require $test_db_class;";
84 ${$test_db_class . '::dsn'};
91 my ($got, $expected) = @_;
96 fail "Unexpected error in " . ((caller(1))[3]) . ": $got";
100 if (ref $expected eq 'Regexp') {
101 like $got, $expected, 'error matches expected pattern';
105 is $got, $expected, 'error matches';
111 $tdata{options}{dump_directory} = $DUMP_PATH;
112 $tdata{options}{use_namespaces} ||= 0;
114 for my $dumper (\&dump_directly, \&dump_dbicdump) {
115 test_dumps(\%tdata, $dumper->(%tdata));
120 my ($tdata, @warns) = @_;
122 my %tdata = %{$tdata};
124 my $schema_class = $tdata{classname};
125 my $check_warns = $tdata{warnings};
126 is(@warns, @$check_warns, "$schema_class warning count");
128 for(my $i = 0; $i <= $#$check_warns; $i++) {
129 like($warns[$i], $check_warns->[$i], "$schema_class warning $i");
132 my $file_regexes = $tdata{regexes};
133 my $file_neg_regexes = $tdata{neg_regexes} || {};
134 my $schema_regexes = delete $file_regexes->{schema};
136 my $schema_path = $DUMP_PATH . '/' . $schema_class;
137 $schema_path =~ s{::}{/}g;
139 dump_file_like($schema_path . '.pm', @$schema_regexes) if $schema_regexes;
141 foreach my $src (keys %$file_regexes) {
142 my $src_file = $schema_path . '/' . $src . '.pm';
143 dump_file_like($src_file, @{$file_regexes->{$src}});
145 foreach my $src (keys %$file_neg_regexes) {
146 my $src_file = $schema_path . '/' . $src . '.pm';
147 dump_file_not_like($src_file, @{$file_neg_regexes->{$src}});
153 open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
154 my $contents = do { local $/; <$dumpfh>; };
156 like($contents, $_, "$path matches $_") for @_;
159 sub dump_file_not_like {
161 open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
162 my $contents = do { local $/; <$dumpfh>; };
164 unlike($contents, $_, "$path does not match $_") for @_;
167 sub append_to_class {
168 my ($class, $string) = @_;
170 $class = $DUMP_PATH . '/' . $class . '.pm';
171 open(my $appendfh, '>>', $class) or die "Failed to open '$class' for append: $!";
172 print $appendfh $string;
176 rmtree($DUMP_PATH, 1, 1);
178 # test loading external content
180 classname => 'DBICTest::Schema::_no_skip_load_external',
182 qr/Dumping manual schema for DBICTest::Schema::_no_skip_load_external to directory /,
183 qr/Schema dump completed/,
187 qr/package DBICTest::Schema::_no_skip_load_external::Foo;\nour \$skip_me = "bad mojo";\n1;/
192 # test skipping external content
194 classname => 'DBICTest::Schema::_skip_load_external',
195 options => { skip_load_external => 1 },
197 qr/Dumping manual schema for DBICTest::Schema::_skip_load_external to directory /,
198 qr/Schema dump completed/,
202 qr/package DBICTest::Schema::_skip_load_external::Foo;\nour \$skip_me = "bad mojo";\n1;/
207 rmtree($DUMP_PATH, 1, 1);
211 my ($fh, $config_file) = tempfile;
214 { skip_relationships => 1 }
219 classname => 'DBICTest::Schema::_skip_load_external',
220 options => { config_file => $config_file },
222 qr/Dumping manual schema for DBICTest::Schema::_skip_load_external to directory /,
223 qr/Schema dump completed/,
234 rmtree($DUMP_PATH, 1, 1);
236 if (DBIx::Class::Schema::Loader::Optional::Dependencies->req_ok_for('use_moose')) {
238 # first dump a fresh use_moose=1 schema
241 classname => 'DBICTest::DumpMore::1',
244 result_base_class => 'My::ResultBaseClass',
245 schema_base_class => 'My::SchemaBaseClass',
248 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
249 qr/Schema dump completed/,
253 qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::SchemaBaseClass';\n\n/,
254 qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
257 qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::ResultBaseClass';\n\n/,
258 qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
261 qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::ResultBaseClass';\n\n/,
262 qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
267 # now upgrade a non-moose schema to use_moose=1
269 rmtree($DUMP_PATH, 1, 1);
272 classname => 'DBICTest::DumpMore::1',
274 result_base_class => 'My::ResultBaseClass',
275 schema_base_class => 'My::SchemaBaseClass',
278 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
279 qr/Schema dump completed/,
283 qr/\nuse base 'My::SchemaBaseClass';\n/,
286 qr/\nuse base 'My::ResultBaseClass';\n/,
289 qr/\nuse base 'My::ResultBaseClass';\n/,
294 # check that changed custom content is upgraded for Moose bits
295 append_to_class('DBICTest::DumpMore::1::Foo', q{# XXX This is my custom content XXX});
298 classname => 'DBICTest::DumpMore::1',
301 result_base_class => 'My::ResultBaseClass',
302 schema_base_class => 'My::SchemaBaseClass',
305 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
306 qr/Schema dump completed/,
310 qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::SchemaBaseClass';\n\n/,
311 qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
314 qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::ResultBaseClass';\n\n/,
315 qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
318 qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::ResultBaseClass';\n\n/,
319 qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
324 # now add the Moose custom content to unapgraded schema, and make sure it is not repeated
326 rmtree($DUMP_PATH, 1, 1);
329 classname => 'DBICTest::DumpMore::1',
331 result_base_class => 'My::ResultBaseClass',
332 schema_base_class => 'My::SchemaBaseClass',
335 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
336 qr/Schema dump completed/,
340 qr/\nuse base 'My::SchemaBaseClass';\n/,
343 qr/\nuse base 'My::ResultBaseClass';\n/,
346 qr/\nuse base 'My::ResultBaseClass';\n/,
351 # add Moose custom content then check it is not repeated
353 append_to_class('DBICTest::DumpMore::1::Foo', qq{__PACKAGE__->meta->make_immutable;\n1;\n});
356 classname => 'DBICTest::DumpMore::1',
359 result_base_class => 'My::ResultBaseClass',
360 schema_base_class => 'My::SchemaBaseClass',
363 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
364 qr/Schema dump completed/,
368 qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::SchemaBaseClass';\n\n/,
369 qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
372 qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::ResultBaseClass';\n\n/,
373 qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
376 qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::ResultBaseClass';\n\n/,
377 qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
382 qr/\n__PACKAGE__->meta->make_immutable;\n.*\n__PACKAGE__->meta->make_immutable;/s,
390 SKIP: { skip 'use_moose=1 deps not installed', 1 };
393 rmtree($DUMP_PATH, 1, 1);
396 classname => 'DBICTest::Schema::_skip_load_external',
397 test_db_class => 'make_dbictest_db_clashing_monikers',
398 error => qr/tables 'bar', 'bars' reduced to the same source moniker 'Bar'/,
401 rmtree($DUMP_PATH, 1, 1);
406 classname => 'DBICTest::DumpMore::1',
408 custom_column_info => sub {
409 my ($table, $col, $info) = @_;
410 return +{ extra => { is_footext => 1 } } if $col eq 'footext';
414 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
415 qr/Schema dump completed/,
419 qr/package DBICTest::DumpMore::1;/,
423 qr/package DBICTest::DumpMore::1::Foo;/,
424 qr/=head1 NAME\n\nDBICTest::DumpMore::1::Foo\n\n=cut\n\n/,
425 qr/=head1 ACCESSORS\n\n/,
426 qr/=head2 fooid\n\n data_type: 'integer'\n is_auto_increment: 1\n is_nullable: 0\n\n/,
427 qr/=head2 footext\n\n data_type: 'text'\n default_value: 'footext'\n extra: {is_footext => 1}\n is_nullable: 1\n\n/,
428 qr/->set_primary_key/,
429 qr/=head1 RELATIONS\n\n/,
430 qr/=head2 bars\n\nType: has_many\n\nRelated object: L<DBICTest::DumpMore::1::Bar>\n\n=cut\n\n/,
434 qr/package DBICTest::DumpMore::1::Bar;/,
435 qr/=head1 NAME\n\nDBICTest::DumpMore::1::Bar\n\n=cut\n\n/,
436 qr/=head1 ACCESSORS\n\n/,
437 qr/=head2 barid\n\n data_type: 'integer'\n is_auto_increment: 1\n is_nullable: 0\n\n/,
438 qr/=head2 fooref\n\n data_type: 'integer'\n is_foreign_key: 1\n is_nullable: 1\n\n/,
439 qr/->set_primary_key/,
440 qr/=head1 RELATIONS\n\n/,
441 qr/=head2 fooref\n\nType: belongs_to\n\nRelated object: L<DBICTest::DumpMore::1::Foo>\n\n=cut\n\n/,
447 append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX});
450 classname => 'DBICTest::DumpMore::1',
452 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
453 qr/Schema dump completed/,
457 qr/package DBICTest::DumpMore::1;/,
461 qr/package DBICTest::DumpMore::1::Foo;/,
462 qr/->set_primary_key/,
463 qr/1;\n# XXX This is my custom content XXX/,
466 qr/package DBICTest::DumpMore::1::Bar;/,
467 qr/->set_primary_key/,
474 classname => 'DBICTest::DumpMore::1',
475 options => { really_erase_my_files => 1 },
477 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
478 qr/Deleting existing file /,
479 qr/Deleting existing file /,
480 qr/Deleting existing file /,
481 qr/Schema dump completed/,
485 qr/package DBICTest::DumpMore::1;/,
489 qr/package DBICTest::DumpMore::1::Foo;/,
490 qr/->set_primary_key/,
494 qr/package DBICTest::DumpMore::1::Bar;/,
495 qr/->set_primary_key/,
501 qr/# XXX This is my custom content XXX/,
506 rmtree($DUMP_PATH, 1, 1);
509 classname => 'DBICTest::DumpMore::1',
510 options => { use_namespaces => 1, generate_pod => 0 },
512 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
513 qr/Schema dump completed/,
522 rmtree($DUMP_PATH, 1, 1);
525 classname => 'DBICTest::DumpMore::1',
526 options => { db_schema => 'foo_schema', qualify_objects => 1, use_namespaces => 1 },
528 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
529 qr/Schema dump completed/,
533 qr/^\Q__PACKAGE__->table("foo_schema.foo");\E/m,
534 # the has_many relname should not have the schema in it!
535 qr/^__PACKAGE__->has_many\(\n "bars"/m,
540 rmtree($DUMP_PATH, 1, 1);
543 classname => 'DBICTest::DumpMore::1',
544 options => { use_namespaces => 1 },
546 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
547 qr/Schema dump completed/,
551 qr/package DBICTest::DumpMore::1;/,
552 qr/->load_namespaces/,
555 qr/package DBICTest::DumpMore::1::Result::Foo;/,
556 qr/->set_primary_key/,
560 qr/package DBICTest::DumpMore::1::Result::Bar;/,
561 qr/->set_primary_key/,
567 rmtree($DUMP_PATH, 1, 1);
570 classname => 'DBICTest::DumpMore::1',
571 options => { use_namespaces => 1,
572 result_namespace => 'Res',
573 resultset_namespace => 'RSet',
574 default_resultset_class => 'RSetBase',
577 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
578 qr/Schema dump completed/,
582 qr/package DBICTest::DumpMore::1;/,
583 qr/->load_namespaces/,
584 qr/result_namespace => 'Res'/,
585 qr/resultset_namespace => 'RSet'/,
586 qr/default_resultset_class => 'RSetBase'/,
589 qr/package DBICTest::DumpMore::1::Res::Foo;/,
590 qr/->set_primary_key/,
594 qr/package DBICTest::DumpMore::1::Res::Bar;/,
595 qr/->set_primary_key/,
601 rmtree($DUMP_PATH, 1, 1);
604 classname => 'DBICTest::DumpMore::1',
605 options => { use_namespaces => 1,
606 result_namespace => '+DBICTest::DumpMore::1::Res',
607 resultset_namespace => 'RSet',
608 default_resultset_class => 'RSetBase',
609 result_base_class => 'My::ResultBaseClass',
610 schema_base_class => 'My::SchemaBaseClass',
613 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
614 qr/Schema dump completed/,
618 qr/package DBICTest::DumpMore::1;/,
619 qr/->load_namespaces/,
620 qr/result_namespace => '\+DBICTest::DumpMore::1::Res'/,
621 qr/resultset_namespace => 'RSet'/,
622 qr/default_resultset_class => 'RSetBase'/,
623 qr/use base 'My::SchemaBaseClass'/,
626 qr/package DBICTest::DumpMore::1::Res::Foo;/,
627 qr/use base 'My::ResultBaseClass'/,
628 qr/->set_primary_key/,
632 qr/package DBICTest::DumpMore::1::Res::Bar;/,
633 qr/use base 'My::ResultBaseClass'/,
634 qr/->set_primary_key/,
640 rmtree($DUMP_PATH, 1, 1);
643 classname => 'DBICTest::DumpMore::1',
646 result_base_class => 'My::MissingResultBaseClass',
648 error => qr/My::MissingResultBaseClass.*is not installed/,
653 END { rmtree($DUMP_PATH, 1, 1) unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP} }
654 # vim:et sts=4 sw=4 tw=0: