From: Tomas Doran Date: Mon, 8 Mar 2010 01:08:29 +0000 (+0000) Subject: Fix appclass actions in the tests X-Git-Tag: 0.52~6 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FTest-WWW-Mechanize-Catalyst.git;a=commitdiff_plain;h=c20c8103da6848b68f8334f938c5a8f28c2c8fc7 Fix appclass actions in the tests --- 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; diff --git a/t/lib/CattySession.pm b/t/lib/CattySession.pm index 4c96c49..ed91014 100644 --- a/t/lib/CattySession.pm +++ b/t/lib/CattySession.pm @@ -1,60 +1,21 @@ package CattySession; use strict; +use warnings; -#use Catalyst; use Catalyst qw/ Session Session::State::Cookie Session::Store::Dummy - /; +/; use Cwd; -use MIME::Base64; -our $VERSION = '0.01'; - -CattySession->config( +__PACKAGE__->config( name => 'CattySession', root => cwd . '/t/root', ); -CattySession->setup(); - -sub auto : Private { - my ( $self, $context ) = @_; - if ( $context->session ) { - return 1; - } - -} - -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 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 html { - my ( $title, $body ) = @_; - return qq{ - -$title - -$body -Hello. - -}; -} +__PACKAGE__->setup; 1; diff --git a/t/lib/ExternalCatty.pm b/t/lib/ExternalCatty.pm index 7b754ae..9b2fd1e 100644 --- a/t/lib/ExternalCatty.pm +++ b/t/lib/ExternalCatty.pm @@ -2,38 +2,10 @@ package ExternalCatty; use strict; use warnings; use Catalyst qw/-Engine=HTTP/; -our $VERSION = '0.01'; __PACKAGE__->config( name => 'ExternalCatty' ); __PACKAGE__->setup; -sub default : Private { - my ( $self, $c ) = @_; - $c->response->content_type('text/html; charset=utf-8'); - $c->response->output( html( 'Root', 'Hello, test ☺!' ) ); -} - -# redirect to a redirect -sub hello: Global { - my ( $self, $context ) = @_; - my $where = $context->uri_for('/'); - $context->response->redirect($where); - return; -} - -sub html { - my ( $title, $body ) = @_; - return qq[ - - - - $title - -$body - -]; -} - # The Cat HTTP server background option is useless here :-( # Thus we have to provide our own background method. sub background {