diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..1b266e2 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,8 @@ +language: perl6 +sudo: false +perl6: + - latest +install: + - rakudobrew build-zef + - zef --debug install . + diff --git a/META.info b/META6.json similarity index 52% rename from META.info rename to META6.json index d8a6c80..3f89a08 100644 --- a/META.info +++ b/META6.json @@ -1,11 +1,14 @@ { + "perl" : "6.*", "name" : "HTTP::Server::Simple", - "version" : "*", + "version" : "0.1.2", "description" : "Simple webserver module, with PSGI support", + "authors" : [ "Martin Berends", "Wenzel P. P. Peppmeyer" ], "provides" : { "HTTP::Server::Simple" : "lib/HTTP/Server/Simple.pm6", "HTTP::Server::Simple::PSGI" : "lib/HTTP/Server/Simple/PSGI.pm6" }, - "depends" : [], - "source-url" : "git://github.com/mberends/http-server-simple.git" + "depends" : [ "Test::META" ], + "resources" : [], + "source-url" : "git://github.com/gfldex/http-server-simple.git" } diff --git a/README b/README.md similarity index 85% rename from README rename to README.md index fce7f99..7635a86 100644 --- a/README +++ b/README.md @@ -1,4 +1,6 @@ -README for the Rakudo Perl 6 version of HTTP::Server::Simple +# HTTP::Server::Simple + +[![Build Status](https://travis-ci.org/gfldex/http-server-simple.svg?branch=master)](https://travis-ci.org/gfldex/http-server-simple) This simple embedded web server is similar to HTTP::Daemon, but provides more hooks for subclassing and extending. The subclasses CGI and PSGI give @@ -15,16 +17,16 @@ where the CGI concerns were not separated from the web server. In this Perl 6 implementation the PSGI concerns are fully separated from the CGI ones. -EXAMPLES +# EXAMPLES Included are examples of minimal web servers and some that demonstrate use of extension hooks and subclassing. -TESTING +# TESTING The code is badly under tested, contributions would be welcome. -SEE ALSO +# SEE ALSO The Perl 6 Web.pm project: http://github.com/masak/web The Perl Dancer project: perldancer.org diff --git a/lib/HTTP/Server/Simple.pm6 b/lib/HTTP/Server/Simple.pm6 index 9889bdc..0c90f78 100644 --- a/lib/HTTP/Server/Simple.pm6 +++ b/lib/HTTP/Server/Simple.pm6 @@ -1,28 +1,27 @@ # HTTP/Server/Simple.pm6 -role HTTP::Server::Simple { +role HTTP::Server::Simple[IO::Socket ::SocketType = IO::Socket::INET] { has $.port; has $.host is rw; - has IO::Socket::INET $!listener; + has SocketType $!listener; has $.connection; # returned by accept() has Str $!request; has Str @!headers; - class Output-Interceptor { + my class Output-Interceptor { has $.socket is rw; multi method print(*@a) { # $*ERR.say: "Intercepting print " ~ @a; - $.socket.send(@a); + $.socket.print(@a); } multi method say(*@a) { # $*ERR.say: "Intercepting say " ~ @a; - $.socket.send(@a ~ "\x0D\x0A"); + $.socket.print(@a ~ "\x0D\x0A"); } } - method new ( $port=8080 ) { - my %methods = self.^methods Z 1..*; # convert list to hash pairs - self.bless( self.CREATE(), # self might also be a subclass + method new ( :$port = 8080 ) { + self.bless( port => $port, host => self.lookup_localhost, ); @@ -91,7 +90,7 @@ role HTTP::Server::Simple { :$query_string, :$localport, :$peername, :$peeraddr, :$localname ) { } method headers (@headers) { - for @headers -> $key, $value { + for @headers -> [$key, $value] { self.header( $key, $value ); } } diff --git a/lib/HTTP/Server/Simple/PSGI.pm6 b/lib/HTTP/Server/Simple/PSGI.pm6 index d8b3767..08bbba8 100644 --- a/lib/HTTP/Server/Simple/PSGI.pm6 +++ b/lib/HTTP/Server/Simple/PSGI.pm6 @@ -13,7 +13,7 @@ class HTTP::Server::Simple::PSGI does HTTP::Server::Simple { method setup ( :$localname, :$localport, :$method, :$request_uri, :$path, :$query_string, :$peername, :$peeraddr, *%rest ) { - %!env = { + %!env = 'SERVER_NAME' => $localname, 'SERVER_PORT' => $localport, 'REQUEST_METHOD' => $method, @@ -31,16 +31,16 @@ class HTTP::Server::Simple::PSGI does HTTP::Server::Simple { 'psgi.runonce' => Bool::False, 'psgi.nonblocking' => Bool::False, 'psgi.streaming' => Bool::False, - }; + ; } method headers (@headers) { - for @headers -> $key is copy, $value { + for @headers -> [$key is copy, $value] { $key ~~ s:g /\-/_/; $key .= uc; $key = 'HTTP_' ~ $key unless $key eq any(); # RAKUDO: :exists doesn't exist yet - if %!env.exists($key) { + if %!env{$key}:exists { # This is how P5 Plack::HTTPParser::PP handles this %!env{$key} ~= ", $value"; } @@ -56,20 +56,20 @@ class HTTP::Server::Simple::PSGI does HTTP::Server::Simple { # Instead it calls handle_response later on. my $response_ref = defined($!psgi_app) ?? $!psgi_app(%!env) # app must return [status,[headers],[body]] - !! [500,[Content-Type => 'text/plain'],[self.WHAT,"app missing"]]; + !! [500,[Content-Type => 'text/plain'],[self.WHAT.perl,"app missing"]]; my $status = $response_ref[0]; my @headers = $response_ref[1]; my @body = $response_ref[2]; # $*ERR.say: "Status: $status"; # $*ERR.say: "Headers: {@headers}"; - # $*ERR.say: "Body: {@body}"; - $.connection.send( "HTTP/1.1 $status OK\x0D\x0A" ); - $.connection.send( + # $*ERR.say: "Body: {@body}"; + $.connection.print( "HTTP/1.1 $status OK\x0D\x0A" ); + $.connection.print( @headers.map({ $_[0].key ~ ': ' ~ $_[0].value }).join("\n") ); - $.connection.send( "\x0D\x0A" ); - $.connection.send( "\x0D\x0A" ); - $.connection.send( @body ); + $.connection.print( "\x0D\x0A" ); + $.connection.print( "\x0D\x0A" ); + $.connection.print( @body ); # $*ERR.say: "end PSGI.handler"; } } diff --git a/t/basic.t b/t/basic.t new file mode 100644 index 0000000..7619ab6 --- /dev/null +++ b/t/basic.t @@ -0,0 +1,15 @@ +use v6; +use lib 'lib'; +use Test; +use HTTP::Server::Simple; +use HTTP::Server::Simple::PSGI; + + +plan 2; + +my $server = HTTP::Server::Simple.new; +ok($server ~~ HTTP::Server::Simple, 'HTTP::Server::Simple can be constructed'); + +$server = HTTP::Server::Simple::PSGI.new; +ok($server ~~ HTTP::Server::Simple::PSGI, 'HTTP::Server::Simple::PSGI can be constructed'); + diff --git a/t/meta.t b/t/meta.t new file mode 100644 index 0000000..0d7d371 --- /dev/null +++ b/t/meta.t @@ -0,0 +1,9 @@ +use v6; + +use lib 'lib'; +use Test; +use Test::META; + +meta-ok; + +done-testing;