From: Tomas Doran Date: Mon, 8 Mar 2010 01:17:29 +0000 (+0000) Subject: Actually add the new bits for rearranged apps X-Git-Tag: 0.52~5 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FTest-WWW-Mechanize-Catalyst.git;a=commitdiff_plain;h=2140e65cd766754138b100dd5234ef5588b79874 Actually add the new bits for rearranged apps --- diff --git a/t/lib/Catty/Controller/Root.pm b/t/lib/Catty/Controller/Root.pm new file mode 100644 index 0000000..d7cb3b7 --- /dev/null +++ b/t/lib/Catty/Controller/Root.pm @@ -0,0 +1,141 @@ +package Catty::Controller::Root; + +use strict; +use warnings; + +use base qw/ Catalyst::Controller /; + +use Cwd; +use MIME::Base64; +use Encode (); + +__PACKAGE__->config( namespace => '' ); + +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 ); + +} + +1; + diff --git a/t/lib/CattySession/Controller/Root.pm b/t/lib/CattySession/Controller/Root.pm new file mode 100644 index 0000000..d83f0da --- /dev/null +++ b/t/lib/CattySession/Controller/Root.pm @@ -0,0 +1,47 @@ +package CattySession::Controller::Root; + +use strict; +use warnings; + +use base qw/ Catalyst::Controller /; + +__PACKAGE__->config( namespace => '' ); + +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. + +}; +} + +1; + diff --git a/t/lib/ExternalCatty/Controller/Root.pm b/t/lib/ExternalCatty/Controller/Root.pm new file mode 100644 index 0000000..882b81d --- /dev/null +++ b/t/lib/ExternalCatty/Controller/Root.pm @@ -0,0 +1,37 @@ +package ExternalCatty::Controller::Root; +use strict; +use warnings; + +use base qw/ Catalyst::Controller /; + +__PACKAGE__->config( namespace => '' ); + +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 + +]; +} + +1; +