t/lib/Catty/Controller/Root.pm

   1 package Catty::Controller::Root;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/ Catalyst::Controller /;
   7
   8 use Cwd;
   9 use MIME::Base64;
  10 use Encode ();
  11
  12 __PACKAGE__->config( namespace => '' );
  13
  14 sub default : Private {
  15     my ( $self, $context ) = @_;
  16     my $html = html( "Root", "This is the root page" );
  17     $context->response->content_type("text/html");
  18     $context->response->output($html);
  19 }
  20
  21 sub hello : Global {
  22     my ( $self, $context ) = @_;
  23     my $str = Encode::encode('utf-8', "\x{263A}"); # ☺
  24     my $html = html( "Hello", "Hi there! $str" );
  25     $context->response->content_type("text/html; charset=utf-8");
  26     $context->response->output($html);
  27 }
  28
  29 # absolute redirect
  30 sub hi : Global {
  31     my ( $self, $context ) = @_;
  32     my $where = $context->uri_for('hello');
  33     $context->response->redirect($where);
  34     return;
  35 }
  36
  37 # partial (relative) redirect
  38 sub greetings : Global {
  39     my ( $self, $context ) = @_;
  40     $context->response->redirect("hello");
  41     return;
  42 }
  43
  44 # redirect to a redirect
  45 sub bonjour : Global {
  46     my ( $self, $context ) = @_;
  47     my $where = $context->uri_for('hi');
  48     $context->response->redirect($where);
  49     return;
  50 }
  51
  52 sub check_auth_basic : Global {
  53     my ( $self, $context ) = @_;
  54
  55     my $auth = $context->req->headers->authorization;
  56     ($auth) = $auth =~ /Basic\s(.*)/i;
  57     $auth = decode_base64($auth);
  58
  59     if ( $auth eq "user:pass" ) {
  60         my $html = html( "Auth", "This is the auth page" );
  61         $context->response->content_type("text/html");
  62         $context->response->output($html);
  63         return $context;
  64     } else {
  65         my $html = html( "Auth", "Auth Failed!" );
  66         $context->response->content_type("text/html");
  67         $context->response->output($html);
  68         $context->response->status("401");
  69         return $context;
  70     }
  71 }
  72
  73 sub redirect_with_500 : Global {
  74     my ( $self, $c ) = @_;
  75     $DB::single = 1;
  76     $c->res->redirect( $c->uri_for("/bonjour"));
  77     die "erk!";
  78 }
  79
  80 sub die : Global {
  81     my ( $self, $context ) = @_;
  82     my $html = html( "Die", "This is the die page" );
  83     $context->response->content_type("text/html");
  84     $context->response->output($html);
  85     die "erk!";
  86 }
  87
  88 sub name : Global {
  89     my ($self, $c) = @_;
  90
  91     my $html = html( $c->config->{name}, "This is the die page" );
  92     $c->response->content_type("text/html");
  93     $c->response->output($html);
  94 }
  95
  96 sub host : Global {
  97     my ($self, $c) = @_;
  98
  99     my $host = $c->req->header('Host') || "<undef>";
 100     my $html = html( $c->config->{name}, "Host: $host" );
 101     $c->response->content_type("text/html");
 102     $c->response->output($html);
 103 }
 104
 105 sub html {
 106     my ( $title, $body ) = @_;
 107     return qq{
 108 <html>
 109 <head><title>$title</title></head>
 110 <body>
 111 $body
 112 <a href="/hello/">Hello</a>.
 113 </body></html>
 114 };
 115 }
 116
 117 sub gzipped : Global {
 118     my ( $self, $c ) = @_;
 119
 120   # If done properly this test should check the accept-encoding header, but we
 121   # control both ends, so just always gzip the response.
 122     require Compress::Zlib;
 123
 124     my $html = html( "Hello", "Hi there! ☺" );
 125     $c->response->content_type("text/html; charset=utf-8");
 126     $c->response->output( Compress::Zlib::memGzip($html) );
 127     $c->response->content_encoding('gzip');
 128     $c->response->headers->push_header( 'Vary', 'Accept-Encoding' );
 129 }
 130
 131 sub user_agent : Global {
 132     my ( $self, $c ) = @_;
 133
 134     my $html = html($c->req->user_agent, $c->req->user_agent);
 135     $c->response->content_type("text/html; charset=utf-8");
 136     $c->response->output( $html );
 137
 138 }
 139
 140 1;
 141