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
