1

IISで一連のスクリプトを設定しなくても、VMWare Perl SDKから大量のデータを簡単に表示できるように、アドホックGUIに取り組んでいます。基本的な考え方は、スクリプトを起動し、2つのプロセスをフォークさせることです。1つはHTTP::Daemon Webサーバーで、2秒後にWin32::IEAutomation実行ブラウザーです。かわいくないことは認めますが、VMCOMSDKよりもVMPerlSDKの方が少し快適です。さらに、これを機能させることができるかどうかを知りたいと思っています。

私の知る限り、プログラムは大丈夫です。フォークは機能します。小さなURIパーサーが機能します。唯一の問題は、サーバーをシャットダウンするために/ quitを呼び出そうとすると、スクリプトが爆発することです。

（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;
4

1 に答える 1

0

デーモン $d を閉じる前に、ソケットをシャットダウンし、親 pid に終了を指示します。

$d->shutdown(2);
$d->close;
undef $d;
kill(2,getppid());
exit;
于 2018-06-15T20:27:39.857 に答える