Perl HTTP服務器

Question

我是Perl新手，我有一個關於HTTP服務器和客戶端API的問題。

我想寫一個HTTP服務器，它接受來自HTTP客戶端的請求。問題是我不知道該怎麼做，因爲我是一名Java開發人員，對我來說有點困難。請你能給我一些關於Perl的HTTP::Daemon模塊的教程和例子嗎？

Answer 1

documentation for HTTP::Daemon中有一個很好的例子。

Answer 2

客戶端例如符合新思從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; 
} 

你只需要適應港口和可能的主機。

Answer 3

我花了很多時間試圖讓許多用戶同時創建一個「簡單」的可用Web服務器。 HTTP::Daemon和其他在線資源的文檔不幫助我。

這裏是工作（Ubuntu的12.10的默認Perl包v5.14.2）例如preforked不同的內容類型頁面和錯誤頁面 Web服務器：

#!/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", @_), 
     ) 
    ); 
}