t/lib/TestApp/Controller/Root.pm

   1 package TestApp::Controller::Root;
   2 use strict;
   3 use warnings;
   4 use base 'Catalyst::Controller';
   5 use utf8;
   6
   7 __PACKAGE__->config->{namespace} = '';
   8
   9 sub chain_root_index : Chained('/') PathPart('') Args(0) { }
  10
  11 sub zero : Path('0') {
  12     my ( $self, $c ) = @_;
  13     $c->res->header( 'X-Test-Class' => ref($self) );
  14     $c->response->content_type('text/plain; charset=utf-8');
  15     $c->forward('TestApp::View::Dump::Request');
  16 }
  17
  18 sub zerobody : Local {
  19     my ($self, $c) = @_;
  20     $c->res->body('0');
  21 }
  22
  23 sub emptybody : Local {
  24     my ($self, $c) = @_;
  25     $c->res->body('');
  26 }
  27
  28 sub index : Private {
  29     my ( $self, $c ) = @_;
  30     $c->res->body('root index');
  31 }
  32
  33 sub global_action : Private {
  34     my ( $self, $c ) = @_;
  35     $c->forward('TestApp::View::Dump::Request');
  36 }
  37
  38 sub class_forward_test_method :Private {
  39     my ( $self, $c ) = @_;
  40     $c->response->headers->header( 'X-Class-Forward-Test-Method' => 1 );
  41 }
  42
  43 sub loop_test : Local {
  44     my ( $self, $c ) = @_;
  45
  46     for( 1..1001 ) {
  47         $c->forward( 'class_forward_test_method' );
  48     }
  49 }
  50
  51 sub recursion_test : Local {
  52     my ( $self, $c ) = @_;
  53     no warnings 'recursion';
  54     $c->forward( 'recursion_test' );
  55 }
  56
  57 sub base_href_test : Local {
  58     my ( $self, $c ) = @_;
  59
  60     my $body = <<"EndOfBody";
  61 <html>
  62   <head>
  63     <base href="http://www.example.com/">
  64   </head>
  65   <body>
  66   </body>
  67 </html>
  68 EndOfBody
  69
  70     $c->response->body($body);
  71 }
  72
  73 sub body_semipredicate : Local {
  74     my ($self, $c) = @_;
  75     $c->res->body; # Old code tests length($c->res->body), which causes the value to be built (undef), which causes the predicate
  76     $c->res->status( $c->res->has_body ? 500 : 200 ); # to return the wrong thing, resulting in a 500.
  77     $c->res->body('Body');
  78 }
  79
  80
  81 sub test_redirect :Global {
  82     my ($self, $c) = @_;
  83     # Don't set content_type
  84     # Don't set body
  85     $c->res->redirect('/go_here');
  86     # route for /go_here doesn't exist
  87     # it is only for checking HTTP response code, content-type etc.
  88 }
  89
  90 sub test_redirect_uri_for :Global {
  91     my ($self, $c) = @_;
  92     # Don't set content_type
  93     # Don't set body
  94     $c->res->redirect($c->uri_for('/go_here'));
  95     # route for /go_here doesn't exist
  96     # it is only for checking HTTP response code, content-type etc.
  97 }
  98
  99 sub test_redirect_with_contenttype :Global {
 100     my ($self, $c) = @_;
 101     # set content_type but don't set body
 102     $c->res->content_type('image/jpeg');
 103     $c->res->redirect('/go_here');
 104     # route for /go_here doesn't exist
 105     # it is only for checking HTTP response code, content-type etc.
 106 }
 107
 108 sub test_redirect_with_content :Global {
 109     my ($self, $c) = @_;
 110     $c->res->content_type('text/plain');
 111     $c->res->body('Please kind sir, I beg you to go to /go_here.');
 112     $c->res->redirect('/go_here');
 113     # route for /go_here doesn't exist
 114     # it is only for checking HTTP response code, content-type etc.
 115 }
 116
 117 sub test_remove_body_with_304 :Global {
 118     my ($self, $c) = @_;
 119     $c->res->status(304);
 120     $c->res->content_type('text/html');
 121     $c->res->body("<html><body>Body should not be set</body></html>");
 122 }
 123
 124 sub test_remove_body_with_204 :Global {
 125     my ($self, $c) = @_;
 126     $c->res->status(204);
 127     $c->res->content_type('text/html');
 128     $c->res->body("<html><body>Body should not be set</body></html>");
 129 }
 130
 131 sub test_remove_body_with_100 :Global {
 132     my ($self, $c) = @_;
 133     $c->res->status(100);
 134     $c->res->body("<html><body>Body should not be set</body></html>");
 135 }
 136
 137 sub test_nobody_with_100 :Global {
 138     my ($self, $c) = @_;
 139     $c->res->status(100);
 140 }
 141
 142 sub end : Private {
 143     my ($self,$c) = @_;
 144 }
 145
 146 1;