当我停止循环时，http ::守护进程坠毁

我正在处理Adhoc GUI，以便我可以轻松地查看VMware Perl SDK的一堆数据，而不必在IIS下设置一堆脚本。基本思想是启动脚本，并将其分配两个过程。其中一个是HTTP :: Daemon Web服务器，然后两秒钟后，Win32 :: ieAutomation run browser。我承认，这不是很漂亮，但是我对VMPerlsDK比VMCOMSDK感到满意。再加上我很好奇，看看我是否可以工作。

据我所知，该程序可以开始使用。叉子起作用。小URI解析器有效。唯一的问题是，每当我尝试致电/退出以关闭服务器时，脚本都会爆炸。

任何建议（除了如何使用IIS和Autoit做到这一点之外，我知道）将不胜感激。谢谢！

#!/usr/bin/perl -w
use Data::Dumper;
use HTTP::Daemon;
use HTTP::Status;
use HTTP::Response;
use strict;
use warnings;
use Win32::IEAutomation;
sub MainPage {
    return<<eol
<html>
<head><title>Test</title></head>
<body>
<h3>Home</h3>
<p><a href="/quit">Quit</a></p>
</body>
</html>
eol
}
# Parses out web variables
sub WebParse {
    my ($wstring) = @_;
    my %webs = ();
    # gets key/value data
    my @pairs = split(/&/, $wstring);
    # puts the key name into an array
    foreach my $pair (@pairs) {
            my ($kname, $kval) = split (/=/, $pair);
            $kval =~ tr/+/ /;
            $kval =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
            $webs{$kname} = $kval;
    }
    return(%webs);
}
sub StartServer {
    my $PORT = shift;
    my $ALLOWED = shift;
    my $d = HTTP::Daemon->new(ReuseAddr => 1, LocalAddr => $ALLOWED, LocalPort => $PORT) || die;
    # Prints a startup message
    print "Please contact me at: <URL:", $d->url, ">n";
    my $xt = 0;
    BLOOP: while (my $c = $d->accept) {
        while (my $r = $c->get_request) {
            # Handles requests with the GET or POST methods
            if ($r->method =~ m/GET/i || $r->method =~ m/POST/i) {
                my $uri = $r->uri; my %ENV = ();
                $ENV{REQUEST_METHOD} = $r->method;
                $ENV{CONTENT_TYPE}   = join('; ', $r->content_type);
                $ENV{CONTENT_LENGTH} = $r->content_length || '';
                $ENV{SCRIPT_NAME}    = $uri->path || 1;
                $ENV{REMOTE_ADDR}    = $c->peerhost();
                if ($r->method =~ m/GET/i) {
                    $ENV{QUERY_STRING}   = $uri->query || '';
                }
                elsif ($r->method =~ m/POST/i) {
                    $ENV{QUERY_STRING}   = $r->{"_content"} || '';
                }
                my %q = &WebParse($ENV{QUERY_STRING});
                my $res = HTTP::Response->new("200");
                if ($uri =~ m/quit/i) {
                    $res->content("Goodbye");
                    $xt=1;
                }
                else {
                    $res->content(MainPage());
                }
                $c->send_response($res);
            }
            # Otherwise
            else {
                $c->send_error("This server only accepts GET or POST methods");
            }
            if ($xt == 1) {
                sleep(2);
                $c->force_last_request();
                last BLOOP;
            }
            $c->close;
        }
        undef($c);
    }
    $d->close;
    undef($d);
    exit;
}
sub StartInterface {
    my $PORT = shift;
    my $ALLOWED = shift;
    my $ie = Win32::IEAutomation->new(visible => 1, maximize => 1);
    $ie->gotoURL("http://".$ALLOWED.":".$PORT."/");
    exit;
}
# Return Status
my $STATUS = 1;
# Server port number
my $PORT = 9005;
# The server that's allowed to talk to this one
my $ALLOWED = "127.0.0.1";
my $pid = fork();
if ($pid == 0) {
    StartServer($PORT, $ALLOWED);
} else {
    sleep(2);
    StartInterface($PORT, $ALLOWED);
}
exit;

在关闭守护程序$ d之前，请关闭套接字，并告诉父母pid退出：

$d->shutdown(2);
$d->close;
undef $d;
kill(2,getppid());
exit;

相关内容

最新更新

热门标签：