[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_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


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