12 our $VERSION = '0.01';
16 root => cwd . '/t/root',
19 Catty->log->levels("fatal");
21 sub default : Private {
22 my ( $self, $context ) = @_;
23 my $html = html( "Root", "This is the root page" );
24 $context->response->content_type("text/html");
25 $context->response->output($html);
29 my ( $self, $context ) = @_;
30 my $str = Encode::encode('utf-8', "\x{263A}"); # ☺
31 my $html = html( "Hello", "Hi there! $str" );
32 $context->response->content_type("text/html; charset=utf-8");
33 $context->response->output($html);
38 my ( $self, $context ) = @_;
39 my $where = $context->uri_for('hello');
40 $context->response->redirect($where);
44 # partial (relative) redirect
45 sub greetings : Global {
46 my ( $self, $context ) = @_;
47 $context->response->redirect("hello");
51 # redirect to a redirect
52 sub bonjour : Global {
53 my ( $self, $context ) = @_;
54 my $where = $context->uri_for('hi');
55 $context->response->redirect($where);
59 sub check_auth_basic : Global {
60 my ( $self, $context ) = @_;
62 my $auth = $context->req->headers->authorization;
63 ($auth) = $auth =~ /Basic\s(.*)/i;
64 $auth = decode_base64($auth);
66 if ( $auth eq "user:pass" ) {
67 my $html = html( "Auth", "This is the auth page" );
68 $context->response->content_type("text/html");
69 $context->response->output($html);
72 my $html = html( "Auth", "Auth Failed!" );
73 $context->response->content_type("text/html");
74 $context->response->output($html);
75 $context->response->status("401");
80 sub redirect_with_500 : Global {
81 my ( $self, $c ) = @_;
83 $c->res->redirect( $c->uri_for("/bonjour"));
88 my ( $self, $context ) = @_;
89 my $html = html( "Die", "This is the die page" );
90 $context->response->content_type("text/html");
91 $context->response->output($html);
98 my $html = html( $c->config->{name}, "This is the die page" );
99 $c->response->content_type("text/html");
100 $c->response->output($html);
106 my $host = $c->req->header('Host') || "<undef>";
107 my $html = html( $c->config->{name}, "Host: $host" );
108 $c->response->content_type("text/html");
109 $c->response->output($html);
113 my ( $title, $body ) = @_;
116 <head><title>$title</title></head>
119 <a href="/hello/">Hello</a>.
124 sub gzipped : Global {
125 my ( $self, $c ) = @_;
127 # If done properly this test should check the accept-encoding header, but we
128 # control both ends, so just always gzip the response.
129 require Compress::Zlib;
131 my $html = html( "Hello", "Hi there! ☺" );
132 $c->response->content_type("text/html; charset=utf-8");
133 $c->response->output( Compress::Zlib::memGzip($html) );
134 $c->response->content_encoding('gzip');
135 $c->response->headers->push_header( 'Vary', 'Accept-Encoding' );
138 sub user_agent : Global {
139 my ( $self, $c ) = @_;
141 my $html = html($c->req->user_agent, $c->req->user_agent);
142 $c->response->content_type("text/html; charset=utf-8");
143 $c->response->output( $html );