1 package Catty::Controller::Root;
6 use base qw/ Catalyst::Controller /;
12 __PACKAGE__->config( namespace => '' );
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);
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);
31 my ( $self, $context ) = @_;
32 my $where = $context->uri_for('hello');
33 $context->response->redirect($where);
37 # partial (relative) redirect
38 sub greetings : Global {
39 my ( $self, $context ) = @_;
40 $context->response->redirect("hello");
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);
52 sub check_auth_basic : Global {
53 my ( $self, $context ) = @_;
55 my $auth = $context->req->headers->authorization;
56 ($auth) = $auth =~ /Basic\s(.*)/i;
57 $auth = decode_base64($auth);
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);
65 my $html = html( "Auth", "Auth Failed!" );
66 $context->response->content_type("text/html");
67 $context->response->output($html);
68 $context->response->status("401");
73 sub redirect_with_500 : Global {
74 my ( $self, $c ) = @_;
76 $c->res->redirect( $c->uri_for("/bonjour"));
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);
91 my $html = html( $c->config->{name}, "This is the die page" );
92 $c->response->content_type("text/html");
93 $c->response->output($html);
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);
106 my ( $title, $body ) = @_;
109 <head><title>$title</title></head>
112 <a href="/hello/">Hello</a>.
117 sub gzipped : Global {
118 my ( $self, $c ) = @_;
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;
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' );
131 sub user_agent : Global {
132 my ( $self, $c ) = @_;
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 );