Véase HTTP::Server::Brick.
pp2@nereida:~/src/testing$ cat -n brickhttp.pl 1 #!/usr/bin/perl -w 2 use strict; 3 4 use HTTP::Server::Brick; 5 use HTTP::Status; 6 7 my $server = HTTP::Server::Brick->new( port => 8888 ); 8 9 $server->mount( '/' => { 10 path => '/var/www', 11 }); 12 13 $server->mount( '/test/proc' => { 14 handler => sub { 15 my ($req, $res) = @_; 16 $res->add_content("<html><body> 17 <p>Path info: $req->{path_info}</p> 18 </body></html>"); 19 1; 20 }, 21 wildcard => 1, 22 }); 23 24 $server->mount( '/test/proc/texty' => { 25 handler => sub { 26 my ($req, $res) = @_; 27 $res->add_content("flubber"); 28 $res->header('Content-type', 'text/plain'); 29 1; 30 }, 31 wildcard => 1, 32 }); 33 34 # these next two are equivalent 35 $server->mount( '/favicon.ico' => { 36 handler => sub { RC_NOT_FOUND }, 37 }); 38 $server->mount( '/favicon.ico' => { 39 handler => sub { 40 my ($req, $res) = @_; 41 $res->code(RC_NOT_FOUND); 42 1; 43 }, 44 }); 45 46 # start accepting requests (won't return unless/until process 47 # receives a HUP signal) 48 $server->start;
pp2@nereida:~/src/testing$ brickhttp.pl [Tue May 6 16:29:58 2008] [1541] Mounted wildcard directory at / [Tue May 6 16:29:58 2008] [1541] Mounted wildcard handler at /test/proc [Tue May 6 16:29:58 2008] [1541] Mounted wildcard handler at /test/proc/texty [Tue May 6 16:29:58 2008] [1541] Mounted handler at /favicon.ico [Tue May 6 16:29:58 2008] [1541] Mounted handler at /favicon.ico [Tue May 6 16:29:58 2008] [1541] Server started on http://nereida.deioc.ull.es:8888/ [Tue May 6 16:30:12 2008] [1541] [200] / [Tue May 6 16:30:12 2008] [1541] [200] /options.html [Tue May 6 16:30:17 2008] [1541] [200] /presentation.html [Tue May 6 16:30:20 2008] [1541] [200] /html/english.html