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 is(scalar keys %$complist, 24, "Correct number of components loaded");
 104
 105 foreach (keys %$complist) {
 106
 107     # Skip the component which happens to be the app itself
 108     next if $_ eq $appclass;
 109
 110     my $instance = $appclass->component($_);
 111     isa_ok($instance, $_);
 112     can_ok($instance, 'whoami');
 113     is($instance->whoami, $_);
 114
 115     if($_ =~ /^${appclass}::(?:V|View)::(.*)/) {
 116         my $moniker = $1;
 117         isa_ok($instance, 'Catalyst::View');
 118         can_ok($appclass->view($moniker), 'whoami');
 119         is($appclass->view($moniker)->whoami, $_);
 120     }
 121     elsif($_ =~ /^${appclass}::(?:M|Model)::(.*)/) {
 122         my $moniker = $1;
 123         isa_ok($instance, 'Catalyst::Model');
 124         can_ok($appclass->model($moniker), 'whoami');
 125         is($appclass->model($moniker)->whoami, $_);
 126     }
 127     elsif($_ =~ /^${appclass}::(?:C|Controller)::(.*)/) {
 128         my $moniker = $1;
 129         isa_ok($instance, 'Catalyst::Controller');
 130         can_ok($appclass->controller($moniker), 'whoami');
 131         is($appclass->controller($moniker)->whoami, $_);
 132     }
 133     else {
 134         die "Something is wrong with this test, this should"
 135             . " have been unreachable";
 136     }
 137 }
 138
 139 rmtree($libdir);
 140
 141 # test extra component loading options
 142
 143 $appclass = 'ExtraOptions';
 144 push @components, { type => 'View', prefix => 'Extra', name => 'Foo' };
 145
 146 foreach my $component (@components) {
 147     make_component_file(
 148         $libdir,
 149         $appclass,
 150         $component->{type},
 151         $component->{prefix},
 152         $component->{name},
 153     );
 154 }
 155
 156 SKIP: {
 157     # FIXME - any backcompat planned?
 158     skip "search_extra has been removed", 5;
 159     eval qq(
 160     package $appclass;
 161     use Catalyst;
 162     $shut_up_deprecated_warnings
 163     __PACKAGE__->config->{ setup_components } = {
 164         search_extra => [ '::Extra' ],
 165         except       => [ "${appclass}::Controller::Foo" ]
 166     };
 167     __PACKAGE__->setup;
 168     );
 169
 170     {
 171         my $config = {
 172             search_extra => [ '::Extra' ],
 173             except       => [ "${appclass}::Controller::Foo" ]
 174         };
 175         my @components_located = $appclass->locate_components($config);
 176         my @components_expected;
 177         for (@components) {
 178             my $name = $appclass . '::' . $_->{prefix} . '::' . $_->{name};
 179             push @components_expected, $name if $name ne "${appclass}::Controller::Foo";
 180         }
 181         is_deeply(
 182             [ sort @components_located ],
 183             [ sort @components_expected ],
 184             'locate_components finds the components correctly'
 185         );
 186     }
 187
 188     can_ok( $appclass, 'components');
 189
 190     $complist = $appclass->components;
 191
 192     is(scalar keys %$complist, 24+1, "Correct number of components loaded");
 193
 194     ok( !exists $complist->{ "${appclass}::Controller::Foo" }, 'Controller::Foo was skipped' );
 195     ok( exists $complist->{ "${appclass}::Extra::Foo" }, 'Extra::Foo was loaded' );
 196
 197     rmtree($libdir);
 198 }
 199
 200 $appclass = "ComponentOnce";
 201
 202 write_component_file([$libdir, $appclass, 'Model'], 'TopLevel', <<EOF);
 203 package ${appclass}::Model::TopLevel;
 204 use base 'Catalyst::Model';
 205 sub COMPONENT {
 206
 207     my \$self = shift->next::method(\@_);
 208     no strict 'refs';
 209     *{\__PACKAGE__ . "::whoami"} = sub { return \__PACKAGE__; };
 210     *${appclass}::Model::TopLevel::GENERATED::ACCEPT_CONTEXT = sub {
 211         return bless {}, 'FooBarBazQuux';
 212     };
 213     \$self;
 214 }
 215
 216 package ${appclass}::Model::TopLevel::Nested;
 217
 218 sub COMPONENT { die "COMPONENT called in the wrong order!"; }
 219
 220 1;
 221
 222 EOF
 223
 224 write_component_file([$libdir, $appclass, 'Model', 'TopLevel'], 'Nested', <<EOF);
 225 package ${appclass}::Model::TopLevel::Nested;
 226 use base 'Catalyst::Model';
 227
 228 my \$called=0;
 229 no warnings 'redefine';
 230 sub COMPONENT { \$called++;return shift->next::method(\@_); }
 231 sub called { return \$called };
 232 1;
 233
 234 EOF
 235
 236 eval "package $appclass; use Catalyst; __PACKAGE__->setup";
 237
 238 is($@, '', "Didn't load component twice");
 239 is($appclass->model('TopLevel::Nested')->called,1, 'COMPONENT called once');
 240
 241 # FIXME we need a much better way of components being able to generate
 242 #       sub-components of themselves (e.g. bring back expand_component_modules?)
 243 #       as otherwise we _have_ to construct / call the COMPONENT method
 244 #       explicitly to get all the sub-components built for Devel::InnerPackage
 245 #       to find them. See FIXME in Catalyst::IOC::Container
 246 ok($appclass->model('TopLevel::GENERATED'), 'Have generated model');
 247 is(ref($appclass->model('TopLevel::GENERATED')), 'FooBarBazQuux',
 248     'ACCEPT_CONTEXT in generated inner package fired as expected');
 249
 250 $appclass = "InnerComponent";
 251
 252 {
 253   package InnerComponent::Controller::Test;
 254   use base 'Catalyst::Controller';
 255 }
 256
 257 $INC{'InnerComponent/Controller/Test.pm'} = 1;
 258
 259 eval "package $appclass; use Catalyst; __PACKAGE__->setup";
 260
 261 isa_ok($appclass->controller('Test'), 'Catalyst::Controller');
 262
 263 rmtree($libdir);
 264
 265 done_testing;