[catagits/Catalyst-Runtime.git] / t / arg_constraints.t

use warnings;
use strict;

BEGIN {
  use Test::More;
  eval "use Types::Standard; 1;" || do {
    plan skip_all => "Trouble loading Types::Standard => $@";
  };

  package MyApp::Types;
  $INC{'MyApp/Types.pm'} = __FILE__;

  use strict;
  use warnings;
 
  use Type::Utils -all;
  use Types::Standard -types;
  use Type::Library
   -base,
   -declare => qw( UserId User ContextLike );

  extends "Types::Standard"; 

  class_type User, { class => "MyApp::Model::User::user" };
  duck_type ContextLike, [qw/model/];

  declare UserId,
   as Int,
   where { $_ < 5 };

  # Tests using this are skipped pending deeper thought
  coerce User,
   from ContextLike,
     via { $_->model('User')->find( $_->req->args->[0] ) };
}

{
  package MyApp::Model::User;
  $INC{'MyApp/Model/User.pm'} = __FILE__;

  use base 'Catalyst::Model';

  our %users = (
    1 => { name => 'john', age => 46 },
    2 => { name => 'mary', age => 36 },
    3 => { name => 'ian', age => 25 },
    4 => { name => 'visha', age => 18 },
  );

  sub find {
    my ($self, $id) = @_;
    my $user = $users{$id} || return;
    return bless $user, "MyApp::Model::User::user";
  }

  package MyApp::Controller::Root;
  $INC{'MyApp/Controller/Root.pm'} = __FILE__;

  use Moose;
  use MooseX::MethodAttributes;
  use MyApp::Types qw/Tuple Int Str StrMatch ArrayRef UserId User/;

  extends 'Catalyst::Controller';

  sub user :Local Args(UserId) {
    my ($self, $c, $int) = @_;
    my $user = $c->model("User")->find($int);
    $c->res->body("name: $user->{name}, age: $user->{age}");
  }

  # Tests using this are current skipped pending coercion rethink
  sub user_object :Local Args(User) Coerce(1) {
    my ($self, $c, $user) = @_;
    $c->res->body("name: $user->{name}, age: $user->{age}");
  }

  sub an_int :Local Args(Int) {
    my ($self, $c, $int) = @_;
    $c->res->body('an_int');
  }

  sub two_ints :Local Args(Int,Int) {
    my ($self, $c, $int) = @_;
    $c->res->body('two_ints');
  }

  sub many_ints :Local Args(ArrayRef[Int]) {
    my ($self, $c, $int) = @_;
    $c->res->body('many_ints');
  }

  sub tuple :Local Args(Tuple[Str,Int]) {
    my ($self, $c, $str, $int) = @_;
    $c->res->body('tuple');
  }

  sub match :Local Args(StrMatch[qr{\d\d-\d\d-\d\d}]) {
    my ($self, $c, $int) = @_;
    $c->res->body('match');
  }

  sub any_priority :Path('priority_test') Args(1) { $_[1]->res->body('any_priority') }

  sub int_priority :Path('priority_test') Args(Int) { $_[1]->res->body('int_priority') }

  sub chain_base :Chained(/) CaptureArgs(1) { }

    sub any_priority_chain :GET Chained(chain_base) PathPart('') Args(1) { $_[1]->res->body('any_priority_chain') }

    sub int_priority_chain :Chained(chain_base) PathPart('') Args(Int) { $_[1]->res->body('int_priority_chain') }

    sub link_any :Chained(chain_base) PathPart('') CaptureArgs(1) { }

      sub any_priority_link_any :Chained(link_any) PathPart('') Args(1) { $_[1]->res->body('any_priority_link_any') }

      sub int_priority_link_any :Chained(link_any) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link_any') }
    
    sub link_int :Chained(chain_base) PathPart('') CaptureArgs(Int) { }

      sub any_priority_link :Chained(link_int) PathPart('') Args(1) { $_[1]->res->body('any_priority_link') }

      sub int_priority_link :Chained(link_int) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link') }

    sub link_int_int :Chained(chain_base) PathPart('') CaptureArgs(Int,Int) { }

      sub any_priority_link2 :Chained(link_int_int) PathPart('') Args(1) { $_[1]->res->body('any_priority_link2') }

      sub int_priority_link2 :Chained(link_int_int) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link2') }

    sub link_tuple :Chained(chain_base) PathPart('') CaptureArgs(Tuple[Int,Int,Int]) { }

      sub any_priority_link3 :Chained(link_tuple) PathPart('') Args(1) { $_[1]->res->body('any_priority_link3') }

      sub int_priority_link3 :Chained(link_tuple) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link3') }

      sub link2_int :Chained(link_tuple) PathPart('') CaptureArgs(UserId) { }

        sub finally2 :GET Chained(link2_int) PathPart('') Args { $_[1]->res->body('finally2') }
        sub finally :GET Chained(link2_int) PathPart('') Args(Int) { $_[1]->res->body('finally') }

  sub default :Default {
    my ($self, $c, $int) = @_;
    $c->res->body('default');
  }

  MyApp::Controller::Root->config(namespace=>'');

  package MyApp;
  use Catalyst;

  MyApp->setup;
}

use Catalyst::Test 'MyApp';

{
  my $res = request '/an_int/1';
  is $res->content, 'an_int';
}

{
  my $res = request '/an_int/aa';
  is $res->content, 'default';
}

{
  my $res = request '/many_ints/1';
  is $res->content, 'many_ints';
}

{
  my $res = request '/many_ints/1/2';
  is $res->content, 'many_ints';
}

{
  my $res = request '/many_ints/1/2/3';
  is $res->content, 'many_ints';
}

{
  my $res = request '/priority_test/1';
  is $res->content, 'int_priority';
}

{
  my $res = request '/priority_test/a';
  is $res->content, 'any_priority';
}

{
  my $res = request '/match/11-22-33';
  is $res->content, 'match';
}

{
  my $res = request '/match/aaa';
  is $res->content, 'default';
}

{
  my $res = request '/user/2';
  is $res->content, 'name: mary, age: 36';
}

{
  my $res = request '/user/20';
  is $res->content, 'default';
}


SKIP: {
  skip "coercion support needs more thought", 1;
  my $res = request '/user_object/20';
  is $res->content, 'default';
}

SKIP: {
  skip "coercion support needs more thought", 1;
  my $res = request '/user_object/2';
  is $res->content, 'name: mary, age: 36';
}

{
  my $res = request '/chain_base/capture/arg';
  is $res->content, 'any_priority_chain';
}

{
  my $res = request '/chain_base/cap1/100/arg';
  is $res->content, 'any_priority_link';
}

{
  my $res = request '/chain_base/cap1/101/102';
  is $res->content, 'int_priority_link';
}

{
  my $res = request '/chain_base/capture/100';
  is $res->content, 'int_priority_chain', 'got expected';
}

{
  my $res = request '/chain_base/cap1/a/arg';
  is $res->content, 'any_priority_link_any';
}

{
  my $res = request '/chain_base/cap1/a/102';
  is $res->content, 'int_priority_link_any';
}

{
  my $res = request '/two_ints/1/2';
  is $res->content, 'two_ints';
}

{
  my $res = request '/two_ints/aa/111';
  is $res->content, 'default';
}

{
  my $res = request '/tuple/aaa/aaa';
  is $res->content, 'default';
}

{
  my $res = request '/tuple/aaa/111';
  is $res->content, 'tuple';
}

{
  my $res = request '/many_ints/1/2/a';
  is $res->content, 'default';
}

{
  my $res = request '/chain_base/100/100/100/100';
  is $res->content, 'int_priority_link2';
}

{
  my $res = request '/chain_base/100/ss/100/100';
  is $res->content, 'default';
}

{
  my $res = request '/chain_base/100/100/100/100/100';
  is $res->content, 'int_priority_link3';
}

{
  my $res = request '/chain_base/100/ss/100/100/100';
  is $res->content, 'default';
}

{
  my $res = request '/chain_base/1/2/3/3/3/6';
  is $res->content, 'finally';
}

{
  my $res = request '/chain_base/1/2/3/3/3/a';
  is $res->content, 'finally2';
}

{
  my $res = request '/chain_base/1/2/3/3/3/6/7/8/9';
  is $res->content, 'finally2';
}

=over

| /chain_base/*/*/*/*/*/*                                     | /chain_base (1)                                             |
|                                                             | -> /link_tuple (Tuple[Int,Int,Int])                         |
|                                                             | -> /link2_int (UserId)                                      |
|                                                             | => GET /finally (Int)  
=cut

{
  # URI testing
  my ($res, $c) = ctx_request '/';
  ok my $url1 = $c->uri_for($c->controller('Root')->action_for('finally'), [1,2,3,4,5],6);
  warn $url1;

  ok my $url2 = $c->uri_for($c->controller('Root')->action_for('finally'), [1,2,3,4,5,6]);
  warn $url2;
}

done_testing;
Commit	Line	Data
d91504e3	1	use warnings;
d91504e3	2	use strict;
842180f7	3
	4	BEGIN {
	5	use Test::More;
	6	eval "use Types::Standard; 1;" \|\| do {
	7	plan skip_all => "Trouble loading Types::Standard => $@";
	8	};
6f0b85d2	9
	10	package MyApp::Types;
	11	$INC{'MyApp/Types.pm'} = __FILE__;
	12
	13	use strict;
	14	use warnings;
	15
	16	use Type::Utils -all;
	17	use Types::Standard -types;
	18	use Type::Library
	19	-base,
	20	-declare => qw( UserId User ContextLike );
	21
	22	extends "Types::Standard";
	23
	24	class_type User, { class => "MyApp::Model::User::user" };
	25	duck_type ContextLike, [qw/model/];
	26
	27	declare UserId,
	28	as Int,
	29	where { $_ < 5 };
	30
a7ab9aa9	31	# Tests using this are skipped pending deeper thought
6f0b85d2	32	coerce User,
	33	from ContextLike,
	34	via { $_->model('User')->find( $_->req->args->[0] ) };
842180f7	35	}
d91504e3	36
d91504e3	37	{
6f0b85d2	38	package MyApp::Model::User;
	39	$INC{'MyApp/Model/User.pm'} = __FILE__;
	40
	41	use base 'Catalyst::Model';
	42
	43	our %users = (
	44	1 => { name => 'john', age => 46 },
	45	2 => { name => 'mary', age => 36 },
	46	3 => { name => 'ian', age => 25 },
	47	4 => { name => 'visha', age => 18 },
	48	);
	49
	50	sub find {
	51	my ($self, $id) = @_;
	52	my $user = $users{$id} \|\| return;
	53	return bless $user, "MyApp::Model::User::user";
	54	}
	55
d91504e3	56	package MyApp::Controller::Root;
	57	$INC{'MyApp/Controller/Root.pm'} = __FILE__;
	58
	59	use Moose;
	60	use MooseX::MethodAttributes;
bf4f1643	61	use MyApp::Types qw/Tuple Int Str StrMatch ArrayRef UserId User/;
d91504e3	62
	63	extends 'Catalyst::Controller';
	64
6f0b85d2	65	sub user :Local Args(UserId) {
	66	my ($self, $c, $int) = @_;
	67	my $user = $c->model("User")->find($int);
	68	$c->res->body("name: $user->{name}, age: $user->{age}");
	69	}
	70
a7ab9aa9	71	# Tests using this are current skipped pending coercion rethink
6f0b85d2	72	sub user_object :Local Args(User) Coerce(1) {
	73	my ($self, $c, $user) = @_;
	74	$c->res->body("name: $user->{name}, age: $user->{age}");
	75	}
	76
6d62355b	77	sub an_int :Local Args(Int) {
6d62355b	78	my ($self, $c, $int) = @_;
6d62355b	79	$c->res->body('an_int');
	80	}
	81
bf4f1643	82	sub two_ints :Local Args(Int,Int) {
	83	my ($self, $c, $int) = @_;
	84	$c->res->body('two_ints');
	85	}
	86
4a0218ca	87	sub many_ints :Local Args(ArrayRef[Int]) {
	88	my ($self, $c, $int) = @_;
	89	$c->res->body('many_ints');
	90	}
	91
842180f7	92	sub tuple :Local Args(Tuple[Str,Int]) {
6f0b85d2	93	my ($self, $c, $str, $int) = @_;
842180f7	94	$c->res->body('tuple');
	95	}
	96
6f0b85d2	97	sub match :Local Args(StrMatch[qr{\d\d-\d\d-\d\d}]) {
	98	my ($self, $c, $int) = @_;
	99	$c->res->body('match');
	100	}
a82c96cf	101
e5604544	102	sub any_priority :Path('priority_test') Args(1) { $_[1]->res->body('any_priority') }
842180f7	103
b7791bd7	104	sub int_priority :Path('priority_test') Args(Int) { $_[1]->res->body('int_priority') }
e5604544	105
a82c96cf	106	sub chain_base :Chained(/) CaptureArgs(1) { }
a82c96cf	107
90102012	108	sub any_priority_chain :GET Chained(chain_base) PathPart('') Args(1) { $_[1]->res->body('any_priority_chain') }
a82c96cf	109
	110	sub int_priority_chain :Chained(chain_base) PathPart('') Args(Int) { $_[1]->res->body('int_priority_chain') }
	111
480d94b5	112	sub link_any :Chained(chain_base) PathPart('') CaptureArgs(1) { }
	113
	114	sub any_priority_link_any :Chained(link_any) PathPart('') Args(1) { $_[1]->res->body('any_priority_link_any') }
	115
	116	sub int_priority_link_any :Chained(link_any) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link_any') }
	117
a82c96cf	118	sub link_int :Chained(chain_base) PathPart('') CaptureArgs(Int) { }
	119
	120	sub any_priority_link :Chained(link_int) PathPart('') Args(1) { $_[1]->res->body('any_priority_link') }
	121
	122	sub int_priority_link :Chained(link_int) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link') }
	123
677c155c	124	sub link_int_int :Chained(chain_base) PathPart('') CaptureArgs(Int,Int) { }
bf4f1643	125
	126	sub any_priority_link2 :Chained(link_int_int) PathPart('') Args(1) { $_[1]->res->body('any_priority_link2') }
	127
	128	sub int_priority_link2 :Chained(link_int_int) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link2') }
	129
677c155c	130	sub link_tuple :Chained(chain_base) PathPart('') CaptureArgs(Tuple[Int,Int,Int]) { }
	131
	132	sub any_priority_link3 :Chained(link_tuple) PathPart('') Args(1) { $_[1]->res->body('any_priority_link3') }
	133
	134	sub int_priority_link3 :Chained(link_tuple) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link3') }
	135
b6847871	136	sub link2_int :Chained(link_tuple) PathPart('') CaptureArgs(UserId) { }
b6847871	137
79b7db20	138	sub finally2 :GET Chained(link2_int) PathPart('') Args { $_[1]->res->body('finally2') }
90102012	139	sub finally :GET Chained(link2_int) PathPart('') Args(Int) { $_[1]->res->body('finally') }
a82c96cf	140
6d62355b	141	sub default :Default {
	142	my ($self, $c, $int) = @_;
	143	$c->res->body('default');
d91504e3	144	}
	145
	146	MyApp::Controller::Root->config(namespace=>'');
	147
	148	package MyApp;
	149	use Catalyst;
	150
	151	MyApp->setup;
	152	}
	153
	154	use Catalyst::Test 'MyApp';
	155
	156	{
6d62355b	157	my $res = request '/an_int/1';
	158	is $res->content, 'an_int';
	159	}
	160
	161	{
337a627a	162	my $res = request '/an_int/aa';
	163	is $res->content, 'default';
	164	}
	165
	166	{
4a0218ca	167	my $res = request '/many_ints/1';
	168	is $res->content, 'many_ints';
	169	}
	170
	171	{
	172	my $res = request '/many_ints/1/2';
	173	is $res->content, 'many_ints';
	174	}
	175
	176	{
	177	my $res = request '/many_ints/1/2/3';
	178	is $res->content, 'many_ints';
	179	}
	180
	181	{
e5604544	182	my $res = request '/priority_test/1';
	183	is $res->content, 'int_priority';
	184	}
842180f7	185
e5604544	186	{
	187	my $res = request '/priority_test/a';
	188	is $res->content, 'any_priority';
	189	}
	190
842180f7	191	{
6f0b85d2	192	my $res = request '/match/11-22-33';
	193	is $res->content, 'match';
	194	}
81436df9	195
6f0b85d2	196	{
	197	my $res = request '/match/aaa';
	198	is $res->content, 'default';
	199	}
	200
	201	{
	202	my $res = request '/user/2';
	203	is $res->content, 'name: mary, age: 36';
	204	}
	205
	206	{
	207	my $res = request '/user/20';
	208	is $res->content, 'default';
	209	}
	210
a7ab9aa9	211
	212	SKIP: {
	213	skip "coercion support needs more thought", 1;
6f0b85d2	214	my $res = request '/user_object/20';
	215	is $res->content, 'default';
	216	}
	217
a7ab9aa9	218	SKIP: {
a7ab9aa9	219	skip "coercion support needs more thought", 1;
6f0b85d2	220	my $res = request '/user_object/2';
	221	is $res->content, 'name: mary, age: 36';
	222	}
	223
a82c96cf	224	{
	225	my $res = request '/chain_base/capture/arg';
	226	is $res->content, 'any_priority_chain';
	227	}
	228
	229	{
	230	my $res = request '/chain_base/cap1/100/arg';
	231	is $res->content, 'any_priority_link';
	232	}
	233
	234	{
	235	my $res = request '/chain_base/cap1/101/102';
	236	is $res->content, 'int_priority_link';
	237	}
	238
	239	{
	240	my $res = request '/chain_base/capture/100';
	241	is $res->content, 'int_priority_chain', 'got expected';
	242	}
	243
480d94b5	244	{
	245	my $res = request '/chain_base/cap1/a/arg';
	246	is $res->content, 'any_priority_link_any';
	247	}
	248
	249	{
	250	my $res = request '/chain_base/cap1/a/102';
	251	is $res->content, 'int_priority_link_any';
	252	}
	253
bf4f1643	254	{
	255	my $res = request '/two_ints/1/2';
	256	is $res->content, 'two_ints';
	257	}
	258
	259	{
	260	my $res = request '/two_ints/aa/111';
	261	is $res->content, 'default';
	262	}
	263
	264	{
	265	my $res = request '/tuple/aaa/aaa';
	266	is $res->content, 'default';
	267	}
	268
	269	{
	270	my $res = request '/tuple/aaa/111';
	271	is $res->content, 'tuple';
	272	}
	273
	274	{
	275	my $res = request '/many_ints/1/2/a';
	276	is $res->content, 'default';
	277	}
	278
	279	{
	280	my $res = request '/chain_base/100/100/100/100';
	281	is $res->content, 'int_priority_link2';
	282	}
	283
	284	{
	285	my $res = request '/chain_base/100/ss/100/100';
	286	is $res->content, 'default';
	287	}
	288
677c155c	289	{
	290	my $res = request '/chain_base/100/100/100/100/100';
	291	is $res->content, 'int_priority_link3';
	292	}
	293
	294	{
	295	my $res = request '/chain_base/100/ss/100/100/100';
	296	is $res->content, 'default';
	297	}
	298
79b7db20	299	{
	300	my $res = request '/chain_base/1/2/3/3/3/6';
	301	is $res->content, 'finally';
	302	}
	303
	304	{
	305	my $res = request '/chain_base/1/2/3/3/3/a';
	306	is $res->content, 'finally2';
	307	}
bf4f1643	308
79b7db20	309	{
	310	my $res = request '/chain_base/1/2/3/3/3/6/7/8/9';
	311	is $res->content, 'finally2';
	312	}
	313
	314	=over
bf4f1643	315
79b7db20	316	\| /chain_base////// \| /chain_base (1) \|
	317	\| \| -> /link_tuple (Tuple[Int,Int,Int]) \|
	318	\| \| -> /link2_int (UserId) \|
	319	\| \| => GET /finally (Int)
b6847871	320	=cut
	321
	322	{
	323	# URI testing
	324	my ($res, $c) = ctx_request '/';
	325	ok my $url1 = $c->uri_for($c->controller('Root')->action_for('finally'), [1,2,3,4,5],6);
	326	warn $url1;
	327
	328	ok my $url2 = $c->uri_for($c->controller('Root')->action_for('finally'), [1,2,3,4,5,6]);
	329	warn $url2;
	330	}
bf4f1643	331
6f0b85d2	332	done_testing;