[catagits/Catalyst-Runtime.git] / t / aggregate / unit_core_mvc.t

use Test::More;
use strict;
use warnings;

use Moose::Meta::Class;

our @complist_suffix = qw/C::Controller M::Model V::View Controller::C Model::M View::V Controller::Model::Dummy::Model Model::Dummy::Model/;

our @complist = map { "MyMVCTestApp::$_" } @complist_suffix;

foreach my $comp (@complist) {
    Moose::Meta::Class->create(
        $comp =>
            version => '0.1',
    );
}
our $warnings = 0;
our $loaded   = 0;

Moose::Meta::Class->create('Some::Test::Object');

Moose::Meta::Class->create(
    'MyMVCTestApp::Model::Test::Object' =>
        superclasses => [ 'Catalyst::Model', 'Some::Test::Object' ],
);

{
    package MyMVCTestApp;

    use base qw/Catalyst/;

    sub locate_components {
        return (@complist, 'MyMVCTestApp::Model::Test::Object');
    }

    no warnings 'redefine';
    local *Catalyst::Log::warn = sub { $warnings++ };
    local *Catalyst::Utils::ensure_class_loaded = sub {
        my $class = shift;
        $loaded++
            if Class::MOP::is_class_loaded($class) && $class =~ /^MyMVCTestApp/
    };

    __PACKAGE__->setup;
}

ok( $warnings, 'Issues deprecated warnings' );
is( $loaded, scalar @complist + 1, 'Loaded all components' );

is( MyMVCTestApp->view('View'), 'MyMVCTestApp::V::View', 'V::View ok' );

is( MyMVCTestApp->controller('Controller'),
    'MyMVCTestApp::C::Controller', 'C::Controller ok' );

is( MyMVCTestApp->model('Model'), 'MyMVCTestApp::M::Model', 'M::Model ok' );

is( MyMVCTestApp->model('Dummy::Model'), 'MyMVCTestApp::Model::Dummy::Model', 'Model::Dummy::Model ok' );

isa_ok( MyMVCTestApp->model('Test::Object'), 'Some::Test::Object', 'Test::Object ok' );

is( MyMVCTestApp->controller('Model::Dummy::Model'), 'MyMVCTestApp::Controller::Model::Dummy::Model', 'Controller::Model::Dummy::Model ok' );

is( MyMVCTestApp->view('V'), 'MyMVCTestApp::View::V', 'View::V ok' );

is( MyMVCTestApp->controller('C'), 'MyMVCTestApp::Controller::C', 'Controller::C ok' );

is( MyMVCTestApp->model('M'), 'MyMVCTestApp::Model::M', 'Model::M ok' );

# failed search
{
    is( MyMVCTestApp->model('DNE'), undef, 'undef for invalid search' );
}

is_deeply( [ sort MyMVCTestApp->views ],
           [ qw/V View/ ],
           'views ok' );

is_deeply( [ sort MyMVCTestApp->controllers ],
           [ qw/C Controller Model::Dummy::Model/ ],
           'controllers ok');

is_deeply( [ sort MyMVCTestApp->models ],
           [ qw/Dummy::Model M Model Test::Object/ ],
           'models ok');

{
    my $warnings = 0;
    no warnings 'redefine';
    local *Catalyst::Log::warn = sub { $warnings++ };

    is( MyMVCTestApp->view , undef, 'view() w/o a default is undef' );
    ok( $warnings, 'warnings thrown for view() w/o a default' );
}

is ( bless ({stash=>{current_view=>'V'}}, 'MyMVCTestApp')->view , 'MyMVCTestApp::View::V', 'current_view ok');

my $view = bless {} , 'MyMVCTestApp::View::V';
is ( bless ({stash=>{current_view_instance=> $view }}, 'MyMVCTestApp')->view , $view, 'current_view_instance ok');

is ( bless ({stash=>{current_view_instance=> $view, current_view=>'MyMVCTestApp::V::View' }}, 'MyMVCTestApp')->view , $view,
  'current_view_instance precedes current_view ok');

{
    my $warnings = 0;
    no warnings 'redefine';
    local *Catalyst::Log::warn = sub { $warnings++ };

    is( MyMVCTestApp->model, undef, 'model() w/o a default is undef' );
    ok( $warnings, 'warnings thrown for model() w/o a default' );
}

is ( bless ({stash=>{current_model=>'M'}}, 'MyMVCTestApp')->model , 'MyMVCTestApp::Model::M', 'current_model ok');

my $model = bless {} , 'MyMVCTestApp::Model::M';
is ( bless ({stash=>{current_model_instance=> $model }}, 'MyMVCTestApp')->model , $model, 'current_model_instance ok');

is ( bless ({stash=>{current_model_instance=> $model, current_model=>'MyMVCTestApp::M::Model' }}, 'MyMVCTestApp')->model , $model,
  'current_model_instance precedes current_model ok');

{
    use FindBin '$Bin';
    use lib "$Bin/../lib";

    use Catalyst::Test 'TestAppController';

    is( get('/foo/test_controller'), 'bar', 'controller() with empty args returns current controller' );
}

our @complist_default_view =
    map { "MyMVCTestAppDefaultView::$_" } @complist_suffix;

{
    package MyMVCTestAppDefaultView;

    use base qw/Catalyst/;

    sub locate_components {
        return @complist_default_view;
    }

    no warnings 'redefine';
    local *Catalyst::Log::warn = sub { $warnings++ };
    local *Catalyst::Utils::ensure_class_loaded = sub {
        my $class = shift;
        $loaded++
            if Class::MOP::is_class_loaded($class) && $class =~ /^MyMVCTestAppDefaultView/
    };

    __PACKAGE__->config( default_view => 'V' );

    __PACKAGE__->setup;
}

is( bless ({stash=>{}}, 'MyMVCTestAppDefaultView')->view, 'MyMVCTestAppDefaultView::View::V', 'default_view ok' );
is( MyMVCTestAppDefaultView->view , 'MyMVCTestAppDefaultView::View::V', 'default_view in class method ok' );

our @complist_default_model =
    map { "MyMVCTestAppDefaultModel::$_" } @complist_suffix;

{
    package MyMVCTestAppDefaultModel;

    use base qw/Catalyst/;

    sub locate_components {
        return @complist_default_model;
    }

    no warnings 'redefine';
    local *Catalyst::Log::warn = sub { $warnings++ };
    local *Catalyst::Utils::ensure_class_loaded = sub {
        my $class = shift;
        $loaded++
            if Class::MOP::is_class_loaded($class) && $class =~ /^MyMVCTestAppDefaultModel/
    };

    __PACKAGE__->config( default_model => 'M' );

    __PACKAGE__->setup;
}

is( bless ({stash=>{}}, 'MyMVCTestAppDefaultModel')->model , 'MyMVCTestAppDefaultModel::Model::M', 'default_model ok' );
is( MyMVCTestAppDefaultModel->model , 'MyMVCTestAppDefaultModel::Model::M', 'default_model in class method ok' );

# regexp behavior tests
{
    # is_deeply is used because regexp behavior means list context
    is_deeply( [ MyMVCTestApp->view( qr{^V[ie]+w$} ) ], [ 'MyMVCTestApp::V::View' ], 'regexp view ok' );
    is_deeply( [ MyMVCTestApp->controller( qr{Dummy\::Model$} ) ], [ 'MyMVCTestApp::Controller::Model::Dummy::Model' ], 'regexp controller ok' );
    is_deeply( [ MyMVCTestApp->model( qr{Dum{2}y} ) ], [ 'MyMVCTestApp::Model::Dummy::Model' ], 'regexp model ok' );

    # object w/ qr{}
    is_deeply( [ MyMVCTestApp->model( qr{Test} ) ], [ MyMVCTestApp->components->{'MyMVCTestApp::Model::Test::Object'} ], 'Object returned' );

    {
        my $warnings = 0;
        no warnings 'redefine';
        local *Catalyst::Log::warn = sub { $warnings++ };

        # object w/ regexp fallback
        is( MyMVCTestApp->model( 'Test' ), undef, 'no regexp fallback' );
        ok( $warnings, 'regexp fallback warnings' );
    }

    is( MyMVCTestApp->view('MyMVCTestApp::V::View$'), undef, 'no regexp fallback');

    is( MyMVCTestApp->controller('MyMVCTestApp::C::Controller$'), undef, 'no regexp fallback');

    is( MyMVCTestApp->model('MyMVCTestApp::M::Model$'), undef, 'no regexp fallback');
}

{
    my @expected = qw( MyMVCTestApp::C::Controller MyMVCTestApp::Controller::C );
    is_deeply( [ sort MyMVCTestApp->controller( qr{^C} ) ], \@expected, 'multiple controller returns from regexp search' );
}

{
    my @expected = qw( MyMVCTestApp::V::View MyMVCTestApp::View::V );
    is_deeply( [ sort MyMVCTestApp->view( qr{^V} ) ], \@expected, 'multiple view returns from regexp search' );
}

{
    my @expected = qw( MyMVCTestApp::M::Model MyMVCTestApp::Model::M );
    is_deeply( [ sort MyMVCTestApp->model( qr{^M} ) ], \@expected, 'multiple model returns from regexp search' );
}

# failed search
{
    is( scalar MyMVCTestApp->controller( qr{DNE} ), 0, '0 results for failed search' );
}

#checking @args passed to ACCEPT_CONTEXT
{
    my $args;

    {
        no warnings 'once';
        *MyMVCTestApp::Model::M::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args};
        *MyMVCTestApp::View::V::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args};
    }

    my $c = bless {}, 'MyMVCTestApp';

    # test accept-context with class rather than instance
    MyMVCTestApp->model('M', qw/foo bar/);
    is_deeply($args, [qw/foo bar/], 'MyMVCTestApp->model args passed to ACCEPT_CONTEXT ok');


    $c->model('M', qw/foo bar/);
    is_deeply($args, [qw/foo bar/], '$c->model args passed to ACCEPT_CONTEXT ok');

    my $x = $c->view('V', qw/foo2 bar2/);
    is_deeply($args, [qw/foo2 bar2/], '$c->view args passed to ACCEPT_CONTEXT ok');

}

{
    package MyApp::WithoutRegexFallback;

    use base qw/Catalyst/;

    __PACKAGE__->config( { disable_component_resolution_regex_fallback => 1 } );

    __PACKAGE__->components( { map { ( ref($_)||$_ , $_ ) }
        qw/MyApp::WithoutRegexFallback::Controller::Another::Foo/ } );

    # allow $c->log->warn to work
    __PACKAGE__->setup_log;
}

{
    # test if non-regex component retrieval still works
    is( MyApp::WithoutRegexFallback->controller('Another::Foo'),
        'MyApp::WithoutRegexFallback::Controller::Another::Foo', 'controller Another::Foo found');
}

{
    my $warnings = 0;
    no warnings 'redefine';
    local *Catalyst::Log::warn = sub { $warnings++ };

    # try to get nonexisting object w/o regexp fallback
    is( MyApp::WithoutRegexFallback->controller('Foo'), undef, 'no controller Foo found');
}

done_testing;
Commit	Line	Data
a9df50f8	1	use Test::More;
5d50f369	2	use strict;
5d50f369	3	use warnings;
e10b40fd	4
a9df50f8	5	use Moose::Meta::Class;
5d50f369	6
a2c0d071	7	our @complist_suffix = qw/C::Controller M::Model V::View Controller::C Model::M View::V Controller::Model::Dummy::Model Model::Dummy::Model/;
	8
	9	our @complist = map { "MyMVCTestApp::$_" } @complist_suffix;
5d50f369	10
a9df50f8	11	foreach my $comp (@complist) {
	12	Moose::Meta::Class->create(
	13	$comp =>
	14	version => '0.1',
	15	);
	16	}
	17	our $warnings = 0;
	18	our $loaded = 0;
	19
	20	Moose::Meta::Class->create('Some::Test::Object');
5d50f369	21
a9df50f8	22	Moose::Meta::Class->create(
	23	'MyMVCTestApp::Model::Test::Object' =>
	24	superclasses => [ 'Catalyst::Model', 'Some::Test::Object' ],
	25	);
	26
	27	{
5d50f369	28	package MyMVCTestApp;
	29
	30	use base qw/Catalyst/;
	31
a9df50f8	32	sub locate_components {
ccc6273e	33	return (@complist, 'MyMVCTestApp::Model::Test::Object');
a9df50f8	34	}
5d50f369	35
a9df50f8	36	no warnings 'redefine';
ccc6273e	37	local *Catalyst::Log::warn = sub { $warnings++ };
ccc6273e	38	local *Catalyst::Utils::ensure_class_loaded = sub {
e10b40fd	39	my $class = shift;
ccc6273e	40	$loaded++
e10b40fd	41	if Class::MOP::is_class_loaded($class) && $class =~ /^MyMVCTestApp/
e10b40fd	42	};
5d50f369	43
a9df50f8	44	__PACKAGE__->setup;
5d50f369	45	}
5d50f369	46
a9df50f8	47	ok( $warnings, 'Issues deprecated warnings' );
	48	is( $loaded, scalar @complist + 1, 'Loaded all components' );
	49
5d50f369	50	is( MyMVCTestApp->view('View'), 'MyMVCTestApp::V::View', 'V::View ok' );
	51
	52	is( MyMVCTestApp->controller('Controller'),
	53	'MyMVCTestApp::C::Controller', 'C::Controller ok' );
	54
	55	is( MyMVCTestApp->model('Model'), 'MyMVCTestApp::M::Model', 'M::Model ok' );
	56
	57	is( MyMVCTestApp->model('Dummy::Model'), 'MyMVCTestApp::Model::Dummy::Model', 'Model::Dummy::Model ok' );
	58
	59	isa_ok( MyMVCTestApp->model('Test::Object'), 'Some::Test::Object', 'Test::Object ok' );
	60
	61	is( MyMVCTestApp->controller('Model::Dummy::Model'), 'MyMVCTestApp::Controller::Model::Dummy::Model', 'Controller::Model::Dummy::Model ok' );
	62
	63	is( MyMVCTestApp->view('V'), 'MyMVCTestApp::View::V', 'View::V ok' );
	64
	65	is( MyMVCTestApp->controller('C'), 'MyMVCTestApp::Controller::C', 'Controller::C ok' );
	66
	67	is( MyMVCTestApp->model('M'), 'MyMVCTestApp::Model::M', 'Model::M ok' );
	68
	69	# failed search
	70	{
	71	is( MyMVCTestApp->model('DNE'), undef, 'undef for invalid search' );
	72	}
	73
	74	is_deeply( [ sort MyMVCTestApp->views ],
	75	[ qw/V View/ ],
	76	'views ok' );
	77
	78	is_deeply( [ sort MyMVCTestApp->controllers ],
	79	[ qw/C Controller Model::Dummy::Model/ ],
	80	'controllers ok');
	81
	82	is_deeply( [ sort MyMVCTestApp->models ],
	83	[ qw/Dummy::Model M Model Test::Object/ ],
	84	'models ok');
	85
	86	{
ccc6273e	87	my $warnings = 0;
	88	no warnings 'redefine';
	89	local *Catalyst::Log::warn = sub { $warnings++ };
5d50f369	90
a2c0d071	91	is( MyMVCTestApp->view , undef, 'view() w/o a default is undef' );
a2c0d071	92	ok( $warnings, 'warnings thrown for view() w/o a default' );
5d50f369	93	}
	94
	95	is ( bless ({stash=>{current_view=>'V'}}, 'MyMVCTestApp')->view , 'MyMVCTestApp::View::V', 'current_view ok');
	96
	97	my $view = bless {} , 'MyMVCTestApp::View::V';
	98	is ( bless ({stash=>{current_view_instance=> $view }}, 'MyMVCTestApp')->view , $view, 'current_view_instance ok');
	99
	100	is ( bless ({stash=>{current_view_instance=> $view, current_view=>'MyMVCTestApp::V::View' }}, 'MyMVCTestApp')->view , $view,
	101	'current_view_instance precedes current_view ok');
	102
	103	{
ccc6273e	104	my $warnings = 0;
	105	no warnings 'redefine';
	106	local *Catalyst::Log::warn = sub { $warnings++ };
5d50f369	107
a2c0d071	108	is( MyMVCTestApp->model, undef, 'model() w/o a default is undef' );
a2c0d071	109	ok( $warnings, 'warnings thrown for model() w/o a default' );
5d50f369	110	}
	111
	112	is ( bless ({stash=>{current_model=>'M'}}, 'MyMVCTestApp')->model , 'MyMVCTestApp::Model::M', 'current_model ok');
	113
	114	my $model = bless {} , 'MyMVCTestApp::Model::M';
	115	is ( bless ({stash=>{current_model_instance=> $model }}, 'MyMVCTestApp')->model , $model, 'current_model_instance ok');
	116
	117	is ( bless ({stash=>{current_model_instance=> $model, current_model=>'MyMVCTestApp::M::Model' }}, 'MyMVCTestApp')->model , $model,
	118	'current_model_instance precedes current_model ok');
	119
e10b40fd	120	{
	121	use FindBin '$Bin';
	122	use lib "$Bin/../lib";
	123
	124	use Catalyst::Test 'TestAppController';
	125
	126	is( get('/foo/test_controller'), 'bar', 'controller() with empty args returns current controller' );
	127	}
	128
a2c0d071	129	our @complist_default_view =
	130	map { "MyMVCTestAppDefaultView::$_" } @complist_suffix;
	131
	132	{
	133	package MyMVCTestAppDefaultView;
	134
	135	use base qw/Catalyst/;
	136
	137	sub locate_components {
ccc6273e	138	return @complist_default_view;
a2c0d071	139	}
	140
	141	no warnings 'redefine';
ccc6273e	142	local *Catalyst::Log::warn = sub { $warnings++ };
ccc6273e	143	local *Catalyst::Utils::ensure_class_loaded = sub {
a2c0d071	144	my $class = shift;
ccc6273e	145	$loaded++
a2c0d071	146	if Class::MOP::is_class_loaded($class) && $class =~ /^MyMVCTestAppDefaultView/
	147	};
	148
	149	__PACKAGE__->config( default_view => 'V' );
	150
	151	__PACKAGE__->setup;
	152	}
	153
	154	is( bless ({stash=>{}}, 'MyMVCTestAppDefaultView')->view, 'MyMVCTestAppDefaultView::View::V', 'default_view ok' );
	155	is( MyMVCTestAppDefaultView->view , 'MyMVCTestAppDefaultView::View::V', 'default_view in class method ok' );
	156
	157	our @complist_default_model =
	158	map { "MyMVCTestAppDefaultModel::$_" } @complist_suffix;
	159
	160	{
	161	package MyMVCTestAppDefaultModel;
	162
	163	use base qw/Catalyst/;
	164
	165	sub locate_components {
ccc6273e	166	return @complist_default_model;
a2c0d071	167	}
	168
	169	no warnings 'redefine';
ccc6273e	170	local *Catalyst::Log::warn = sub { $warnings++ };
ccc6273e	171	local *Catalyst::Utils::ensure_class_loaded = sub {
a2c0d071	172	my $class = shift;
ccc6273e	173	$loaded++
a2c0d071	174	if Class::MOP::is_class_loaded($class) && $class =~ /^MyMVCTestAppDefaultModel/
	175	};
	176
	177	__PACKAGE__->config( default_model => 'M' );
	178
	179	__PACKAGE__->setup;
	180	}
5d50f369	181
a2c0d071	182	is( bless ({stash=>{}}, 'MyMVCTestAppDefaultModel')->model , 'MyMVCTestAppDefaultModel::Model::M', 'default_model ok' );
a2c0d071	183	is( MyMVCTestAppDefaultModel->model , 'MyMVCTestAppDefaultModel::Model::M', 'default_model in class method ok' );
5d50f369	184
	185	# regexp behavior tests
	186	{
	187	# is_deeply is used because regexp behavior means list context
	188	is_deeply( [ MyMVCTestApp->view( qr{^V[ie]+w$} ) ], [ 'MyMVCTestApp::V::View' ], 'regexp view ok' );
	189	is_deeply( [ MyMVCTestApp->controller( qr{Dummy\::Model$} ) ], [ 'MyMVCTestApp::Controller::Model::Dummy::Model' ], 'regexp controller ok' );
	190	is_deeply( [ MyMVCTestApp->model( qr{Dum{2}y} ) ], [ 'MyMVCTestApp::Model::Dummy::Model' ], 'regexp model ok' );
	191
	192	# object w/ qr{}
	193	is_deeply( [ MyMVCTestApp->model( qr{Test} ) ], [ MyMVCTestApp->components->{'MyMVCTestApp::Model::Test::Object'} ], 'Object returned' );
	194
	195	{
ccc6273e	196	my $warnings = 0;
	197	no warnings 'redefine';
	198	local *Catalyst::Log::warn = sub { $warnings++ };
5d50f369	199
5d50f369	200	# object w/ regexp fallback
5a53ef3d	201	is( MyMVCTestApp->model( 'Test' ), undef, 'no regexp fallback' );
5d50f369	202	ok( $warnings, 'regexp fallback warnings' );
	203	}
	204
5a53ef3d	205	is( MyMVCTestApp->view('MyMVCTestApp::V::View$'), undef, 'no regexp fallback');
	206
	207	is( MyMVCTestApp->controller('MyMVCTestApp::C::Controller$'), undef, 'no regexp fallback');
	208
	209	is( MyMVCTestApp->model('MyMVCTestApp::M::Model$'), undef, 'no regexp fallback');
5d50f369	210	}
	211
	212	{
	213	my @expected = qw( MyMVCTestApp::C::Controller MyMVCTestApp::Controller::C );
	214	is_deeply( [ sort MyMVCTestApp->controller( qr{^C} ) ], \@expected, 'multiple controller returns from regexp search' );
	215	}
	216
	217	{
	218	my @expected = qw( MyMVCTestApp::V::View MyMVCTestApp::View::V );
	219	is_deeply( [ sort MyMVCTestApp->view( qr{^V} ) ], \@expected, 'multiple view returns from regexp search' );
	220	}
	221
	222	{
	223	my @expected = qw( MyMVCTestApp::M::Model MyMVCTestApp::Model::M );
	224	is_deeply( [ sort MyMVCTestApp->model( qr{^M} ) ], \@expected, 'multiple model returns from regexp search' );
	225	}
	226
	227	# failed search
	228	{
	229	is( scalar MyMVCTestApp->controller( qr{DNE} ), 0, '0 results for failed search' );
	230	}
	231
	232	#checking @args passed to ACCEPT_CONTEXT
	233	{
	234	my $args;
	235
	236	{
	237	no warnings 'once';
	238	*MyMVCTestApp::Model::M::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args};
	239	*MyMVCTestApp::View::V::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args};
	240	}
	241
	242	my $c = bless {}, 'MyMVCTestApp';
	243
	244	# test accept-context with class rather than instance
	245	MyMVCTestApp->model('M', qw/foo bar/);
	246	is_deeply($args, [qw/foo bar/], 'MyMVCTestApp->model args passed to ACCEPT_CONTEXT ok');
	247
	248
	249	$c->model('M', qw/foo bar/);
	250	is_deeply($args, [qw/foo bar/], '$c->model args passed to ACCEPT_CONTEXT ok');
	251
	252	my $x = $c->view('V', qw/foo2 bar2/);
	253	is_deeply($args, [qw/foo2 bar2/], '$c->view args passed to ACCEPT_CONTEXT ok');
	254
02fee6c6	255	}
	256
	257	{
	258	package MyApp::WithoutRegexFallback;
	259
	260	use base qw/Catalyst/;
	261
	262	__PACKAGE__->config( { disable_component_resolution_regex_fallback => 1 } );
	263
	264	__PACKAGE__->components( { map { ( ref($_)\|\|$_ , $_ ) }
	265	qw/MyApp::WithoutRegexFallback::Controller::Another::Foo/ } );
	266
	267	# allow $c->log->warn to work
	268	__PACKAGE__->setup_log;
	269	}
	270
	271	{
	272	# test if non-regex component retrieval still works
	273	is( MyApp::WithoutRegexFallback->controller('Another::Foo'),
	274	'MyApp::WithoutRegexFallback::Controller::Another::Foo', 'controller Another::Foo found');
	275	}
	276
	277	{
	278	my $warnings = 0;
	279	no warnings 'redefine';
	280	local *Catalyst::Log::warn = sub { $warnings++ };
	281
	282	# try to get nonexisting object w/o regexp fallback
	283	is( MyApp::WithoutRegexFallback->controller('Foo'), undef, 'no controller Foo found');
02fee6c6	284	}
a9df50f8	285
5a53ef3d	286	done_testing;