projects / catagits/Test-WWW-Mechanize-Catalyst.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw (parent: c20c810)
Actually add the new bits for rearranged apps
Tomas Doran [Mon, 8 Mar 2010 01:17:29 +0000 (01:17 +0000)]
t/lib/Catty/Controller/Root.pm [new file with mode: 0644] patch | blob
t/lib/CattySession/Controller/Root.pm [new file with mode: 0644] patch | blob
t/lib/ExternalCatty/Controller/Root.pm [new file with mode: 0644] patch | blob

diff --git a/t/lib/Catty/Controller/Root.pm b/t/lib/Catty/Controller/Root.pm
new file mode 100644 (file)
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') || "<undef>";
+    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{
+<html>
+<head><title>$title</title></head>
+<body>
+$body
+<a href="/hello/">Hello</a>.
+</body></html>
+};
+}
+
+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 (file)
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{
+<html>
+<head><title>$title</title></head>
+<body>
+$body
+<a href="/hello/">Hello</a>.
+</body></html>
+};
+}
+
+1;
+
diff --git a/t/lib/ExternalCatty/Controller/Root.pm b/t/lib/ExternalCatty/Controller/Root.pm
new file mode 100644 (file)
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[
+<html>
+<head>
+    <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+    <title>$title</title>
+</head>
+<body>$body</body>
+</html>
+];
+}
+
+1;
+
git://git.shadowcat.co.uk:catagits/Test-WWW-Mechanize-Catalyst