X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FTest.pm;h=3265da305e3606228c7618e826c7841ce8880ff9;hb=585893b98efe1cf95118f2686108959fdebb0fab;hp=0d2acc9e3a667557f8d40a2d6f1edbf040995bed;hpb=7c48ba15d6cf5328b7773e998e3cffd6a0890e03;p=catagits%2FCatalyst-Runtime.git 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.