[Tokyo.pm] httpd control (Long)
harada goichi
goichi @ mb.kcom.ne.jp
2000年 9月 28日 (木) 09:55:51 CDT
こんばんは、吾一です。
Yasuo Matsumoto wrote:
>
> 松本です。
>
> 現実逃避モードです。
> ということで Perl Multi Control(中身はただの httpd)を考えています。
WindowsのActivePerl5.6のforkは、擬似プロセス(実態は5.6タイプのスレッ
ド)
を産んでいるので、幾つか制限があるみたいですね。
その一つにコールバックから呼べないというのがあって、そのせいで
「ボタンを押したらforkしてデーモン開始」ってわけにはいかないみたいです。
僕にはWin32::Processを使う以外に良い方法は思いつきませんでした。
以下、ちょっと挑戦してみたサンプルです。
Windows2000で確認しました。
コントロールスクリプトとデーモンスクリプトを同じディレクトリに
保存して実行してみてください。
デーモンスクリプトは、daemon.plって名前にしてください。
# 本体はまだ改良中です。
#####################
# コントロールスクリプト
#!perl
use Tk;
use Win32::Process;
use FindBin qw($Bin);
use Config;
my $ProcessObj;
my $daemon_script = "daemon.pl";
my $mw = new MainWindow;
$l = $mw->Label(-text => "daemon stoped")->pack();
$mw->Button(-text=>"start daemon", -command => \&start_daemon)->pack();
$mw->Button(-text=>"stop daemon", -command => \&stop_daemon)->pack();
MainLoop;
sub
ErrorReport{
print Win32::FormatMessage( Win32::GetLastError() );
}
sub
start_daemon{
if (! $ProcessObj){
print STDERR "start Daemon\n";
Win32::Process::Create($ProcessObj,
$Config{bin} . "\\perl.exe",
"perl.exe $daemon_script",
0,
NORMAL_PRIORITY_CLASS,
".")|| die ErrorReport();
$l->configure(-text => "daemon running");
}
}
sub
stop_daemon{
if ($ProcessObj){
$ProcessObj->Kill( 0 );
undef ($ProcessObj);
print STDERR "stop Daemon\n";
$l->configure(-text => "daemon stopped");
}
}
###############################
#!perl
# デーモンスクリプト
use HTTP::Daemon;
use HTTP::Status;
use FindBin qw($Bin);
my $DOC_ROOT = $Bin;
sub dmsg
{
print STDERR scalar localtime,": @_\n";
}
my $d = new HTTP::Daemon LocalPort => 80;
print "Please contact me at: <URL:", $d->url, ">\n";
while (my $c = $d->accept) {
while (my $r = $c->get_request) {
if ($r->method eq 'GET'){
if ( ($file = $r->url->path) ne undef) {
dmsg "Request $file";
$c->send_basic_header();
if (-f "$DOC_ROOT$file" and $file =~ /\.htm(l)?$/){
$c->send_file_response("$DOC_ROOT$file");
}
elsif (-d "$DOC_ROOT$file"){
$c->send_response("Content-type: text/html");
$c->send("<html><head><title>dir
list</title></head><body>");
for (grep {/\.htm(l)?/} glob("$DOC_ROOT$file*")){
$c->send("<a href=\"$_\">$_</a><br>");
}
$c->send("</body></html>");
}
else {
$c->send_error(RC_FORBIDDEN);
}
}
}
else {
$c->send_error(RC_FORBIDDEN);
}
}
$c->close;
undef($c);
}
--
---------------------------------------
Goichi Harada
E-mail goichi @ mb.kcom.ne.jp
Tokyo-pm メーリングリストの案内