From: Sebastian Riedel <sri@labs.kraih.com>
Date: Mon, 21 Mar 2005 22:51:53 +0000 (+0000)
Subject: added Catalyst::Engine::Server
X-Git-Tag: 5.7099_04~1746
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=a0bb847e6fa82f029a4f77a1cbd29f51002c3e23

added Catalyst::Engine::Server
---

diff --git a/Changes b/Changes
index c8d94d4..5510f48 100644
--- a/Changes
+++ b/Changes
@@ -5,6 +5,7 @@ This file documents the revision history for Perl extension Catalyst.
         - added connection informations (Christian Hansen)
         - HTTP::Request support in Catalyst::Test (Christian Hansen)
         - moved cgi.pl to nph-cgi.pl
+        - added Catalyst::Engine::Server (Christian Hansen)
 
 4.28  Sat Mar 19 22:00:00 2005
         - fixed isa tree (Christian Hansen)
diff --git a/MANIFEST b/MANIFEST
index c15290a..2a4525a 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4,6 +4,7 @@ lib/Catalyst/Base.pm
 lib/Catalyst/Engine.pm
 lib/Catalyst/Engine/Apache.pm
 lib/Catalyst/Engine/CGI.pm
+lib/Catalyst/Engine/Server.pm
 lib/Catalyst/Helper.pm
 lib/Catalyst/Log.pm
 lib/Catalyst/Manual.pod
@@ -13,6 +14,7 @@ lib/Catalyst/Manual/Internals.pod
 lib/Catalyst/Manual/Intro.pod
 lib/Catalyst/Manual/SuccessStories.pod
 lib/Catalyst/Manual/Troubleshooting.pod
+lib/Catalyst/Manual/Tutorial.pod
 lib/Catalyst/Request.pm
 lib/Catalyst/Response.pm
 lib/Catalyst/Test.pm
diff --git a/Makefile.PL b/Makefile.PL
index 1425cf1..0d02e17 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -11,6 +11,7 @@ WriteMakefile(
         Class::Data::Inheritable => 0,
         HTML::Entities           => 0,
         HTTP::Headers            => 0,
+        HTTP::Server::Simple     => 0,
         Module::Pluggable::Fast  => 0
     }
 );
diff --git a/lib/Catalyst/Engine/Server.pm b/lib/Catalyst/Engine/Server.pm
new file mode 100644
index 0000000..014e2f1
--- /dev/null
+++ b/lib/Catalyst/Engine/Server.pm
@@ -0,0 +1,136 @@
+package Catalyst::Engine::Server;
+
+use strict;
+use base 'Catalyst::Engine::CGI';
+
+=head1 NAME
+
+Catalyst::Engine::Server - Catalyst Server Engine
+
+=head1 SYNOPSIS
+
+See L<Catalyst>.
+
+=head1 DESCRIPTION
+
+This is the Catalyst engine specialized for development and testing.
+
+=head1 OVERLOADED METHODS
+
+This class overloads some methods from C<Catalyst::Engine::CGI>.
+
+=over 4
+
+=item $c->run
+
+=cut
+
+sub run {
+    my $class  = shift;
+    my $port   = shift || 3000;
+    my $script = shift;
+
+    my $server = Catalyst::Engine::Server::Simple->new($port);
+
+    $server->handler( sub { $script ? print `$script` : $class->handler } );
+    $server->run;
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<Catalyst>, L<HTTP::Server::Simple>.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@cpan.org>
+Christian Hansen, C<ch@ngmedia.com>
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+package Catalyst::Engine::Server::Simple;
+
+use strict;
+use base 'HTTP::Server::Simple';
+
+my %CLEAN_ENV = %ENV;
+
+sub handler {
+    my $self = shift;
+
+    if (@_) {
+        $self->{handler} = shift;
+    }
+
+    else {
+        $self->{handler}->();
+    }
+}
+
+sub print_banner {
+    my $self = shift;
+
+    printf(
+        "You can connect to your server at http://%s:%d/\n",
+        $self->host || 'localhost',
+        $self->port
+    );
+}
+
+sub accept_hook {
+    %ENV = ( %CLEAN_ENV, SERVER_SOFTWARE => "Catalyst/$Catalyst::VERSION" );
+}
+
+our %env_mapping = (
+    protocol     => "SERVER_PROTOCOL",
+    localport    => "SERVER_PORT",
+    localname    => "SERVER_NAME",
+    path         => "PATH_INFO",
+    request_uri  => "REQUEST_URI",
+    method       => "REQUEST_METHOD",
+    peeraddr     => "REMOTE_ADDR",
+    peername     => "REMOTE_HOST",
+    query_string => "QUERY_STRING",
+);
+
+sub setup {
+    no warnings 'uninitialized';
+    my $self = shift;
+
+    while ( my ( $item, $value ) = splice @_, 0, 2 ) {
+        if ( $self->can($item) ) {
+            $self->$item($value);
+        }
+        elsif ( my $k = $env_mapping{$item} ) {
+            $ENV{$k} = $value;
+        }
+    }
+}
+
+sub headers {
+    my $self    = shift;
+    my $headers = shift;
+
+    while ( my ( $tag, $value ) = splice @{$headers}, 0, 2 ) {
+        $tag = uc($tag);
+        $tag =~ s/^COOKIES$/COOKIE/;
+        $tag =~ s/-/_/g;
+        $tag = "HTTP_" . $tag
+          unless $tag =~ m/^CONTENT_(?:LENGTH|TYPE)$/;
+
+        if ( exists $ENV{$tag} ) {
+            $ENV{$tag} .= "; $value";
+        }
+        else {
+            $ENV{$tag} = $value;
+        }
+    }
+}
+
+1;
diff --git a/lib/Catalyst/Manual.pod b/lib/Catalyst/Manual.pod
index 4a868b6..0bc6ebb 100644
--- a/lib/Catalyst/Manual.pod
+++ b/lib/Catalyst/Manual.pod
@@ -9,6 +9,9 @@ This is the comprehensive user guide and reference for Catalyst.
 L<Catalyst::Manual::Intro>
     Introduction to Catalyst.
 
+L<Catalyst::Manual::Tutorial>
+    A simple step by step tutorial.
+
 L<Catalyst::Manual::Cookbook>
     Cooking with Catalyst.