removed regexp fallback
[catagits/Catalyst-Runtime.git] / t / aggregate / unit_core_component_loading.t
1 # way too many tests to count
2 use Test::More;
3
4 use strict;
5 use warnings;
6
7 use File::Spec;
8 use File::Path;
9
10 my $libdir = 'test_trash';
11 local @INC = @INC;
12 unshift(@INC, $libdir);
13
14 my $appclass = 'TestComponents';
15 my @components = (
16     { type => 'Controller', prefix => 'C', name => 'Bar' },
17     { type => 'Controller', prefix => 'C', name => 'Foo::Bar' },
18     { type => 'Controller', prefix => 'C', name => 'Foo::Foo::Bar' },
19     { type => 'Controller', prefix => 'C', name => 'Foo::Foo::Foo::Bar' },
20     { type => 'Controller', prefix => 'Controller', name => 'Bar::Bar::Bar::Foo' },
21     { type => 'Controller', prefix => 'Controller', name => 'Bar::Bar::Foo' },
22     { type => 'Controller', prefix => 'Controller', name => 'Bar::Foo' },
23     { type => 'Controller', prefix => 'Controller', name => 'Foo' },
24     { type => 'Model', prefix => 'M', name => 'Bar' },
25     { type => 'Model', prefix => 'M', name => 'Foo::Bar' },
26     { type => 'Model', prefix => 'M', name => 'Foo::Foo::Bar' },
27     { type => 'Model', prefix => 'M', name => 'Foo::Foo::Foo::Bar' },
28     { type => 'Model', prefix => 'Model', name => 'Bar::Bar::Bar::Foo' },
29     { type => 'Model', prefix => 'Model', name => 'Bar::Bar::Foo' },
30     { type => 'Model', prefix => 'Model', name => 'Bar::Foo' },
31     { type => 'Model', prefix => 'Model', name => 'Foo' },
32     { type => 'View', prefix => 'V', name => 'Bar' },
33     { type => 'View', prefix => 'V', name => 'Foo::Bar' },
34     { type => 'View', prefix => 'V', name => 'Foo::Foo::Bar' },
35     { type => 'View', prefix => 'V', name => 'Foo::Foo::Foo::Bar' },
36     { type => 'View', prefix => 'View', name => 'Bar::Bar::Bar::Foo' },
37     { type => 'View', prefix => 'View', name => 'Bar::Bar::Foo' },
38     { type => 'View', prefix => 'View', name => 'Bar::Foo' },
39     { type => 'View', prefix => 'View', name => 'Foo' },
40 );
41
42 sub write_component_file {
43   my ($dir_list, $module_name, $content) = @_;
44
45   my $dir  = File::Spec->catdir(@$dir_list);
46   my $file = File::Spec->catfile($dir, $module_name . '.pm');
47
48   mkpath(join(q{/}, @$dir_list) );
49   open(my $fh, '>', $file) or die "Could not open file $file for writing: $!";
50   print $fh $content;
51   close $fh;
52 }
53
54 sub make_component_file {
55     my ($libdir, $appclass, $type, $prefix, $name) = @_;
56
57     my $compbase = "Catalyst::${type}";
58     my $fullname = "${appclass}::${prefix}::${name}";
59     my @namedirs = split(/::/, $name);
60     my $name_final = pop(@namedirs);
61     my @dir_list = ($libdir, $appclass, $prefix, @namedirs);
62
63     write_component_file(\@dir_list, $name_final, <<EOF);
64 package $fullname;
65 use MRO::Compat;
66 use base '$compbase';
67 sub COMPONENT {
68     my \$self = shift->next::method(\@_);
69     no strict 'refs';
70     *{\__PACKAGE__ . "::whoami"} = sub { return \__PACKAGE__; };
71     \$self;
72 }
73 1;
74
75 EOF
76 }
77
78 foreach my $component (@components) {
79     make_component_file(
80         $libdir,
81         $appclass,
82         $component->{type},
83         $component->{prefix},
84         $component->{name},
85     );
86 }
87
88 my $shut_up_deprecated_warnings = q{
89     __PACKAGE__->log(Catalyst::Log->new('fatal'));
90 };
91
92 eval "package $appclass; use Catalyst; $shut_up_deprecated_warnings __PACKAGE__->setup";
93
94 is_deeply(
95     [ sort $appclass->locate_components ],
96     [ map { $appclass . '::' . $_->{prefix} . '::' . $_->{name} } @components ],    'locate_components finds the components correctly'
97 );
98
99 can_ok( $appclass, 'components');
100
101 my $complist = $appclass->components;
102
103 # the +1 below is for the app class itself
104 is(scalar keys %$complist, 24+1, "Correct number of components loaded");
105
106 foreach (keys %$complist) {
107
108     # Skip the component which happens to be the app itself
109     next if $_ eq $appclass;
110
111     my $instance = $appclass->component($_);
112     isa_ok($instance, $_);
113     can_ok($instance, 'whoami');
114     is($instance->whoami, $_);
115
116     if($_ =~ /^${appclass}::(?:V|View)::(.*)/) {
117         my $moniker = $1;
118         isa_ok($instance, 'Catalyst::View');
119         can_ok($appclass->view($moniker), 'whoami');
120         is($appclass->view($moniker)->whoami, $_);
121     }
122     elsif($_ =~ /^${appclass}::(?:M|Model)::(.*)/) {
123         my $moniker = $1;
124         isa_ok($instance, 'Catalyst::Model');
125         can_ok($appclass->model($moniker), 'whoami');
126         is($appclass->model($moniker)->whoami, $_);
127     }
128     elsif($_ =~ /^${appclass}::(?:C|Controller)::(.*)/) {
129         my $moniker = $1;
130         isa_ok($instance, 'Catalyst::Controller');
131         can_ok($appclass->controller($moniker), 'whoami');
132         is($appclass->controller($moniker)->whoami, $_);
133     }
134     else {
135         die "Something is wrong with this test, this should"
136             . " have been unreachable";
137     }
138 }
139
140 rmtree($libdir);
141
142 # test extra component loading options
143
144 $appclass = 'ExtraOptions';
145 push @components, { type => 'View', prefix => 'Extra', name => 'Foo' };
146
147 foreach my $component (@components) {
148     make_component_file(
149         $libdir,
150         $appclass,
151         $component->{type},
152         $component->{prefix},
153         $component->{name},
154     );
155 }
156
157 eval qq(
158 package $appclass;
159 use Catalyst;
160 $shut_up_deprecated_warnings
161 __PACKAGE__->config->{ setup_components } = {
162     search_extra => [ '::Extra' ],
163     except       => [ "${appclass}::Controller::Foo" ]
164 };
165 __PACKAGE__->setup;
166 );
167
168 {
169     my $config = {
170         search_extra => [ '::Extra' ],
171         except       => [ "${appclass}::Controller::Foo" ]
172     };
173     my @components_located = $appclass->locate_components($config);
174     my @components_expected;
175     for (@components) {
176         my $name = $appclass . '::' . $_->{prefix} . '::' . $_->{name};
177         push @components_expected, $name if $name ne "${appclass}::Controller::Foo";
178     }
179     is_deeply(
180         [ sort @components_located ],
181         [ sort @components_expected ],
182         'locate_components finds the components correctly'
183     );
184 }
185
186 can_ok( $appclass, 'components');
187
188 $complist = $appclass->components;
189
190 is(scalar keys %$complist, 24+1, "Correct number of components loaded");
191
192 ok( !exists $complist->{ "${appclass}::Controller::Foo" }, 'Controller::Foo was skipped' );
193 ok( exists $complist->{ "${appclass}::Extra::Foo" }, 'Extra::Foo was loaded' );
194
195 rmtree($libdir);
196
197 $appclass = "ComponentOnce";
198
199 write_component_file([$libdir, $appclass, 'Model'], 'TopLevel', <<EOF);
200 package ${appclass}::Model::TopLevel;
201 use base 'Catalyst::Model';
202 sub COMPONENT {
203
204     my \$self = shift->next::method(\@_);
205     no strict 'refs';
206     *{\__PACKAGE__ . "::whoami"} = sub { return \__PACKAGE__; };
207     *${appclass}::Model::TopLevel::GENERATED::ACCEPT_CONTEXT = sub {
208         return bless {}, 'FooBarBazQuux';
209     };
210     \$self;
211 }
212
213 package ${appclass}::Model::TopLevel::Nested;
214
215 sub COMPONENT { die "COMPONENT called in the wrong order!"; }
216
217 1;
218
219 EOF
220
221 write_component_file([$libdir, $appclass, 'Model', 'TopLevel'], 'Nested', <<EOF);
222 package ${appclass}::Model::TopLevel::Nested;
223 use base 'Catalyst::Model';
224
225 my \$called=0;
226 no warnings 'redefine';
227 sub COMPONENT { \$called++;return shift->next::method(\@_); }
228 sub called { return \$called };
229 1;
230
231 EOF
232
233 eval "package $appclass; use Catalyst; __PACKAGE__->setup";
234
235 is($@, '', "Didn't load component twice");
236 is($appclass->model('TopLevel::Nested')->called,1, 'COMPONENT called once');
237
238 ok($appclass->model('TopLevel::GENERATED'), 'Have generated model');
239 is(ref($appclass->model('TopLevel::GENERATED')), 'FooBarBazQuux',
240     'ACCEPT_CONTEXT in generated inner package fired as expected');
241
242 $appclass = "InnerComponent";
243
244 {
245   package InnerComponent::Controller::Test;
246   use base 'Catalyst::Controller';
247 }
248
249 $INC{'InnerComponent/Controller/Test.pm'} = 1;
250
251 eval "package $appclass; use Catalyst; __PACKAGE__->setup";
252
253 isa_ok($appclass->controller('Test'), 'Catalyst::Controller');
254
255 rmtree($libdir);
256
257 done_testing;