X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FCatty.pm;h=ea27ec95d6d8c301cde63400608e56d1f4c8dc49;hb=c20c8103da6848b68f8334f938c5a8f28c2c8fc7;hp=17cff7f023709ca552806edd4dbad1d40cc4c940;hpb=254eca4135088b598bc59093b98475992b4bf6f5;p=catagits%2FTest-WWW-Mechanize-Catalyst.git
diff --git a/t/lib/Catty.pm b/t/lib/Catty.pm
index 17cff7f..ea27ec9 100644
--- a/t/lib/Catty.pm
+++ b/t/lib/Catty.pm
@@ -1,122 +1,18 @@
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 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 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' );
-}
+__PACKAGE__->setup();
+__PACKAGE__->log->levels("fatal");
1;