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

use warnings;
use strict;
use HTTP::Request::Common;

BEGIN {
  use Test::More;
  eval "use Types::Standard; use Type::Utils; use Type::Library; 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 chain_base2 :Chained(/) CaptureArgs(1) { }

    sub chained_zero_post2 :POST Chained(chain_base2) PathPart('') Args(0) { $_[1]->res->body('chained_zero_post2') }
    sub chained_zero2      :     Chained(chain_base2) PathPart('') Args(0) { $_[1]->res->body('chained_zero2') }

    sub chained_zero_post3 :POST Chained(chain_base2) PathPart('') Args(1) { $_[1]->res->body('chained_zero_post3') }
    sub chained_zero3      :     Chained(chain_base2) PathPart('') Args(1) { $_[1]->res->body('chained_zero3') }


  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)                                             |
|                                                             | => /chained_zero (0)                                        |
| /chain_base/*                                               | /chain_base (1)                                             |
|                                                             | => POST /chained_zero_post (0)                              

=cut

{
    my $res = request PUT '/chain_base2/capture/1';
    is $res->content, 'chained_zero3';
}

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

{
    my $res = request POST '/chain_base2/capture/1';
    is $res->content, 'chained_zero3';
}

{
    my $res = request PUT '/chain_base2/capture';
    is $res->content, 'chained_zero2';
}

{
    my $res = request '/chain_base2/capture';
    is $res->content, 'chained_zero2';
}

{
    my $res = request POST '/chain_base2/capture';
    is $res->content, 'chained_zero2';
}

=over

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

=cut


done_testing;

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