Perl HTTP server - perl

Question

I'm new at Perl, and I have a question regarding HTTP servers and client APIs.
I want to write an HTTP server which accepts requests from HTTP clients. The problem is that I do not know how to do it because I'm a Java developer, and it's a little bit difficult for me. Please can you give me some tutorials and example for HTTP::Daemon module for Perl?

Answer 1

I spent a lot of time trying to make a "simple" usable web server by many users simultaneously. The documentation for HTTP::Daemon and other online resources isn't helping me.
Here is a working (Ubuntu 12.10 with default Perl package v5.14.2) example preforked web server with different content type pages and error pages:
#!/usr/bin/perl
use strict;
use warnings;
use CGI qw/ :standard /;
use Data::Dumper;
use HTTP::Daemon;
use HTTP::Response;
use HTTP::Status;
use POSIX qw/ WNOHANG /;
use constant HOSTNAME => qx{hostname};
my %O = (
'listen-host' => '127.0.0.1',
'listen-port' => 8080,
'listen-clients' => 30,
'listen-max-req-per-child' => 100,
);
my $d = HTTP::Daemon->new(
LocalAddr => $O{'listen-host'},
LocalPort => $O{'listen-port'},
Reuse => 1,
) or die "Can't start http listener at $O{'listen-host'}:$O{'listen-port'}";
print "Started HTTP listener at " . $d->url . "\n";
my %chld;
if ($O{'listen-clients'}) {
$SIG{CHLD} = sub {
# checkout finished children
while ((my $kid = waitpid(-1, WNOHANG)) > 0) {
delete $chld{$kid};
}
};
}
while (1) {
if ($O{'listen-clients'}) {
# prefork all at once
for (scalar(keys %chld) .. $O{'listen-clients'} - 1 ) {
my $pid = fork;
if (!defined $pid) { # error
die "Can't fork for http child $_: $!";
}
if ($pid) { # parent
$chld{$pid} = 1;
}
else { # child
$_ = 'DEFAULT' for #SIG{qw/ INT TERM CHLD /};
http_child($d);
exit;
}
}
sleep 1;
}
else {
http_child($d);
}
}
sub http_child {
my $d = shift;
my $i;
my $css = <<CSS;
form { display: inline; }
CSS
while (++$i < $O{'listen-max-req-per-child'}) {
my $c = $d->accept or last;
my $r = $c->get_request(1) or last;
$c->autoflush(1);
print sprintf("[%s] %s %s\n", $c->peerhost, $r->method, $r->uri->as_string);
my %FORM = $r->uri->query_form();
if ($r->uri->path eq '/') {
_http_response($c, { content_type => 'text/html' },
start_html(
-title => HOSTNAME,
-encoding => 'utf-8',
-style => { -code => $css },
),
p('Here are all input parameters:'),
pre(Data::Dumper->Dump([\%FORM],['FORM'])),
(map { p(a({ href => $_->[0] }, $_->[1])) }
['/', 'Home'],
['/ping', 'Ping the simple text/plain content'],
['/error', 'Sample error page'],
['/other', 'Sample not found page'],
),
end_html(),
)
}
elsif ($r->uri->path eq '/ping') {
_http_response($c, { content_type => 'text/plain' }, 1);
}
elsif ($r->uri->path eq '/error') {
my $error = 'AAAAAAAAA! My server error!';
_http_error($c, RC_INTERNAL_SERVER_ERROR, $error);
die $error;
}
else {
_http_error($c, RC_NOT_FOUND);
}
$c->close();
undef $c;
}
}
sub _http_error {
my ($c, $code, $msg) = #_;
$c->send_error($code, $msg);
}
sub _http_response {
my $c = shift;
my $options = shift;
$c->send_response(
HTTP::Response->new(
RC_OK,
undef,
[
'Content-Type' => $options->{content_type},
'Cache-Control' => 'no-store, no-cache, must-revalidate, post-check=0, pre-check=0',
'Pragma' => 'no-cache',
'Expires' => 'Thu, 01 Dec 1994 16:00:00 GMT',
],
join("\n", #_),
)
);
}

Answer 2

There is a very fine example in the documentation for HTTP::Daemon.

Answer 3

A client example compliant with the synopsys from HTTP::Daemon :
require LWP::UserAgent;
my $ua = LWP::UserAgent->new;
$ua->timeout(10);
$ua->env_proxy;
my $response = $ua->get('http://localhost:52798/xyzzy');
if ($response->is_success) {
print $response->decoded_content; # or whatever
}
else {
die $response->status_line;
}
You just need to adapt the port and maybe the host.