11 our $VERSION = '0.01';
15 root => cwd . '/t/root',
18 Catty->log->levels("fatal");
20 sub default : Private {
21 my ( $self, $context ) = @_;
22 my $html = html( "Root", "This is the root page" );
23 $context->response->content_type("text/html");
24 $context->response->output($html);
28 my ( $self, $context ) = @_;
29 my $str = Encode::encode('utf-8', "\x{263A}"); # ☺
30 my $html = html( "Hello", "Hi there! $str" );
31 $context->response->content_type("text/html; charset=utf-8");
32 $context->response->output($html);
37 my ( $self, $context ) = @_;
38 my $where = $context->uri_for('hello');
39 $context->response->redirect($where);
43 # partial (relative) redirect
44 sub greetings : Global {
45 my ( $self, $context ) = @_;
46 $context->response->redirect("hello");
50 # redirect to a redirect
51 sub bonjour : Global {
52 my ( $self, $context ) = @_;
53 my $where = $context->uri_for('hi');
54 $context->response->redirect($where);
58 sub check_auth_basic : Global {
59 my ( $self, $context ) = @_;
61 my $auth = $context->req->headers->authorization;
62 ($auth) = $auth =~ /Basic\s(.*)/i;
63 $auth = decode_base64($auth);
65 if ( $auth eq "user:pass" ) {
66 my $html = html( "Auth", "This is the auth page" );
67 $context->response->content_type("text/html");
68 $context->response->output($html);
71 my $html = html( "Auth", "Auth Failed!" );
72 $context->response->content_type("text/html");
73 $context->response->output($html);
74 $context->response->status("401");
80 my ( $self, $context ) = @_;
81 my $html = html( "Die", "This is the die page" );
82 $context->response->content_type("text/html");
83 $context->response->output($html);
90 my $html = html( $c->config->{name}, "This is the die page" );
91 $c->response->content_type("text/html");
92 $c->response->output($html);
98 my $host = $c->req->header('Host') || "<undef>";
99 my $html = html( $c->config->{name}, "Host: $host" );
100 $c->response->content_type("text/html");
101 $c->response->output($html);
105 my ( $title, $body ) = @_;
108 <head><title>$title</title></head>
111 <a href="/hello/">Hello</a>.
116 sub gzipped : Global {
117 my ( $self, $c ) = @_;
119 # If done properly this test should check the accept-encoding header, but we
120 # control both ends, so just always gzip the response.
121 require Compress::Zlib;
123 my $html = html( "Hello", "Hi there! ☺" );
124 $c->response->content_type("text/html; charset=utf-8");
125 $c->response->output( Compress::Zlib::memGzip($html) );
126 $c->response->content_encoding('gzip');
127 $c->response->headers->push_header( 'Vary', 'Accept-Encoding' );