使用 CTRL + C 终止当前 LWP 请求

Question

我有一个基于 Term::ReadLine 和 LWP::UserAgent

的脚本

逻辑是这样的，

while (defined ($_ = $term->readline('console> ')))
{
    next unless $_; chomp;

    if ($_ eq 'exit')
    {
        last;
    }
    &run ($_);
}

sub run {
    my $ua   = LWP::UserAgent->new;
    my $resp = $ua->get (...);

    say $resp->content;
}

在 run 中它将执行 LWP 请求。现在如果我按下 CTRL + C，不仅 LWP 被终止，整个 perl 脚本也被终止。

我只想终止 LWP 请求。有任何想法吗？

我可以添加一个 SIGINT 处理程序，但我不知道该处理程序应该做什么

Answer 1

停止代码的一种方法是运行它在 child 进程中 kill child 在 parent 的信号处理程序中SIGINT 被 parent 接收。 parent 保持运行ning 因为信号被处理。

use warnings;
use strict;
use feature 'say';

$SIG{INT} = \&sigint_handler;    # or: $SIG{INT} = sub { ... };

say "Parent $$ start.";

my $pid = run_proc();
my $gone_pid = waitpid $pid, 0;  # check status, in $?

say "Parent exiting";

sub run_proc
{
    my $pid = fork // die "Can't fork: $!";
    if ($pid == 0) {                               # child process
        say "\tKid, sleep 5 (time for Ctrl-C)";    # run your job here
        sleep 5;                                
        say "\tKid exiting.";
        exit;
    }   
    return $pid;
}

sub sigint_handler { 
    if ($pid and kill 0, $pid) {
        say "Got $_[0], send 'kill TERM' to child process $pid.";
        my $no_signalled = kill 15, $pid;
     }
     else { die "Got $_[0]" }   # or use exit
}

大量代码用于诊断打印。一些评论如下

kill只发送一个信号。它不以任何方式确保进程终止。用 kill $pid, 0 检查这个，如果进程还没有 被收割 （即使它是一个僵尸），returns 为真。在我的系统上 TERM 是 15，尽管这很常见，但请检查一下。

信号可能会在 child 不是运行ning 的时候发出。处理程序首先检查 $pid 是否存在，如果不存在，则 dies/exits，尊重 SIGINT。酌情更改。

在 fork 之后，parent 立即下降到 if ($pid == 0) 和 returns 之后 $pid。

可以在child中安装$SIG{TERM}，如果需要有序退出，可以在里面进行清理。

SIGINT 处理程序也会从 child 中运行，所以 "Got $_[0] ..." 被打印了两次。如果这是一个问题，请向 child 添加处理程序以忽略信号 $SIG{INT} = 'IGNORE';。有了这个，当 child 是运行ning 时 Ctrl-C 命中，输出是

Parent 9334 start. Kid, sleep 5 (time for Ctrl-C) ^CGot INT, send 'kill TERM' to child process 9335. Parent exiting

child退出后的状态可以通过$?查看，参见system和in perlvar。

文档：fork (and exec, system), %SIG in perlvar, waitpid, parts of perlipc, kill.

如果在 child 中完成的工作需要与 parent 进行通信，那么还有更多工作要做。但是，添加到问题中的代码片段表明情况并非如此。

Answer 2

您需要在对 $ua->request 的调用中提供回调。在该回调中发出 die 将终止传输。

然后您只需要在 Ctrl-C 信号处理程序中设置一个标志变量，如果设置了该标志，则在回调中设置 die。

当我回到 PC 并且当您展示了您的 run 子例程的功能时，我会编写一些代码。

下面是一些看起来不错的代码，但我目前无法测试

注意 run 是任何子程序的可怕标识符，尤其是启动网络传输并打印结果的子程序

sub run {

    my ($url) = @_;

    my $die;
    local $SIG{INT} = sub { $die = 1 };

    my $ua = LWP::UserAgent->new;

    my $resp = $ua->get(
        $url,
        ':content_cb' => sub {
            die "Interrupted LWP transfer" if $die;
            my ($data, $resp, $proto) = @_;
            print $data;
        },
        ':read_size_hint' => 1024
    );

    print "\n";  # Emulate additional newline from `say`
}

请注意，减少 :read_size_hint 会导致使用更小的数据块更频繁地调用回调。这样会提高对Ctrl-C的响应，但会降低传输效率

Answer 3

将信号转换为异常。

local $SIG{INT} = sub { die "SIGINT\n" };

通常，人们会将代码包装在 eval BLOCK 中，但 LWP::UserAgent 会捕获这些异常并 returns 错误响应。

例如，

use LWP::UserAgent;
my $ua = LWP::UserAgent->new();
my $response = do {
   local $SIG{INT} = sub { die "SIGINT\n" };
   $ua->get("http://localhost/zzz.crx")
};
say $response->is_success ? "Successful" : "Unsuccessful";
say $response->code;
say $response->status_line;

如果没有收到 SIGINT 则输出：

Successful
200
200 OK

如果收到 SIGINT 则输出：

Unsuccessful
500
500 SIGINT

使用 CTRL + C 终止当前 LWP 请求

Kill current LWP request with CTRL + C

perl

lwp