一个Perl模块中使用Win32进程和线程的方法

Question

我正在尝试适应在Windows上运行的Perl代码，其中需要启动一个单独的进程并执行一些多线程流程（该进程可能会继续运行或在执行多线程流程时退出）。

基本上，逻辑如下：

use Win32::Process;
use threads;
use strict;

my $proc;
Win32::Process::Create($proc,'dir','',0,NORMAL_PRIORITY_CLASS(),".");

my $t1= threads->create(\&thread_proc);
my $t2= threads->create(\&thread_proc);

sleep 2;
print "Waiting for thread ".$t1->tid." to exit\n";
$t1->join();
print "Waiting for thread ".$t2->tid." to exit\n";
$t2->join();
print "All done.\n";
# Cleanup would be here

sub thread_proc {
  foreach (1..5) {
    print "Thread ".threads->tid." waiting $_\n";
    sleep 1;
  }
  return 0;
}

当执行到第二个join时，Perl就会崩溃（调试器显示堆已被破坏）。

如果我注释掉上面的Win32::Process::Create，它就能正常工作。

用Win32::Job替换Win32::Process也没有帮助，虽然它还会产生以下信息：

Free to wrong pool 4a47c0 not 328400 at ...

将整个线程逻辑封装到 BEGIN {} 块中似乎可以解决崩溃的问题，但这不是一个理想的解决方法，因为在实际代码中，与线程相关的逻辑更加复杂，不能轻易地本地化。

在 Win32::Process 或 Win32::Job 文档（或其他任何地方）中，我都找不到关于这些模块不支持线程的信息。

因此，问题是，代码是否有误，还是模块存在通用问题，在后一种情况下，是否存在已知相对稳定的类似模块可供使用？

草莓 Perl 5 版本24，子版本1 (v5.24.1)，构建于 MSWin32-x64-multi-thread

- elenst

---

只进行分叉(forking)可能更简单。 - Sinan Ünür

同意，我倾向于这种方法。我一直在尝试实验，目前看来效果不错。在Linux上已经是这样了，但是在Windows上实现的方式有所不同，需要使用线程/进程等。通过一些搜索，似乎在Windows上分叉操作一直以来都不太受欢迎，也许这就是选择其他方法的原因。但是如果事实证明“聪明”的方法真的行不通，我会让它普遍地进行分叉操作。 - elenst

现在我完全不理解这个问题 - 为什么你要在那里使用 Win32::Process::Create？我以为你想在单独的进程中运行线程，但是如果你不想混合它们（更好！），那么你在问什么？请注意，在 Win32 上进行分叉是可行的，并且还有很好的模块可用。除非需要以复杂的方式交换数据，否则分叉要简单得多。（请标记您要寻址的人，以便他们收到通知） - zdim

@zdim：目标是以一种方式从Perl内部运行可执行文件，以便Perl代码稍后可以对其进行某些控制（例如获取pid、杀死进程等），并从Perl本身运行一些并发流；Win32::Process之所以存在是因为它在代码中，而不是我的创作；最后，问题是为什么上面的代码会崩溃，它是否基本上是错误的，或者使用的模块是否线程安全，如果是，是否有更好的类似物。分叉是已知的可能性，但在Windows上是有问题的，因此我对替代方案感兴趣。 - elenst

我删除了除一个之外的所有评论，以免分散注意力。 - zdim

Answer 1

您的意图不太清楚。您是希望此进程在Perl程序结束后继续运行吗？还是您想与此进程进行通信？

在大多数情况下，只需使用普通的 fork（在Windows上进行模拟，但大多数内容仍能正常运作）即可，除非您想以Windows特定的方式与 $proc 进行交互。另外请注意，通常 dir 是 cmd.exe 的内置命令，因此除非您在 %PATH% 上拥有 dir.exe、dir.com 或 dir.bat 等文件，否则 Win32::Process 将无法在其中运行。

以下程序可以复制崩溃：

#!/usr/bin/env perl

$| = 1;

use v5.24; # why not?
use strict;
use warnings;

use threads;

use feature 'signatures';
no warnings 'experimental::signatures';

use autouse Carp => qw( croak );
use Win32::GuiTest qw( FindWindowLike SendKeys SetForegroundWindow );
use Win32::Process;
use Win32;

run();

sub run {
    Win32::Process::Create(
        my $proc,
        'C:\WINDOWS\system32\notepad.exe',
        'notepad.exe',
        0,
        +NORMAL_PRIORITY_CLASS,
        '.',
    ) or croak Win32::FormatMessage(Win32::GetLastError());

    my @thr = map threads->create(\&task), 1 .. 2;

    threads->yield;

    my @windows;
    do {
        @windows = FindWindowLike(0, 'Notepad');
    } until (@windows);

    wait_for_thread($_, $windows[0]) for @thr;

    say 'All done.';

    SetForegroundWindow($windows[0]);
    SendKeys('%fxn');

    $proc->Wait(+INFINITE);
    return;
}

sub task {
    my $tid = threads->tid;
    say "Thread $tid waiting ($_)" for 1 .. 5;
    threads->yield;
    return;
}

sub wait_for_thread($thr, $window) {
    my $msg = sprintf "Waiting for thread %d\n", $thr->tid;
    print $msg;

    SetForegroundWindow($window);
    SendKeys($msg);

    $thr->join;
    return;
}

我在调试器中看到了这个：

很可能是线程和Win32::Process之间的交互暴露出了一个错误*。

另一方面，下面的版本似乎运行良好：

#!/usr/bin/env perl

$| = 1;

use v5.24; # why not?
use strict;
use warnings;

use threads;

use feature 'signatures';
no warnings 'experimental::signatures';

use autouse Carp => qw( croak );
use Win32::GuiTest qw( FindWindowLike SendKeys SetForegroundWindow );

run();

sub run {
    defined(my $cpid = fork)
        or croak "Failed to fork: $!";

    if (!$cpid) {
        system 'notepad';
        exit;
    }

    my @thr = map threads->create(\&task), 1 .. 2;

    threads->yield;

    my @windows;
    do {
        @windows = FindWindowLike(0, 'Notepad');
    } until (@windows);

    wait_for_thread($_, $windows[0]) for @thr;

    say 'All done.';

    SetForegroundWindow($windows[0]);
    SendKeys('%fxn');

    1 while waitpid(-1, 0) > 0;
    return;
}

sub task {
    my $tid = threads->tid;
    say "Thread $tid waiting ($_)" for 1 .. 5;
    threads->yield;
    return;
}

sub wait_for_thread($thr, $window) {
    my $msg = sprintf "Waiting for thread %d\n", $thr->tid;
    print $msg;

    SetForegroundWindow($window);
    SendKeys($msg);

    $thr->join;
    return;
}

正如我所提到的，除非有特定的原因需要使用 Win32::Process，否则最好使用 fork。

* 如有疑问，请随时与P5P联系。

- Sinan Ünür

---

谢谢。我打算接受它，因为（a）它确认崩溃确实出现在独立原因上，而且（b）我已经切换到了"fork"，目前看起来它运行得很好。不过我还会等一下，看看是否有其他想法。对于这些问题——是的，进程在某些情况下可能会超过Perl程序的生命周期，但它也可以在Perl生命周期内重新启动（这就是为什么我不能同时使用fork和线程的原因，当进程需要重新启动并且线程已经创建时，情况会变得太混乱了，但我可以在任何地方使用fork）。与该进程通信很少。 - elenst