1use warnings;
2use strict;
3
4use Test::More;
5use DBIx::Class::Schema::Loader::Optional::Dependencies ();
6BEGIN {
7  use DBIx::Class::Schema::Loader::Optional::Dependencies ();
8  plan skip_all => 'Tests needs ' . DBIx::Class::Schema::Loader::Optional::Dependencies->req_missing_for('use_moose')
9    unless (DBIx::Class::Schema::Loader::Optional::Dependencies->req_ok_for('use_moose'));
10}
11
12use lib qw(t/lib);
13use dbixcsl_dumper_tests;
14my $t = 'dbixcsl_dumper_tests';
15
16$t->cleanup;
17
18# first dump a fresh use_moose=1 schema
19$t->dump_test(
20  classname => 'DBICTest::DumpMore::1',
21  options => {
22    use_moose => 1,
23    result_base_class => 'My::ResultBaseClass',
24    schema_base_class => 'My::SchemaBaseClass',
25    result_roles => ['TestRole', 'TestRole2'],
26  },
27  regexes => {
28    schema => [
29      qr/\nuse Moose;\nuse MooseX::MarkAsMethods autoclean => 1;\nextends 'My::SchemaBaseClass';\n\n/,
30      qr/\n__PACKAGE__->meta->make_immutable\(inline_constructor => 0\);\n1;(?!\n1;\n)\n.*/,
31    ],
32    Foo => [
33      qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse MooseX::MarkAsMethods autoclean => 1;\nextends 'My::ResultBaseClass';\n\n/,
34      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/,
35      qr/\nwith 'TestRole', 'TestRole2';\n\n/,
36      qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
37    ],
38    Bar => [
39      qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse MooseX::MarkAsMethods autoclean => 1;\nextends 'My::ResultBaseClass';\n\n/,
40      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/,
41      qr/\nwith 'TestRole', 'TestRole2';\n\n/,
42      qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
43    ],
44  },
45);
46
47$t->cleanup;
48
49# check protect_overloads works as expected
50$t->dump_test(
51  classname => 'DBICTest::DumpMore::1',
52  options => {
53    use_moose      => 1,
54    only_autoclean => 1,
55  },
56  regexes => {
57    schema => [
58      qr/\nuse namespace::autoclean;\n/,
59    ],
60    Foo => [
61      qr/\nuse namespace::autoclean;\n/,
62    ],
63  },
64);
65
66$t->cleanup;
67
68# now upgrade a fresh non-moose schema to use_moose=1
69$t->dump_test(
70  classname => 'DBICTest::DumpMore::1',
71  options => {
72    use_moose => 0,
73    result_base_class => 'My::ResultBaseClass',
74    schema_base_class => 'My::SchemaBaseClass',
75  },
76  regexes => {
77    schema => [
78      qr/\nuse base 'My::SchemaBaseClass';\n/,
79    ],
80    Foo => [
81      qr/\nuse base 'My::ResultBaseClass';\n/,
82    ],
83    Bar => [
84      qr/\nuse base 'My::ResultBaseClass';\n/,
85    ],
86  },
87);
88
89# check that changed custom content is upgraded for Moose bits
90$t->append_to_class('DBICTest::DumpMore::1::Foo', q{# XXX This is my custom content XXX});
91
92$t->dump_test(
93  classname => 'DBICTest::DumpMore::1',
94  options => {
95    use_moose => 1,
96    result_base_class => 'My::ResultBaseClass',
97    schema_base_class => 'My::SchemaBaseClass',
98  },
99  regexes => {
100    schema => [
101      qr/\nuse Moose;\nuse MooseX::MarkAsMethods autoclean => 1;\nextends 'My::SchemaBaseClass';\n\n/,
102      qr/\n__PACKAGE__->meta->make_immutable\(inline_constructor => 0\);\n1;(?!\n1;\n)\n.*/,
103    ],
104    Foo => [
105      qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse MooseX::MarkAsMethods autoclean => 1;\nextends 'My::ResultBaseClass';\n\n/,
106      qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
107      qr/# XXX This is my custom content XXX/,
108    ],
109    Bar => [
110      qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse MooseX::MarkAsMethods autoclean => 1;\nextends 'My::ResultBaseClass';\n\n/,
111      qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
112    ],
113  },
114);
115
116$t->cleanup;
117
118# check with a fresh non-moose schema that Moose custom content added to a use_moose=0 schema is not repeated
119$t->dump_test(
120  classname => 'DBICTest::DumpMore::1',
121  options => {
122    result_base_class => 'My::ResultBaseClass',
123    schema_base_class => 'My::SchemaBaseClass',
124  },
125  regexes => {
126    schema => [
127      qr/\nuse base 'My::SchemaBaseClass';\n/,
128    ],
129    Foo => [
130      qr/\nuse base 'My::ResultBaseClass';\n/,
131    ],
132    Bar => [
133      qr/\nuse base 'My::ResultBaseClass';\n/,
134    ],
135  },
136);
137
138# add Moose custom content then check it is not repeated
139# after that regen again *without* the use_moose flag, make
140# sure moose isn't stripped away
141$t->append_to_class('DBICTest::DumpMore::1::Foo', qq{use Moose;\n__PACKAGE__->meta->make_immutable;\n1;\n});
142
143for my $supply_use_moose (1, 0) {
144  $t->dump_test(
145    classname => 'DBICTest::DumpMore::1',
146    options => {
147      $supply_use_moose ? (use_moose => 1) : (),
148      result_base_class => 'My::ResultBaseClass',
149      schema_base_class => 'My::SchemaBaseClass',
150    },
151    regexes => {
152      schema => [
153        qr/\nuse Moose;\nuse MooseX::MarkAsMethods autoclean => 1;\nextends 'My::SchemaBaseClass';\n\n/,
154        qr/\n__PACKAGE__->meta->make_immutable\(inline_constructor => 0\);\n1;(?!\n1;\n)\n.*/,
155      ],
156      Foo => [
157        qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse MooseX::MarkAsMethods autoclean => 1;\nextends 'My::ResultBaseClass';\n\n/,
158        qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
159      ],
160      Bar => [
161        qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse MooseX::MarkAsMethods autoclean => 1;\nextends 'My::ResultBaseClass';\n\n/,
162        qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
163      ],
164    },
165    neg_regexes => {
166      Foo => [
167#        qr/\nuse Moose;\n.*\nuse Moose;/s, # TODO
168        qr/\n__PACKAGE__->meta->make_immutable;\n.*\n__PACKAGE__->meta->make_immutable;/s,
169      ],
170    },
171  );
172}
173
174# check that a moose schema can *not* be downgraded
175
176$t->dump_test (
177  classname => 'DBICTest::DumpMore::1',
178  options => {
179    use_moose => 0,
180    result_base_class => 'My::ResultBaseClass',
181    schema_base_class => 'My::SchemaBaseClass',
182  },
183  error => qr/\QIt is not possible to "downgrade" a schema that was loaded with use_moose => 1\E/,
184);
185
186done_testing;
187