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

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

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 chained_zero_post :POST Chained(chain_base) PathPart('') Args(0) { $_[1]->res->body('chained_zero_post') }
    sub chained_zero      :     Chained(chain_base) PathPart('') Args(0) { $_[1]->res->body('chained_zero') }

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

=cut

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

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

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

=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;
b4037086	3	use HTTP::Request::Common;
842180f7	4
	5	BEGIN {
	6	use Test::More;
	7	eval "use Types::Standard; 1;" \|\| do {
	8	plan skip_all => "Trouble loading Types::Standard => $@";
	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
b4037086	109	sub chained_zero_post :POST Chained(chain_base) PathPart('') Args(0) { $_[1]->res->body('chained_zero_post') }
	110	sub chained_zero : Chained(chain_base) PathPart('') Args(0) { $_[1]->res->body('chained_zero') }
	111
90102012	112	sub any_priority_chain :GET Chained(chain_base) PathPart('') Args(1) { $_[1]->res->body('any_priority_chain') }
a82c96cf	113
	114	sub int_priority_chain :Chained(chain_base) PathPart('') Args(Int) { $_[1]->res->body('int_priority_chain') }
	115
480d94b5	116	sub link_any :Chained(chain_base) PathPart('') CaptureArgs(1) { }
	117
	118	sub any_priority_link_any :Chained(link_any) PathPart('') Args(1) { $_[1]->res->body('any_priority_link_any') }
	119
	120	sub int_priority_link_any :Chained(link_any) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link_any') }
	121
a82c96cf	122	sub link_int :Chained(chain_base) PathPart('') CaptureArgs(Int) { }
	123
	124	sub any_priority_link :Chained(link_int) PathPart('') Args(1) { $_[1]->res->body('any_priority_link') }
	125
	126	sub int_priority_link :Chained(link_int) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link') }
	127
677c155c	128	sub link_int_int :Chained(chain_base) PathPart('') CaptureArgs(Int,Int) { }
bf4f1643	129
	130	sub any_priority_link2 :Chained(link_int_int) PathPart('') Args(1) { $_[1]->res->body('any_priority_link2') }
	131
	132	sub int_priority_link2 :Chained(link_int_int) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link2') }
	133
677c155c	134	sub link_tuple :Chained(chain_base) PathPart('') CaptureArgs(Tuple[Int,Int,Int]) { }
	135
	136	sub any_priority_link3 :Chained(link_tuple) PathPart('') Args(1) { $_[1]->res->body('any_priority_link3') }
	137
	138	sub int_priority_link3 :Chained(link_tuple) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link3') }
	139
b6847871	140	sub link2_int :Chained(link_tuple) PathPart('') CaptureArgs(UserId) { }
b6847871	141
79b7db20	142	sub finally2 :GET Chained(link2_int) PathPart('') Args { $_[1]->res->body('finally2') }
90102012	143	sub finally :GET Chained(link2_int) PathPart('') Args(Int) { $_[1]->res->body('finally') }
a82c96cf	144
6d62355b	145	sub default :Default {
	146	my ($self, $c, $int) = @_;
	147	$c->res->body('default');
d91504e3	148	}
	149
	150	MyApp::Controller::Root->config(namespace=>'');
	151
	152	package MyApp;
	153	use Catalyst;
	154
	155	MyApp->setup;
	156	}
	157
	158	use Catalyst::Test 'MyApp';
	159
	160	{
6d62355b	161	my $res = request '/an_int/1';
	162	is $res->content, 'an_int';
	163	}
	164
	165	{
337a627a	166	my $res = request '/an_int/aa';
	167	is $res->content, 'default';
	168	}
	169
	170	{
4a0218ca	171	my $res = request '/many_ints/1';
	172	is $res->content, 'many_ints';
	173	}
	174
	175	{
	176	my $res = request '/many_ints/1/2';
	177	is $res->content, 'many_ints';
	178	}
	179
	180	{
	181	my $res = request '/many_ints/1/2/3';
	182	is $res->content, 'many_ints';
	183	}
	184
	185	{
e5604544	186	my $res = request '/priority_test/1';
	187	is $res->content, 'int_priority';
	188	}
842180f7	189
e5604544	190	{
	191	my $res = request '/priority_test/a';
	192	is $res->content, 'any_priority';
	193	}
	194
842180f7	195	{
6f0b85d2	196	my $res = request '/match/11-22-33';
	197	is $res->content, 'match';
	198	}
81436df9	199
6f0b85d2	200	{
	201	my $res = request '/match/aaa';
	202	is $res->content, 'default';
	203	}
	204
	205	{
	206	my $res = request '/user/2';
	207	is $res->content, 'name: mary, age: 36';
	208	}
	209
	210	{
	211	my $res = request '/user/20';
	212	is $res->content, 'default';
	213	}
	214
a7ab9aa9	215
	216	SKIP: {
	217	skip "coercion support needs more thought", 1;
6f0b85d2	218	my $res = request '/user_object/20';
	219	is $res->content, 'default';
	220	}
	221
a7ab9aa9	222	SKIP: {
a7ab9aa9	223	skip "coercion support needs more thought", 1;
6f0b85d2	224	my $res = request '/user_object/2';
	225	is $res->content, 'name: mary, age: 36';
	226	}
	227
a82c96cf	228	{
	229	my $res = request '/chain_base/capture/arg';
	230	is $res->content, 'any_priority_chain';
	231	}
	232
	233	{
	234	my $res = request '/chain_base/cap1/100/arg';
	235	is $res->content, 'any_priority_link';
	236	}
	237
	238	{
	239	my $res = request '/chain_base/cap1/101/102';
	240	is $res->content, 'int_priority_link';
	241	}
	242
	243	{
	244	my $res = request '/chain_base/capture/100';
	245	is $res->content, 'int_priority_chain', 'got expected';
	246	}
	247
480d94b5	248	{
	249	my $res = request '/chain_base/cap1/a/arg';
	250	is $res->content, 'any_priority_link_any';
	251	}
	252
	253	{
	254	my $res = request '/chain_base/cap1/a/102';
	255	is $res->content, 'int_priority_link_any';
	256	}
	257
bf4f1643	258	{
	259	my $res = request '/two_ints/1/2';
	260	is $res->content, 'two_ints';
	261	}
	262
	263	{
	264	my $res = request '/two_ints/aa/111';
	265	is $res->content, 'default';
	266	}
	267
	268	{
	269	my $res = request '/tuple/aaa/aaa';
	270	is $res->content, 'default';
	271	}
	272
	273	{
	274	my $res = request '/tuple/aaa/111';
	275	is $res->content, 'tuple';
	276	}
	277
	278	{
	279	my $res = request '/many_ints/1/2/a';
	280	is $res->content, 'default';
	281	}
	282
	283	{
	284	my $res = request '/chain_base/100/100/100/100';
	285	is $res->content, 'int_priority_link2';
	286	}
	287
	288	{
	289	my $res = request '/chain_base/100/ss/100/100';
	290	is $res->content, 'default';
	291	}
	292
677c155c	293	{
	294	my $res = request '/chain_base/100/100/100/100/100';
	295	is $res->content, 'int_priority_link3';
	296	}
	297
	298	{
	299	my $res = request '/chain_base/100/ss/100/100/100';
	300	is $res->content, 'default';
	301	}
	302
79b7db20	303	{
	304	my $res = request '/chain_base/1/2/3/3/3/6';
	305	is $res->content, 'finally';
	306	}
	307
	308	{
	309	my $res = request '/chain_base/1/2/3/3/3/a';
	310	is $res->content, 'finally2';
	311	}
bf4f1643	312
79b7db20	313	{
	314	my $res = request '/chain_base/1/2/3/3/3/6/7/8/9';
	315	is $res->content, 'finally2';
	316	}
	317
	318	=over
bf4f1643	319
b4037086	320	\| /chain_base/* \| /chain_base (1) \|
	321	\| \| => /chained_zero (0) \|
	322	\| /chain_base/* \| /chain_base (1) \|
	323	\| \| => POST /chained_zero_post (0)
	324
	325	=cut
	326
	327	{
	328	my $res = request PUT '/chain_base/capture';
	329	is $res->content, 'chained_zero';
	330	}
	331
	332	{
	333	my $res = request '/chain_base/capture';
	334	is $res->content, 'chained_zero';
	335	}
	336
	337	{
	338	my $res = request POST '/chain_base/capture';
	339	is $res->content, 'chained_zero_post';
	340	}
	341
	342	=over
	343
	344	\| /chain_base////// \| /chain_base (1)
	345	\| \| -> /link_tuple (Tuple[Int,Int,Int])
	346	\| \| -> /link2_int (UserId)
	347	\| \| => GET /finally (Int)
	348
b6847871	349	=cut
	350
	351	{
	352	# URI testing
	353	my ($res, $c) = ctx_request '/';
	354	ok my $url1 = $c->uri_for($c->controller('Root')->action_for('finally'), [1,2,3,4,5],6);
	355	warn $url1;
	356
	357	ok my $url2 = $c->uri_for($c->controller('Root')->action_for('finally'), [1,2,3,4,5,6]);
	358	warn $url2;
	359	}
bf4f1643	360
6f0b85d2	361	done_testing;