use strict; use warnings; use IO::File; use Test::More; BEGIN { eval q(require Test::HTTP); plan skip_all => "Test::HTTP required for these tests." if ($@); plan tests => 16; } use Test::HTTP; use Test::HTTP::Syntax; # The indenting is retarded because this is intended to be copied verbatim # into the synopsis in the pod docs. use HTTP::Server::Simple::Dispatched qw(static); my $server = HTTP::Server::Simple::Dispatched->new( hostname => 'myawesomeserver.org', port => 8081, debug => 1, dispatch => [ qr{^/hello/} => sub { my ($response) = @_; $response->content_type('text/plain'); $response->content("Hello, world!"); return 1; }, qr{^/say/(\w+)/} => sub { my ($response) = @_; $response->content_type('text/plain'); $response->content("You asked me to say $1."); return 1; }, qr{^/counter/} => sub { my ($response, $request, $context) = @_; my $num = ++$context->{counter}; $response->content_type('text/plain'); $response->content("Called $num times."); return 1; }, qr{^/static/(.*\.(?:png|gif|jpg))} => static("t/"), qr{^/error/} => sub { die "This will cause a 500!"; }, ], ); # here the similarity ends: the synopsis says run, we say background because # we have to do some tests now. # $server->run(); my $pid = $server->background(); my $SERVER = 'http://localhost:8081'; test_http 'hello' { >> GET $SERVER/hello/ << 200 << Content-type: text/plain << << Hello, world! } test_http 'say' { >> GET $SERVER/say/arglebargle/ << 200 << << You asked me to say arglebargle. } test_http 'counter1' { >> GET $SERVER/counter/ << 200 << << Called 1 times. } test_http 'counter2' { >> GET $SERVER/counter/ << 200 << << Called 2 times. } test_http 'error' { >> GET $SERVER/error/ << 500 } test_http '404' { >> GET $SERVER/clearly/not << 404 } test_http 'static' { my $fh = IO::File->new('t/test.png'); my $content; {local $/; $content = <$fh>;} >> GET $SERVER/static/test.png << 200 << Content-type: image/png ok($content eq $test->response->content, "File matches perfectly."); undef($fh); } test_http 'static_regex' { >> GET $SERVER/static/01-synopsis.t << 404 } test_http 'hax' { my $dots = "../" x 20; >> GET $SERVER/static/${dots}etc/passwd << 404 } kill TERM => $pid;