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

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

BEGIN {
  use Test::More;
  eval "use Type::Tiny; 1" || do {
    plan skip_all => "Trouble loading Type::Tiny and friends => $@";
  };
}

BEGIN {
  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_again : Chained(chain_base2) PathPart('') Args(0) { $_[1]->res->body('chained_zero_again') }
    sub chained_zero_post2 : 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 : 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';
}


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

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

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

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

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

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

=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;

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