1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
use strict;
use warnings;
use DBIx::Class::Schema::Loader;
use DBIx::Class::Schema::Loader::Utils 'slurp_file';
use File::Path;
use Test::More tests => 19;
use Test::Exception;
use lib qw(t/lib);
use make_dbictest_db;
use dbixcsl_test_dir qw/$tdir/;
my $dump_path = "$tdir/dump";
my %original_class_data;
my ($schema_file_count, $result_file_count);
{
package DBICTest::Schema::1;
use Test::More;
use base 'DBIx::Class::Schema::Loader';
__PACKAGE__->loader_options(
dump_directory => $dump_path,
quiet => 1,
filter_generated_code => sub {
my ($type, $class, $text) = @_;
like $type, qr/^(?:schema|result)\z/,
'got correct file type';
if ($type eq 'schema') {
$schema_file_count++;
is $class, 'DBICTest::Schema::1',
'correct class for schema type file passed to filter';
}
elsif ($type eq 'result') {
$result_file_count++;
like $class, qr/^DBICTest::Schema::1::Result::(?:Foo|Bar)\z/,
'correct class for result type file passed to filter';
}
else {
die 'invalid file type passed to filter';
}
$original_class_data{$class} = $text;
if ($class =~ /::1$/) {
$text = "No Gotcha!";
}
else {
$text .= q{my $foo = "Kilroy was here";};
}
return $text;
},
);
}
{
package DBICTest::Schema::2;
use base 'DBIx::Class::Schema::Loader';
__PACKAGE__->loader_options(
dump_directory => $dump_path,
quiet => 1,
filter_generated_code => qq{"$^X" t/bin/simple_filter},
);
}
DBICTest::Schema::1->connect($make_dbictest_db::dsn);
# schema is generated in 2 passes
is $schema_file_count, 2,
'correct number of schema files passed to filter';
is $result_file_count, 4,
'correct number of result files passed to filter';
my $foo = slurp_file "$dump_path/DBICTest/Schema/1/Result/Foo.pm";
ok ! -e "$dump_path/DBICTest/Schema/1.pm",
"No package means no file written";
ok $original_class_data{"DBICTest::Schema::1"},
"Even though we processed the missing class";
like $foo, qr/# Created by .* THE FIRST PART/s,
"We get the whole autogenerated text";
like $foo, qr/Kilroy was here/, "Can insert text";
DBICTest::Schema::2->connect($make_dbictest_db::dsn);
$foo = slurp_file "$dump_path/DBICTest/Schema/2/Result/Foo.pm";
like $foo, qr/Kilroy was here/,
"Can insert text via command filter";
END { rmtree($dump_path, 1, 1); }
|
