7 require DBIx::Class::Schema::Loader;
9 my $DUMP_PATH = './t/_dump';
14 my $schema_class = $tdata{classname};
17 @{$schema_class . '::ISA'} = ('DBIx::Class::Schema::Loader');
18 $schema_class->loader_options(%{$tdata{options}});
22 local $SIG{__WARN__} = sub { push(@warns, @_) };
23 $schema_class->connect($make_dbictest_db::dsn);
26 $schema_class->storage->disconnect if !$err && $schema_class->storage;
27 undef *{$schema_class};
29 check_error($err, $tdata{error});
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));
40 while (my ($opt, $val) = each(%{ $tdata{options} })) {
41 push @cmd, '-o', "$opt=$val";
44 push @cmd, $tdata{classname}, $make_dbictest_db::dsn;
46 # make sure our current @INC gets used by dbicdump
48 local $ENV{PERL5LIB} = join $Config{path_sep}, @INC, ($ENV{PERL5LIB} || '');
51 my $pid = open3($in, $out, $err, @cmd);
60 check_error($error, $tdata{error});
70 my ($got, $expected) = @_;
72 return unless $got && $expected;
74 if (ref $expected eq 'Regexp') {
75 like $got, $expected, 'error matches expected pattern';
79 is $got, $expected, 'error matches';
85 $tdata{options}{dump_directory} = $DUMP_PATH;
86 $tdata{options}{use_namespaces} ||= 0;
88 for my $dumper (\&dump_directly, \&dump_dbicdump) {
89 test_dumps(\%tdata, $dumper->(%tdata));
94 my ($tdata, @warns) = @_;
96 my %tdata = %{$tdata};
98 my $schema_class = $tdata{classname};
99 my $check_warns = $tdata{warnings};
100 is(@warns, @$check_warns, "$schema_class warning count");
102 for(my $i = 0; $i <= $#$check_warns; $i++) {
103 like($warns[$i], $check_warns->[$i], "$schema_class warning $i");
106 my $file_regexes = $tdata{regexes};
107 my $file_neg_regexes = $tdata{neg_regexes} || {};
108 my $schema_regexes = delete $file_regexes->{schema};
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}});
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}});
125 open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
126 my $contents = do { local $/; <$dumpfh>; };
129 like($contents, $_, "like $path " . $num++) for @_;
132 sub dump_file_not_like {
134 open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
135 my $contents = do { local $/; <$dumpfh>; };
138 unlike($contents, $_, "unlike $path ". $num++) for @_;
141 sub append_to_class {
142 my ($class, $string) = @_;
144 $class = $DUMP_PATH . '/' . $class . '.pm';
145 open(my $appendfh, '>>', $class) or die "Failed to open '$class' for append: $!";
146 print $appendfh $string;
150 rmtree($DUMP_PATH, 1, 1);
152 # test loading external content
154 classname => 'DBICTest::Schema::13',
158 qr/Dumping manual schema for DBICTest::Schema::13 to directory /,
159 qr/Schema dump completed/,
163 qr/package DBICTest::Schema::13::Foo;\nour \$skip_me = "bad mojo";\n1;/
168 # test skipping external content
170 classname => 'DBICTest::Schema::14',
171 options => { skip_load_external => 1 },
174 qr/Dumping manual schema for DBICTest::Schema::14 to directory /,
175 qr/Schema dump completed/,
179 qr/package DBICTest::Schema::14::Foo;\nour \$skip_me = "bad mojo";\n1;/
184 rmtree($DUMP_PATH, 1, 1);
189 classname => 'DBICTest::DumpMore::1',
193 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
194 qr/Schema dump completed/,
198 qr/package DBICTest::DumpMore::1;/,
202 qr/package DBICTest::DumpMore::1::Foo;/,
203 qr/=head1 NAME\n\nDBICTest::DumpMore::1::Foo\n\n=cut\n\n/,
204 qr/=head1 ACCESSORS\n\n/,
205 qr/=head2 fooid\n\n data_type: INTEGER\n default_value: undef\n is_nullable: 1\n size: undef\n\n/,
206 qr/=head2 footext\n\n data_type: TEXT\n default_value: undef\n is_nullable: 1\n size: undef\n\n/,
207 qr/->set_primary_key/,
208 qr/=head1 RELATIONS\n\n/,
209 qr/=head2 bars\n\nType: has_many\n\nRelated object: L<DBICTest::DumpMore::1::Bar>\n\n=cut\n\n/,
213 qr/package DBICTest::DumpMore::1::Bar;/,
214 qr/=head1 NAME\n\nDBICTest::DumpMore::1::Bar\n\n=cut\n\n/,
215 qr/=head1 ACCESSORS\n\n/,
216 qr/=head2 barid\n\n data_type: INTEGER\n default_value: undef\n is_nullable: 1\n size: undef\n\n/,
217 qr/=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/,
218 qr/->set_primary_key/,
219 qr/=head1 RELATIONS\n\n/,
220 qr/=head2 fooref\n\nType: belongs_to\n\nRelated object: L<DBICTest::DumpMore::1::Foo>\n\n=cut\n\n/,
226 append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX});
229 classname => 'DBICTest::DumpMore::1',
233 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
234 qr/Schema dump completed/,
238 qr/package DBICTest::DumpMore::1;/,
242 qr/package DBICTest::DumpMore::1::Foo;/,
243 qr/->set_primary_key/,
244 qr/1;\n# XXX This is my custom content XXX/,
247 qr/package DBICTest::DumpMore::1::Bar;/,
248 qr/->set_primary_key/,
255 classname => 'DBICTest::DumpMore::1',
256 options => { really_erase_my_files => 1 },
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/,
267 qr/package DBICTest::DumpMore::1;/,
271 qr/package DBICTest::DumpMore::1::Foo;/,
272 qr/->set_primary_key/,
276 qr/package DBICTest::DumpMore::1::Bar;/,
277 qr/->set_primary_key/,
283 qr/# XXX This is my custom content XXX/,
289 classname => 'DBICTest::DumpMore::1',
290 options => { use_namespaces => 1, generate_pod => 0 },
293 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
294 qr/Schema dump completed/,
304 classname => 'DBICTest::DumpMore::1',
305 options => { use_namespaces => 1 },
308 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
309 qr/Schema dump completed/,
313 qr/package DBICTest::DumpMore::1;/,
314 qr/->load_namespaces/,
317 qr/package DBICTest::DumpMore::1::Result::Foo;/,
318 qr/->set_primary_key/,
322 qr/package DBICTest::DumpMore::1::Result::Bar;/,
323 qr/->set_primary_key/,
330 classname => 'DBICTest::DumpMore::1',
331 options => { use_namespaces => 1,
332 result_namespace => 'Res',
333 resultset_namespace => 'RSet',
334 default_resultset_class => 'RSetBase',
338 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
339 qr/Schema dump completed/,
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'/,
350 qr/package DBICTest::DumpMore::1::Res::Foo;/,
351 qr/->set_primary_key/,
355 qr/package DBICTest::DumpMore::1::Res::Bar;/,
356 qr/->set_primary_key/,
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',
368 result_base_class => 'My::ResultBaseClass',
369 schema_base_class => 'My::SchemaBaseClass',
373 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
374 qr/Schema dump completed/,
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'/,
383 qr/use base 'My::SchemaBaseClass'/,
386 qr/package DBICTest::DumpMore::1::Res::Foo;/,
387 qr/use base 'My::ResultBaseClass'/,
388 qr/->set_primary_key/,
392 qr/package DBICTest::DumpMore::1::Res::Bar;/,
393 qr/use base 'My::ResultBaseClass'/,
394 qr/->set_primary_key/,
401 classname => 'DBICTest::DumpMore::1',
404 result_base_class => 'My::MissingResultBaseClass',
406 error => qr/My::MissingResultBaseClass.*is not installed/,
411 END { rmtree($DUMP_PATH, 1, 1) unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP} }