$title

X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FCatty.pm;h=ea27ec95d6d8c301cde63400608e56d1f4c8dc49;hb=74649ca9f02a76226d0b0b92c499e6a1fb6e9bc4;hp=83e6745d1f6896b9f17e98ff1cfa53674bdf2667;hpb=affa35d5063fbeb1ca9ccc5bff2372b583c8575f;p=catagits%2FTest-WWW-Mechanize-Catalyst.git diff --git a/t/lib/Catty.pm b/t/lib/Catty.pm index 83e6745..ea27ec9 100644 --- a/t/lib/Catty.pm +++ b/t/lib/Catty.pm @@ -3,146 +3,16 @@ package Catty; use strict; use warnings; -#use Catalyst; use Catalyst; -use Cwd; -use MIME::Base64; -use Encode qw//; -our $VERSION = '0.01'; +use Cwd; -Catty->config( +__PACKAGE__->config( name => 'Catty', root => cwd . '/t/root', ); -Catty->setup(); -Catty->log->levels("fatal"); - -sub default : Private { - my ( $self, $context ) = @_; - my $html = html( "Root", "This is the root page" ); - $context->response->content_type("text/html"); - $context->response->output($html); -} - -sub hello : Global { - my ( $self, $context ) = @_; - my $str = Encode::encode('utf-8', "\x{263A}"); # âº - my $html = html( "Hello", "Hi there! $str" ); - $context->response->content_type("text/html; charset=utf-8"); - $context->response->output($html); -} - -# absolute redirect -sub hi : Global { - my ( $self, $context ) = @_; - my $where = $context->uri_for('hello'); - $context->response->redirect($where); - return; -} - -# partial (relative) redirect -sub greetings : Global { - my ( $self, $context ) = @_; - $context->response->redirect("hello"); - return; -} - -# redirect to a redirect -sub bonjour : Global { - my ( $self, $context ) = @_; - my $where = $context->uri_for('hi'); - $context->response->redirect($where); - return; -} - -sub check_auth_basic : Global { - my ( $self, $context ) = @_; - - my $auth = $context->req->headers->authorization; - ($auth) = $auth =~ /Basic\s(.*)/i; - $auth = decode_base64($auth); - - if ( $auth eq "user:pass" ) { - my $html = html( "Auth", "This is the auth page" ); - $context->response->content_type("text/html"); - $context->response->output($html); - return $context; - } else { - my $html = html( "Auth", "Auth Failed!" ); - $context->response->content_type("text/html"); - $context->response->output($html); - $context->response->status("401"); - return $context; - } -} - -sub redirect_with_500 : Global { - my ( $self, $c ) = @_; - $DB::single = 1; - $c->res->redirect( $c->uri_for("/bonjour")); - die "erk!"; -} - -sub die : Global { - my ( $self, $context ) = @_; - my $html = html( "Die", "This is the die page" ); - $context->response->content_type("text/html"); - $context->response->output($html); - die "erk!"; -} - -sub name : Global { - my ($self, $c) = @_; - - my $html = html( $c->config->{name}, "This is the die page" ); - $c->response->content_type("text/html"); - $c->response->output($html); -} - -sub host : Global { - my ($self, $c) = @_; - - my $host = $c->req->header('Host') || ""; - my $html = html( $c->config->{name}, "Host: $host" ); - $c->response->content_type("text/html"); - $c->response->output($html); -} - -sub html { - my ( $title, $body ) = @_; - return qq{ - -$title - -$body -Hello. - -}; -} - -sub gzipped : Global { - my ( $self, $c ) = @_; - - # If done properly this test should check the accept-encoding header, but we - # control both ends, so just always gzip the response. - require Compress::Zlib; - - my $html = html( "Hello", "Hi there! âº" ); - $c->response->content_type("text/html; charset=utf-8"); - $c->response->output( Compress::Zlib::memGzip($html) ); - $c->response->content_encoding('gzip'); - $c->response->headers->push_header( 'Vary', 'Accept-Encoding' ); -} - -sub user_agent : Global { - my ( $self, $c ) = @_; - - my $html = html($c->req->user_agent, $c->req->user_agent); - $c->response->content_type("text/html; charset=utf-8"); - $c->response->output( $html ); - -} +__PACKAGE__->setup(); +__PACKAGE__->log->levels("fatal"); 1;