AnyEventを使ってHTTPD書いてみた。モジュールリロードもやれる子。
まぁ、アプリケーションサーバライクな部分のコードを書いて無いから、
モジュールリロード部分はさっぱり役に立たないけれどｗｗｗ。
試したい場合は、create_responseでreq、resを受け取ってホゲホゲするパッケージを書いてやると良いよ。
AnyEvent::HTTPDを使えば良いじゃん、って話もあるけど、あれって微妙で・・・。
Object::Eventとか要らんもの使っていて、モジュールのリロードが痛いコードになったり、
ヘッダに同じキーが2作るとアウトだったり(Cookieで刺さる)。HTTP::Requestじゃないのが痛かったり。
他も微妙と言うか、べっつにこんくらい自分で書けよ、シリーズだったので。
なんでもCPAN使えば良いってもんじゃない。と言うかそれやると無駄な苦労が増える場合の方が多かったりｗｗｗ。
最近ホント酷いものねぇ。困ったもんです。Ratingが一切アテにならないと言う・・・。
CPANに対する愚痴はほどほどにしといて、このコード、前書いたechoより随分コードが増えてると思う。特にレスポンス周り。
echoのサンプル、実は、レスポンスで返すデータが増えると、データが途中でぶった切られるのよね。
サンプルのエコーサーバ程度だからあれで済むんだけど、本気でサーバやるとなるとそれじゃ困る。
何故にデータが途中で切られるか、と言うと、ソケットが書き込み可能の状態じゃないのに無理やり書こうとするから。
この原因は、ソケットが読み書き両用でオープンされてて、あっちからデータが来たりこっちから書いたりがブツかって、
いやーんな状態になったりするから。
そう言う場合EAGAINって言うエラーが飛んでくる。これは読めないのに無理やりソケットからデータを読もうとしても飛ぶエラー。
データが無いのに読んだりね。
だから、ソケットが書ける状態なのかをAnyEventのioで監視して、書ける状態になったら書き込み開始。
で、書いてる最中にEAGAIN起こっちゃったら、書くの中止して、再びソケットの監視へ、ってな風にやれば良い。
それをwrite_responseで再帰使ってやってる。
これで、最低限動くHTTPDの出来上がり。
#!/usr/bin/perl
use AnyEvent;
use AnyEvent::Socket;
use IO::Handle;
use HTTP::Parser;
use Errno qw(EAGAIN);
use Data::Dumper;
my $HOST = '192.168.0.100';
my $PORT = 8080;
my $HTTP_VERSION = '1.1';
my $MODULE_RELOAD = 0.5;
$| = 1;
server_listen();
sub server_listen {
tcp_server $HOST, $PORT, sub {
my ($sock, $host, $port) = @_;
autoflush $sock 1;
print "Client connected: $host($port)\n";
my $sock_watcher; $sock_watcher = AnyEvent->io(
fh => $sock,
poll => 'r',
cb => sub {
my $data;
while (<$sock>) { $data .= $_; }
my $res = create_response(parse_request($data));
$res->header('Content-Length' => length $res->content);
my $res_data = "HTTP/$HTTP_VERSION " . $res->as_string;
my $res_len = length $res_data;
write_response($sock, $res_data, $res_len);
undef $sock_watcher;
},
);
}, sub {
my ($fh, $host, $port) = @_;
print "HTTP server is listening on $host($port)\n";
};
if ($MODULE_RELOAD) { reload_check(); }
else { AnyEvent->condvar->recv; }
}
sub parse_request {
my $parser = new HTTP::Parser(request => 1);
if ($parser->add(shift) == 0) {
my $req = $parser->request;
warn 'URI: ' . $req->uri;
warn 'METHOD: ' . $req->method;
warn Dumper $req->headers;
return $req;
}
}
sub create_response {
my ($req) = @_;
my $res = new HTTP::Response;
$res->code(200);
$res->header('Content-Type' => 'text/html');
my $content;
for ('a' .. 'z') { $content .= $_ x 10000 . "
\n"; }
$res->content($content);
return $res;
}
sub write_response {
my ($sock, $res_data, $res_len, $offset) = @_;
my $w_sock_watcher; $w_sock_watcher = AnyEvent->io(
fh => $sock,
poll => 'w',
cb => sub {
defined $offset or $offset = 0;
while (my $len = syswrite $sock, $res_data, $res_len, $offset) {
$offset += $len;
$offset == $res_len and last;
}
if ($! == EAGAIN && $offset != $res_len) {
undef $w_sock_watcher;
write_response($sock, $res_data, $res_len, $offset);
}
undef $w_sock_watcher;
}
);
}
sub reload_check {
my $cv = AnyEvent->condvar;
my $time_watcher = AnyEvent->timer(
interval => $MODULE_RELOAD,
cb => sub {
if (my $target = module_reload()) {
for (keys %$target) { print "Reloaded: $_($target->{$_})\n"; }
}
},
);
$cv->wait;
}
sub module_reload {
my %reloaded = ();
for (keys %INC) {
my $lm = -M $INC{$_};
my $path = $INC{$_};
$lm == $LAST_MODIFY{$_} and next;
if ($LAST_MODIFY{$_}) {
delete $INC{$_};
eval { require $path; };
if ($@) { $INC{$_} = $path; warn $@; }
else { $reloaded{$_} = $path; }
}
$LAST_MODIFY{$_} = $lm;
}
return %reloaded ? \%reloaded : undef;
}
