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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
use DBIx::Class::Schema::Loader::Optional::Dependencies
-skip_all_without => 'use_moose';
use strict;
use warnings;
use Test::More;
use lib qw(t/lib);
use dbixcsl_dumper_tests;
my $t = 'dbixcsl_dumper_tests';
$t->cleanup;
# first dump a fresh use_moose=1 schema
$t->dump_test(
classname => 'DBICTest::DumpMore::1',
options => {
use_moose => 1,
result_base_class => 'My::ResultBaseClass',
schema_base_class => 'My::SchemaBaseClass',
result_roles => ['TestRole', 'TestRole2'],
},
regexes => {
schema => [
qr/\nuse Moose;\nuse MooseX::MarkAsMethods autoclean => 1;\nextends 'My::SchemaBaseClass';\n\n/,
qr/\n__PACKAGE__->meta->make_immutable\(inline_constructor => 0\);\n1;(?!\n1;\n)\n.*/,
],
Foo => [
qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse MooseX::MarkAsMethods autoclean => 1;\nextends 'My::ResultBaseClass';\n\n/,
qr/=head1 L<Moose> ROLES APPLIED\n\n=over 4\n\n=item \* L<TestRole>\n\n=item \* L<TestRole2>\n\n=back\n\n=cut\n\n/,
qr/\nwith 'TestRole', 'TestRole2';\n\n/,
qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
],
Bar => [
qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse MooseX::MarkAsMethods autoclean => 1;\nextends 'My::ResultBaseClass';\n\n/,
qr/=head1 L<Moose> ROLES APPLIED\n\n=over 4\n\n=item \* L<TestRole>\n\n=item \* L<TestRole2>\n\n=back\n\n=cut\n\n/,
qr/\nwith 'TestRole', 'TestRole2';\n\n/,
qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
],
},
);
$t->cleanup;
# check protect_overloads works as expected
$t->dump_test(
classname => 'DBICTest::DumpMore::1',
options => {
use_moose => 1,
only_autoclean => 1,
},
regexes => {
schema => [
qr/\nuse namespace::autoclean;\n/,
],
Foo => [
qr/\nuse namespace::autoclean;\n/,
],
},
);
$t->cleanup;
# now upgrade a fresh non-moose schema to use_moose=1
$t->dump_test(
classname => 'DBICTest::DumpMore::1',
options => {
use_moose => 0,
result_base_class => 'My::ResultBaseClass',
schema_base_class => 'My::SchemaBaseClass',
},
regexes => {
schema => [
qr/\nuse base 'My::SchemaBaseClass';\n/,
],
Foo => [
qr/\nuse base 'My::ResultBaseClass';\n/,
],
Bar => [
qr/\nuse base 'My::ResultBaseClass';\n/,
],
},
);
# check that changed custom content is upgraded for Moose bits
$t->append_to_class('DBICTest::DumpMore::1::Foo', q{# XXX This is my custom content XXX});
$t->dump_test(
classname => 'DBICTest::DumpMore::1',
options => {
use_moose => 1,
result_base_class => 'My::ResultBaseClass',
schema_base_class => 'My::SchemaBaseClass',
},
regexes => {
schema => [
qr/\nuse Moose;\nuse MooseX::MarkAsMethods autoclean => 1;\nextends 'My::SchemaBaseClass';\n\n/,
qr/\n__PACKAGE__->meta->make_immutable\(inline_constructor => 0\);\n1;(?!\n1;\n)\n.*/,
],
Foo => [
qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse MooseX::MarkAsMethods autoclean => 1;\nextends 'My::ResultBaseClass';\n\n/,
qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
qr/# XXX This is my custom content XXX/,
],
Bar => [
qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse MooseX::MarkAsMethods autoclean => 1;\nextends 'My::ResultBaseClass';\n\n/,
qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
],
},
);
$t->cleanup;
# check with a fresh non-moose schema that Moose custom content added to a use_moose=0 schema is not repeated
$t->dump_test(
classname => 'DBICTest::DumpMore::1',
options => {
result_base_class => 'My::ResultBaseClass',
schema_base_class => 'My::SchemaBaseClass',
},
regexes => {
schema => [
qr/\nuse base 'My::SchemaBaseClass';\n/,
],
Foo => [
qr/\nuse base 'My::ResultBaseClass';\n/,
],
Bar => [
qr/\nuse base 'My::ResultBaseClass';\n/,
],
},
);
# add Moose custom content then check it is not repeated
# after that regen again *without* the use_moose flag, make
# sure moose isn't stripped away
$t->append_to_class('DBICTest::DumpMore::1::Foo', qq{use Moose;\n__PACKAGE__->meta->make_immutable;\n1;\n});
for my $supply_use_moose (1, 0) {
$t->dump_test(
classname => 'DBICTest::DumpMore::1',
options => {
$supply_use_moose ? (use_moose => 1) : (),
result_base_class => 'My::ResultBaseClass',
schema_base_class => 'My::SchemaBaseClass',
},
regexes => {
schema => [
qr/\nuse Moose;\nuse MooseX::MarkAsMethods autoclean => 1;\nextends 'My::SchemaBaseClass';\n\n/,
qr/\n__PACKAGE__->meta->make_immutable\(inline_constructor => 0\);\n1;(?!\n1;\n)\n.*/,
],
Foo => [
qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse MooseX::MarkAsMethods autoclean => 1;\nextends 'My::ResultBaseClass';\n\n/,
qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
],
Bar => [
qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse MooseX::MarkAsMethods autoclean => 1;\nextends 'My::ResultBaseClass';\n\n/,
qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
],
},
neg_regexes => {
Foo => [
# qr/\nuse Moose;\n.*\nuse Moose;/s, # TODO
qr/\n__PACKAGE__->meta->make_immutable;\n.*\n__PACKAGE__->meta->make_immutable;/s,
],
},
);
}
# check that a moose schema can *not* be downgraded
$t->dump_test (
classname => 'DBICTest::DumpMore::1',
options => {
use_moose => 0,
result_base_class => 'My::ResultBaseClass',
schema_base_class => 'My::SchemaBaseClass',
},
error => qr/\QIt is not possible to "downgrade" a schema that was loaded with use_moose => 1\E/,
);
done_testing;
|
