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     no warnings 'recursion';
  60     $c->forward( 'recursion_test' );
  61 }
  62
  63 sub base_href_test : Local {
  64     my ( $self, $c ) = @_;
  65
  66     my $body = <<"EndOfBody";
  67 <html>
  68   <head>
  69     <base href="http://www.example.com/">
  70   </head>
  71   <body>
  72   </body>
  73 </html>
  74 EndOfBody
  75
  76     $c->response->body($body);
  77 }
  78
  79 sub body_semipredicate : Local {
  80     my ($self, $c) = @_;
  81     $c->res->body; # Old code tests length($c->res->body), which causes the value to be built (undef), which causes the predicate
  82     $c->res->status( $c->res->has_body ? 500 : 200 ); # to return the wrong thing, resulting in a 500.
  83     $c->res->body('Body');
  84 }
  85
  86
  87 sub test_redirect :Global {
  88     my ($self, $c) = @_;
  89     # Don't set content_type
  90     # Don't set body
  91     $c->res->redirect('/go_here');
  92 }
  93
  94 sub test_redirect_with_contenttype :Global {
  95     my ($self, $c) = @_;
  96     # set content_type but don't set body
  97     $c->res->content_type('image/jpeg');
  98     $c->res->redirect('/go_here');
  99 }
 100
 101 sub test_redirect_with_content :Global {
 102     my ($self, $c) = @_;
 103     $c->res->content_type('text/plain');
 104     $c->res->body('Please kind sir, I beg you to go to /go_here.');
 105     $c->res->redirect('/go_here');
 106 }
 107
 108 sub end : Private {
 109     my ($self,$c) = @_;
 110 }
 111
 112 1;