Commit | Line | Data |
2140e65c |
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 | |