t/lib/TestApp/Controller/Root.pm

   1 package TestApp::Controller::Root;
   2 use strict;
   3 use warnings;
   4 use base 'Catalyst::Controller';
   5
   6 __PACKAGE__->config->{namespace} = '';
   7
   8 sub chain_root_index : Chained('/') PathPart('') Args(0) { }
   9
  10 sub zero : Path('0') {
  11     my ( $self, $c ) = @_;
  12     $c->res->header( 'X-Test-Class' => ref($self) );
  13     $c->response->content_type('text/plain; charset=utf-8');
  14     $c->forward('TestApp::View::Dump::Request');
  15 }
  16
  17 sub zerobody : Local {
  18     my ($self, $c) = @_;
  19     $c->res->body('0');
  20 }
  21
  22 sub emptybody : Local {
  23     my ($self, $c) = @_;
  24     $c->res->body('');
  25 }
  26
  27 sub localregex : LocalRegex('^localregex$') {
  28     my ( $self, $c ) = @_;
  29     $c->res->header( 'X-Test-Class' => ref($self) );
  30     $c->response->content_type('text/plain; charset=utf-8');
  31     $c->forward('TestApp::View::Dump::Request');
  32 }
  33
  34 sub index : Private {
  35     my ( $self, $c ) = @_;
  36     $c->res->body('root index');
  37 }
  38
  39 sub global_action : Private {
  40     my ( $self, $c ) = @_;
  41     $c->forward('TestApp::View::Dump::Request');
  42 }
  43
  44 sub class_forward_test_method :Private {
  45     my ( $self, $c ) = @_;
  46     $c->response->headers->header( 'X-Class-Forward-Test-Method' => 1 );
  47 }
  48
  49 sub loop_test : Local {
  50     my ( $self, $c ) = @_;
  51
  52     for( 1..1001 ) {
  53         $c->forward( 'class_forward_test_method' );
  54     }
  55 }
  56
  57 sub recursion_test : Local {
  58     my ( $self, $c ) = @_;
  59     $c->forward( 'recursion_test' );
  60 }
  61
  62 sub base_href_test : Local {
  63     my ( $self, $c ) = @_;
  64
  65     my $body = <<"EndOfBody";
  66 <html>
  67   <head>
  68     <base href="http://www.example.com/">
  69   </head>
  70   <body>
  71   </body>
  72 </html>
  73 EndOfBody
  74
  75     $c->response->body($body);
  76 }
  77
  78 sub body_semipredicate : Local {
  79     my ($self, $c) = @_;
  80     $c->res->body; # Old code tests length($c->res->body), which causes the value to be built (undef), which causes the predicate
  81     $c->res->status( $c->res->has_body ? 500 : 200 ); # to return the wrong thing, resulting in a 500.
  82     $c->res->body('Body');
  83 }
  84
  85
  86 sub test_redirect :Global {
  87     my ($self, $c) = @_;
  88     # Don't set content_type
  89     # Don't set body
  90     $c->res->redirect('/go_here');
  91 }
  92
  93 sub test_redirect_with_contenttype :Global {
  94     my ($self, $c) = @_;
  95     # set content_type but don't set body
  96     $c->res->content_type('image/jpeg');
  97     $c->res->redirect('/go_here');
  98 }
  99
 100 sub test_redirect_with_content :Global {
 101     my ($self, $c) = @_;
 102     $c->res->content_type('text/plain');
 103     $c->res->body('Please kind sir, I beg you to go to /go_here.');
 104     $c->res->redirect('/go_here');
 105 }
 106
 107 sub end : Private {
 108     my ($self,$c) = @_;
 109 }
 110
 111 1;