[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 メーリングリストの案内