t/arg_constraints.t

   1 use warnings;
   2 use strict;
   3 use HTTP::Request::Common;
   4 use utf8;
   5
   6 BEGIN {
   7   use Test::More;
   8   eval "use Type::Tiny 1.000005; 1" || do {
   9     plan skip_all => "Trouble loading Type::Tiny and friends => $@";
  10   };
  11 }
  12
  13 BEGIN {
  14   package MyApp::Types;
  15   $INC{'MyApp/Types.pm'} = __FILE__;
  16
  17   use strict;
  18   use warnings;
  19
  20   use Type::Utils -all;
  21   use Types::Standard -types;
  22   use Type::Library
  23    -base,
  24    -declare => qw( UserId Heart User ContextLike );
  25
  26   extends "Types::Standard";
  27
  28   class_type User, { class => "MyApp::Model::User::user" };
  29   duck_type ContextLike, [qw/model/];
  30
  31   declare UserId,
  32    as Int,
  33    where { $_ < 5 };
  34
  35   declare Heart,
  36    as Str,
  37    where { $_ eq '♥' };
  38
  39   # Tests using this are skipped pending deeper thought
  40   coerce User,
  41    from ContextLike,
  42      via { $_->model('User')->find( $_->req->args->[0] ) };
  43 }
  44
  45 {
  46   package MyApp::Role::Controller;
  47   $INC{'MyApp/Role/Controller.pm'} = __FILE__;
  48
  49   use Moose::Role;
  50   use MooseX::MethodAttributes::Role;
  51   use MyApp::Types qw/Int Str/;
  52
  53   sub role_str :Path('role_test') Args(Str) {
  54     my ($self, $c, $arg) = @_;
  55     $c->res->body('role_str'.$arg);
  56   }
  57
  58   sub role_int :Path('role_test') Args(Int) {
  59     my ($self, $c, $arg) = @_;
  60     $c->res->body('role_int'.$arg);
  61   }
  62
  63   package MyApp::Model::User;
  64   $INC{'MyApp/Model/User.pm'} = __FILE__;
  65
  66   use base 'Catalyst::Model';
  67
  68   our %users = (
  69     1 => { name => 'john', age => 46 },
  70     2 => { name => 'mary', age => 36 },
  71     3 => { name => 'ian', age => 25 },
  72     4 => { name => 'visha', age => 18 },
  73   );
  74
  75   sub find {
  76     my ($self, $id) = @_;
  77     my $user = $users{$id} || return;
  78     return bless $user, "MyApp::Model::User::user";
  79   }
  80
  81   package MyApp::Controller::Root;
  82   $INC{'MyApp/Controller/Root.pm'} = __FILE__;
  83
  84   use Moose;
  85   use MooseX::MethodAttributes;
  86   use Types::Standard qw/slurpy/;
  87   use MyApp::Types qw/Tuple Int Str StrMatch ArrayRef UserId User Heart/;
  88
  89   extends 'Catalyst::Controller';
  90   with 'MyApp::Role::Controller';
  91
  92
  93   sub user :Local Args(UserId) {
  94     my ($self, $c, $int) = @_;
  95     my $user = $c->model("User")->find($int);
  96     $c->res->body("name: $user->{name}, age: $user->{age}");
  97   }
  98
  99   # Tests using this are current skipped pending coercion rethink
 100   sub user_object :Local Args(User) Coerce(1) {
 101     my ($self, $c, $user) = @_;
 102     $c->res->body("name: $user->{name}, age: $user->{age}");
 103   }
 104
 105   sub stringy_enum :Local Args('Int',Int) {
 106     my ($self, $c) = @_;
 107     $c->res->body('enum');
 108   }
 109
 110   sub an_int :Local Args(Int) {
 111     my ($self, $c, $int) = @_;
 112     $c->res->body('an_int');
 113   }
 114
 115   sub two_ints :Local Args(Int,Int) {
 116     my ($self, $c, $int) = @_;
 117     $c->res->body('two_ints');
 118   }
 119
 120   sub many_ints :Local Args(ArrayRef[Int]) {
 121     my ($self, $c, @ints) = @_;
 122     $c->res->body('many_ints');
 123   }
 124
 125   sub tuple :Local Args(Tuple[Str,Int]) {
 126     my ($self, $c, $str, $int) = @_;
 127     $c->res->body('tuple');
 128   }
 129
 130   sub slurpy_tuple :Local Args(Tuple[Str,Int, slurpy ArrayRef[Int]]) {
 131     my ($self, $c, $str, $int) = @_;
 132     $c->res->body('tuple');
 133   }
 134
 135   sub match :Local Args(StrMatch[qr{\d\d-\d\d-\d\d}]) {
 136     my ($self, $c, $int) = @_;
 137     $c->res->body('match');
 138   }
 139
 140   sub any_priority :Path('priority_test') Args(1) { $_[1]->res->body('any_priority') }
 141
 142   sub int_priority :Path('priority_test') Args(Int) { $_[1]->res->body('int_priority') }
 143
 144   sub chain_base :Chained(/) CaptureArgs(1) { }
 145
 146     sub any_priority_chain :GET Chained(chain_base) PathPart('') Args(1) { $_[1]->res->body('any_priority_chain') }
 147
 148     sub int_priority_chain :Chained(chain_base) PathPart('') Args(Int) { $_[1]->res->body('int_priority_chain') }
 149
 150     sub link_any :Chained(chain_base) PathPart('') CaptureArgs(1) { }
 151
 152       sub any_priority_link_any :Chained(link_any) PathPart('') Args(1) { $_[1]->res->body('any_priority_link_any') }
 153
 154       sub int_priority_link_any :Chained(link_any) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link_any') }
 155
 156     sub link_int :Chained(chain_base) PathPart('') CaptureArgs(Int) { }
 157
 158       sub any_priority_link :Chained(link_int) PathPart('') Args(1) { $_[1]->res->body('any_priority_link') }
 159
 160       sub int_priority_link :Chained(link_int) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link') }
 161
 162     sub link_int_int :Chained(chain_base) PathPart('') CaptureArgs(Int,Int) { }
 163
 164       sub any_priority_link2 :Chained(link_int_int) PathPart('') Args(1) { $_[1]->res->body('any_priority_link2') }
 165
 166       sub int_priority_link2 :Chained(link_int_int) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link2') }
 167
 168     sub link_tuple :Chained(chain_base) PathPart('') CaptureArgs(Tuple[Int,Int,Int]) { }
 169
 170       sub any_priority_link3 :Chained(link_tuple) PathPart('') Args(1) { $_[1]->res->body('any_priority_link3') }
 171
 172       sub int_priority_link3 :Chained(link_tuple) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link3') }
 173
 174       sub link2_int :Chained(link_tuple) PathPart('') CaptureArgs(UserId) { }
 175
 176         sub finally2 :GET Chained(link2_int) PathPart('') Args { $_[1]->res->body('finally2') }
 177         sub finally :GET Chained(link2_int) PathPart('') Args(Int) { $_[1]->res->body('finally') }
 178
 179   sub chain_base2 :Chained(/) CaptureArgs(1) { }
 180
 181     sub chained_zero_again : Chained(chain_base2) PathPart('') Args(0) { $_[1]->res->body('chained_zero_again') }
 182     sub chained_zero_post2 : Chained(chain_base2) PathPart('') Args(0) { $_[1]->res->body('chained_zero_post2') }
 183     sub chained_zero2      :     Chained(chain_base2) PathPart('') Args(0) { $_[1]->res->body('chained_zero2') }
 184
 185     sub chained_zero_post3 : Chained(chain_base2) PathPart('') Args(1) { $_[1]->res->body('chained_zero_post3') }
 186     sub chained_zero3      :     Chained(chain_base2) PathPart('') Args(1) { $_[1]->res->body('chained_zero3') }
 187
 188
 189   sub heart :Local Args(Heart) { }
 190
 191   sub utf8_base :Chained(/) CaptureArgs(Heart) { }
 192     sub utf8_end :Chained(utf8_base) PathPart('') Args(Heart) { }
 193
 194   sub default :Default {
 195     my ($self, $c, $int) = @_;
 196     $c->res->body('default');
 197   }
 198
 199   MyApp::Controller::Root->config(namespace=>'');
 200
 201   package MyApp::Controller::Autoclean;
 202   $INC{'MyApp/Controller/Autoclean.pm'} = __FILE__;
 203
 204   use Moose;
 205   use MooseX::MethodAttributes;
 206   use namespace::clean -except => [ 'meta' ];
 207
 208   use MyApp::Types qw/Int/;
 209
 210   extends 'Catalyst::Controller';
 211
 212   sub an_int :Local Args(Int) {
 213     my ($self, $c, $int) = @_;
 214     $c->res->body('an_int (autoclean)');
 215   }
 216
 217   MyApp::Controller::Autoclean->config(namespace=>'autoclean');
 218
 219   package MyApp::Role;
 220   $INC{'MyApp/Role.pm'} = __FILE__;
 221
 222   use Moose::Role;
 223   use MooseX::MethodAttributes::Role;
 224   use MyApp::Types qw/Int/;
 225
 226   sub an_int :Local Args(Int) {
 227     my ($self, $c, $int) = @_;
 228     $c->res->body('an_int (withrole)');
 229   }
 230
 231   sub an_int_ns :Local Args(MyApp::Types::Int) {
 232     my ($self, $c, $int) = @_;
 233     $c->res->body('an_int (withrole)');
 234   }
 235
 236   package MyApp::BaseController;
 237   $INC{'MyApp/BaseController.pm'} = __FILE__;
 238
 239   use Moose;
 240   use MooseX::MethodAttributes;
 241   use MyApp::Types qw/Int/;
 242
 243   extends 'Catalyst::Controller';
 244
 245   sub from_parent :Local Args(Int) {
 246     my ($self, $c, $id) = @_;
 247     $c->res->body("from_parent $id");
 248   }
 249
 250   package MyApp::Controller::WithRole;
 251   $INC{'MyApp/Controller/WithRole.pm'} = __FILE__;
 252
 253   use Moose;
 254   use MooseX::MethodAttributes;
 255
 256   extends 'MyApp::BaseController';
 257
 258   with 'MyApp::Role';
 259
 260   MyApp::Controller::WithRole->config(namespace=>'withrole');
 261
 262   package MyApp;
 263   use Catalyst;
 264
 265   MyApp->setup('-Log=fatal');
 266 }
 267
 268 use Catalyst::Test 'MyApp';
 269
 270 {
 271   my $res = request '/an_int/1';
 272   is $res->content, 'an_int';
 273 }
 274
 275 {
 276   my $res = request '/an_int/aa';
 277   is $res->content, 'default';
 278 }
 279
 280 {
 281   my $res = request '/many_ints/1';
 282   is $res->content, 'many_ints';
 283 }
 284
 285 {
 286   my $res = request '/many_ints/1/2';
 287   is $res->content, 'many_ints';
 288 }
 289
 290 {
 291   my $res = request '/many_ints/1/2/3';
 292   is $res->content, 'many_ints';
 293 }
 294
 295 {
 296   my $res = request '/priority_test/1';
 297   is $res->content, 'int_priority';
 298 }
 299
 300 {
 301   my $res = request '/priority_test/a';
 302   is $res->content, 'any_priority';
 303 }
 304
 305 {
 306   my $res = request '/match/11-22-33';
 307   is $res->content, 'match';
 308 }
 309
 310 {
 311   my $res = request '/match/aaa';
 312   is $res->content, 'default';
 313 }
 314
 315 {
 316   my $res = request '/user/2';
 317   is $res->content, 'name: mary, age: 36';
 318 }
 319
 320 {
 321   my $res = request '/user/20';
 322   is $res->content, 'default';
 323 }
 324
 325
 326 SKIP: {
 327   skip "coercion support needs more thought", 1;
 328   my $res = request '/user_object/20';
 329   is $res->content, 'default';
 330 }
 331
 332 SKIP: {
 333   skip "coercion support needs more thought", 1;
 334   my $res = request '/user_object/2';
 335   is $res->content, 'name: mary, age: 36';
 336 }
 337
 338 {
 339   my $res = request '/chain_base/capture/arg';
 340   is $res->content, 'any_priority_chain';
 341 }
 342
 343 {
 344   my $res = request '/chain_base/cap1/100/arg';
 345   is $res->content, 'any_priority_link';
 346 }
 347
 348 {
 349   my $res = request '/chain_base/cap1/101/102';
 350   is $res->content, 'int_priority_link';
 351 }
 352
 353 {
 354   my $res = request '/chain_base/capture/100';
 355   is $res->content, 'int_priority_chain', 'got expected';
 356 }
 357
 358 {
 359   my $res = request '/chain_base/cap1/a/arg';
 360   is $res->content, 'any_priority_link_any';
 361 }
 362
 363 {
 364   my $res = request '/chain_base/cap1/a/102';
 365   is $res->content, 'int_priority_link_any';
 366 }
 367
 368 {
 369   my $res = request '/two_ints/1/2';
 370   is $res->content, 'two_ints';
 371 }
 372
 373 {
 374   my $res = request '/two_ints/aa/111';
 375   is $res->content, 'default';
 376 }
 377
 378 {
 379   my $res = request '/tuple/aaa/aaa';
 380   is $res->content, 'default';
 381 }
 382
 383 {
 384   my $res = request '/tuple/aaa/111';
 385   is $res->content, 'tuple';
 386 }
 387
 388 {
 389   my $res = request '/tuple/aaa/111/111/111';
 390   is $res->content, 'default';
 391 }
 392
 393 {
 394   my $res = request '/slurpy_tuple/aaa/111/111/111';
 395   is $res->content, 'tuple';
 396 }
 397
 398
 399 {
 400   my $res = request '/many_ints/1/2/a';
 401   is $res->content, 'default';
 402 }
 403
 404 {
 405   my $res = request '/chain_base/100/100/100/100';
 406   is $res->content, 'int_priority_link2';
 407 }
 408
 409 {
 410   my $res = request '/chain_base/100/ss/100/100';
 411   is $res->content, 'default';
 412 }
 413
 414 {
 415   my $res = request '/chain_base/100/100/100/100/100';
 416   is $res->content, 'int_priority_link3';
 417 }
 418
 419 {
 420   my $res = request '/chain_base/100/ss/100/100/100';
 421   is $res->content, 'default';
 422 }
 423
 424 {
 425   my $res = request '/chain_base/1/2/3/3/3/6';
 426   is $res->content, 'finally';
 427 }
 428
 429 {
 430   my $res = request '/chain_base/1/2/3/3/3/a';
 431   is $res->content, 'finally2';
 432 }
 433
 434 {
 435   my $res = request '/chain_base/1/2/3/3/3/6/7/8/9';
 436   is $res->content, 'finally2';
 437 }
 438
 439
 440 {
 441     my $res = request PUT '/chain_base2/capture/1';
 442     is $res->content, 'chained_zero3', "request PUT '/chain_base2/capture/1'";
 443 }
 444
 445 {
 446     my $res = request '/chain_base2/capture/1';
 447     is $res->content, 'chained_zero3', "request '/chain_base2/capture/1'";
 448 }
 449
 450 {
 451     my $res = request POST '/chain_base2/capture/1';
 452     is $res->content, 'chained_zero3', "request POST '/chain_base2/capture/1'";
 453 }
 454
 455 {
 456     my $res = request PUT '/chain_base2/capture';
 457     is $res->content, 'chained_zero2', "request PUT '/chain_base2/capture'";
 458 }
 459
 460 {
 461     my $res = request '/chain_base2/capture';
 462     is $res->content, 'chained_zero2', "request '/chain_base2/capture'";
 463 }
 464
 465 {
 466     my $res = request POST '/chain_base2/capture';
 467     is $res->content, 'chained_zero2', "request POST '/chain_base2/capture'";
 468 }
 469
 470 {
 471     my $res = request '/stringy_enum/1/2';
 472     is $res->content, 'enum', "request '/stringy_enum/a'";
 473 }
 474
 475 {
 476     my $res = request '/stringy_enum/b/2';
 477     is $res->content, 'default', "request '/stringy_enum/a'";
 478 }
 479
 480 {
 481     my $res = request '/stringy_enum/1/a';
 482     is $res->content, 'default', "request '/stringy_enum/a'";
 483 }
 484
 485 =over
 486
 487 | /chain_base/*/*/*/*/*/*                 | /chain_base (1)
 488 |                                         | -> /link_tuple (Tuple[Int,Int,Int])
 489 |                                         | -> /link2_int (UserId)
 490 |                                         | => GET /finally (Int)
 491
 492 =cut
 493
 494 {
 495   # URI testing
 496   my ($res, $c) = ctx_request '/';
 497
 498   {
 499     ok my $url = eval { $c->uri_for($c->controller('Root')->action_for('user'), 2) };
 500     is $url, 'http://localhost/user/2';
 501   }
 502
 503   {
 504     ok my $url = eval { $c->uri_for($c->controller('Root')->action_for('user'), [2]) };
 505     is $url, 'http://localhost/user/2';
 506   }
 507
 508   {
 509     ok my $url = ! eval { $c->uri_for($c->controller('Root')->action_for('user'), [20]) };
 510   }
 511
 512   {
 513     ok my $url = eval { $c->uri_for($c->controller('Root')->action_for('finally'), [1,2,3,4,4],6) };
 514     is $url, 'http://localhost/chain_base/1/2/3/4/4/6';
 515   }
 516
 517   {
 518     ok my $url = eval { $c->uri_for($c->controller('Root')->action_for('finally'), [1,2,3,4,4,6]) };
 519     is $url, 'http://localhost/chain_base/1/2/3/4/4/6';
 520   }
 521
 522   {
 523     ok my $url = ! eval { $c->uri_for($c->controller('Root')->action_for('finally'), [1,2,3,4,5,6]) };
 524   }
 525
 526   {
 527     ok my $url = eval { $c->uri_for($c->controller('Root')->action_for('finally'), ['a',2,3,4,4,6]) };
 528     is $url, 'http://localhost/chain_base/a/2/3/4/4/6';
 529   }
 530
 531   {
 532     ok my $url = ! eval { $c->uri_for($c->controller('Root')->action_for('finally'), ['a','1',3,4,4,'a']) };
 533   }
 534
 535   {
 536     ok my $url = ! eval { $c->uri_for($c->controller('Root')->action_for('finally'), ['a','a',3,4,4,'6']) };
 537   }
 538
 539   {
 540     ok my $url = eval { $c->uri_for($c->controller('Root')->action_for('heart'), ['♥']) };
 541     is $url, 'http://localhost/heart/%E2%99%A5';
 542   }
 543
 544   {
 545     ok my $url = ! eval { $c->uri_for($c->controller('Root')->action_for('heart'), ['1']) };
 546   }
 547
 548   {
 549     ok my $url = eval { $c->uri_for($c->controller('Root')->action_for('utf8_end'), ['♥','♥']) };
 550     is $url, 'http://localhost/utf8_base/%E2%99%A5/%E2%99%A5';
 551   }
 552
 553   {
 554     ok my $url = ! eval { $c->uri_for($c->controller('Root')->action_for('utf8_end'), ['2','1']) };
 555   }
 556
 557 }
 558
 559 # Test Roles
 560
 561 {
 562     my $res = request '/role_test/1';
 563     is $res->content, 'role_int1';
 564 }
 565
 566 {
 567     my $res = request '/role_test/a';
 568     is $res->content, 'role_stra';
 569 }
 570
 571
 572 {
 573   my $res = request '/autoclean/an_int/1';
 574   is $res->content, 'an_int (autoclean)';
 575 }
 576
 577 {
 578   my $res = request '/withrole/an_int_ns/S';
 579   is $res->content, 'default';
 580 }
 581
 582 {
 583   my $res = request '/withrole/an_int_ns/111';
 584   is $res->content, 'an_int (withrole)';
 585 }
 586
 587 {
 588   my $res = request '/withrole/an_int/1';
 589   is $res->content, 'an_int (withrole)';
 590 }
 591
 592 {
 593   my $res = request '/withrole/from_parent/1';
 594   is $res->content, 'from_parent 1';
 595 }
 596 done_testing;