From: Sebastian Riedel Date: Mon, 21 Mar 2005 23:31:25 +0000 (+0000) Subject: updated server.pl and cgi-server.pl X-Git-Tag: 5.7099_04~1745 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=585893b98efe1cf95118f2686108959fdebb0fab updated server.pl and cgi-server.pl --- diff --git a/Changes b/Changes index 5510f48..0d26476 100644 --- a/Changes +++ b/Changes @@ -6,6 +6,10 @@ This file documents the revision history for Perl extension Catalyst. - HTTP::Request support in Catalyst::Test (Christian Hansen) - moved cgi.pl to nph-cgi.pl - added Catalyst::Engine::Server (Christian Hansen) + - removed Catalyst::Test::server + - updated helper scripts + IMPORTANT: note that you have to regenerate script/server.pl, + script/cgi-server.pl and script/cgi.pl (now nph-cgi.pl) 4.28 Sat Mar 19 22:00:00 2005 - fixed isa tree (Christian Hansen) diff --git a/lib/Catalyst/Helper.pm b/lib/Catalyst/Helper.pm index 74bd0fa..52b35a0 100644 --- a/lib/Catalyst/Helper.pm +++ b/lib/Catalyst/Helper.pm @@ -370,12 +370,16 @@ sub _mk_server { $self->mk_file( "$script\/server.pl", <<"EOF"); $Config{startperl} -w +BEGIN { + \$ENV{CATALYST_ENGINE} = 'Server'; +} + use strict; use Getopt::Long; use Pod::Usage; use FindBin; use lib "\$FindBin::Bin/../lib"; -use Catalyst::Test '$name'; +use $name; my \$help = 0; my \$port = 3000; @@ -384,7 +388,7 @@ GetOptions( 'help|?' => \\\$help, 'port=s' => \\\$port ); pod2usage(1) if \$help; -Catalyst::Test::server(\$port); +$name->run(\$port); 1; __END__ @@ -432,12 +436,17 @@ sub _mk_cgiserver { $self->mk_file( "$script\/cgi-server.pl", <<"EOF"); $Config{startperl} -w +BEGIN { + \$ENV{CATALYST_ENGINE} = 'Server'; +} + use strict; use Getopt::Long; use Pod::Usage; use FindBin; +use lib "\$FindBin::Bin/../lib"; use File::Spec; -use Catalyst::Test; +use $name; my \$help = 0; my \$port = 3000; @@ -446,8 +455,7 @@ GetOptions( 'help|?' => \\\$help, 'port=s' => \\\$port ); pod2usage(1) if \$help; -Catalyst::Test::server( - \$port, File::Spec->catfile( \$FindBin::Bin, 'nph-cgi.pl' ) ); +$name->run( \$port, File::Spec->catfile( \$FindBin::Bin, 'nph-cgi.pl' ) ); 1; __END__ diff --git a/lib/Catalyst/Manual/Internals.pod b/lib/Catalyst/Manual/Internals.pod index ac939f4..1553eef 100644 --- a/lib/Catalyst/Manual/Internals.pod +++ b/lib/Catalyst/Manual/Internals.pod @@ -15,6 +15,7 @@ extend Catalyst. prepare_path prepare_cookies prepare_headers + prepare_connection prepare_action prepare_parameters prepare_uploads diff --git a/lib/Catalyst/Manual/Intro.pod b/lib/Catalyst/Manual/Intro.pod index 15f6ee8..042face 100644 --- a/lib/Catalyst/Manual/Intro.pod +++ b/lib/Catalyst/Manual/Intro.pod @@ -554,20 +554,12 @@ Start your application on the command line... script/server.pl -or - - perl -I/home/joeuser/myapp/lib -MCatalyst::Test=MyApp -e1 3000 - ...then visit http://localhost:3000/ in a browser to view the output. You can also do it all from the command line: script/test.pl http://localhost/ -or - - perl -I/home/joeuser/myapp/lib -MCatalyst::Test=MyApp -e1 http://localhost/ - Have fun! =head1 SUPPORT diff --git a/lib/Catalyst/Test.pm b/lib/Catalyst/Test.pm index 0d2acc9..3265da3 100644 --- a/lib/Catalyst/Test.pm +++ b/lib/Catalyst/Test.pm @@ -21,8 +21,6 @@ Catalyst::Test - Test Catalyst applications =head1 SYNOPSIS # Helper - script/cgi-server.pl - script/server.pl script/test.pl # Tests @@ -33,9 +31,6 @@ Catalyst::Test - Test Catalyst applications # Request perl -MCatalyst::Test=MyApp -e1 index.html - # Server - perl -MCatalyst::Test=MyApp -e1 3000 - =head1 DESCRIPTION Test Catalyst applications. @@ -60,8 +55,7 @@ Returns a C object. no warnings; CHECK { if ( ( caller(0) )[1] eq '-e' ) { - if ( $ARGV[0] =~ /^\d+$/ ) { server( $ARGV[0] ) } - else { print request( $ARGV[0] || 'http://localhost' )->content } + print request( $ARGV[0] || 'http://localhost' )->content; } } } @@ -123,87 +117,6 @@ sub request { return HTTP::Response->parse($output); } -=head3 server - -Starts a testserver. - - Catalyst::Test::server(3000); - -=cut - -sub server { - my ( $port, $script ) = @_; - - # Listen - my $tcp = getprotobyname('tcp'); - socket( HTTPDaemon, PF_INET, SOCK_STREAM, $tcp ) or die $!; - setsockopt( HTTPDaemon, SOL_SOCKET, SO_REUSEADDR, pack( "l", 1 ) ) - or warn $!; - bind( HTTPDaemon, sockaddr_in( $port, INADDR_ANY ) ) or die $!; - listen( HTTPDaemon, SOMAXCONN ) or die $!; - - print "You can connect to your server at http://localhost:$port\n"; - - # Process - my %clean = %ENV; - for ( ; accept( Remote, HTTPDaemon ) ; close Remote ) { - *STDIN = *Remote; - *STDOUT = *Remote; - my $remote_sockaddr = getpeername(STDIN); - my ( undef, $iaddr ) = sockaddr_in($remote_sockaddr); - my $peername = gethostbyaddr( $iaddr, AF_INET ) || "localhost"; - my $peeraddr = inet_ntoa($iaddr) || "127.0.0.1"; - my $local_sockaddr = getsockname(STDIN); - my ( undef, $localiaddr ) = sockaddr_in($local_sockaddr); - my $localname = gethostbyaddr( $localiaddr, AF_INET ) || 'localhost'; - my $localaddr = inet_ntoa($localiaddr) || '127.0.0.1'; - my $chunk; - - while ( sysread( STDIN, my $buff, 1 ) ) { - last if $buff eq "\n"; - $chunk .= $buff; - } - my ( $method, $request_uri, $proto, undef ) = split /\s+/, $chunk; - my ( $file, undef, $query_string ) = - ( $request_uri =~ /([^?]*)(\?(.*))?/ ); - last if ( $method !~ /^(GET|POST|HEAD)$/ ); - %ENV = %clean; - - $chunk = ''; - while ( sysread( STDIN, my $buff, 1 ) ) { - if ( $buff eq "\n" ) { - $chunk =~ s/[\r\l\n\s]+$//; - if ( $chunk =~ /^([\w\-]+): (.+)/i ) { - my $tag = uc($1); - $tag =~ s/^COOKIES$/COOKIE/; - my $val = $2; - $tag =~ s/-/_/g; - $tag = "HTTP_" . $tag - unless ( grep /^$tag$/, qw(CONTENT_LENGTH CONTENT_TYPE) ); - if ( $ENV{$tag} ) { $ENV{$tag} .= "; $val" } - else { $ENV{$tag} = $val } - } - last if $chunk =~ /^$/; - $chunk = ''; - } - else { $chunk .= $buff } - } - $ENV{SERVER_PROTOCOL} = $proto; - $ENV{SERVER_PORT} = $port; - $ENV{SERVER_NAME} = $localname; - $ENV{SERVER_URL} = "http://$localname:$port/"; - $ENV{PATH_INFO} = $file; - $ENV{REQUEST_URI} = $request_uri; - $ENV{REQUEST_METHOD} = $method; - $ENV{REMOTE_ADDR} = $peeraddr; - $ENV{REMOTE_HOST} = $peername; - $ENV{QUERY_STRING} = $query_string || ''; - $ENV{CONTENT_TYPE} ||= 'multipart/form-data'; - $ENV{SERVER_SOFTWARE} ||= "Catalyst/$Catalyst::VERSION"; - $script ? print STDOUT `$script` : $class->run; - } -} - =head1 SEE ALSO L.