Question

我正在开发一个adhoc GUI，这样我就可以轻松地从VMWare Perl SDK中查看大量数据，而无需在IIS下设置一堆脚本。基本的想法是启动脚本，并让它分叉两个进程。一个是HTTP :: Daemon Web服务器，然后两秒钟后它的Win32 :: IEAutomation运行浏览器。我承认，它并不漂亮，但我对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;

Answer 1

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

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

当我停止循环时HTTP ::守护进程崩溃

1 个答案: