File: 25_signal.t

package info (click to toggle)
libfurl-perl 3.14-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 660 kB
  • sloc: perl: 2,188; makefile: 5; sh: 1
file content (70 lines) | stat: -rw-r--r-- 1,988 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
# to test "stop_if"
use strict;
use warnings;
use Furl::HTTP;
use Test::TCP;
use Test::More;
use FindBin;
use lib "$FindBin::Bin/../..";
use t::HTTPServer;

plan skip_all => "Win32 is not supported" if Furl::HTTP::WIN32;

my $n = shift(@ARGV) || 3;
test_tcp(
    client => sub {
        my $port = shift;
        my $stop_if = 0;
        my $furl = Furl::HTTP->new(
            bufsize => 10,
            stop_if => sub { $stop_if },
        );
        local $SIG{ALRM} = sub {
            note "caught ALRM";
        };
        for (1 .. $n) {
            note "try it $_ with stop_if=false";
            # ignore signal
            $stop_if = undef;
            alarm(2);
            my ($undef, $code, $msg, $headers, $content) =
                $furl->request(
                    port       => $port,
                    path_query => '/',
                    host       => '127.0.0.1',
                );
            is $code, 200, "ignore signal ($_)";
            alarm(0);
            sleep(4); # wait until the server stops handling the request
            # cancel on signal
            note "try it $_ with stop_if=true";
            $stop_if = 1;
            alarm(2);
            ($undef, $code, $msg, $headers, $content) =
                $furl->request(
                    port       => $port,
                    path_query => '/5',
                    host       => '127.0.0.1',
                );
            is $code, 500, "cancelled ($_)";
            alarm(0);
            sleep(4); # wait until the server stops handling the request
        }
        done_testing;
    },
    server => sub {
        my $port = shift;
        t::HTTPServer->new(port => $port)->run(sub {
            my $env = shift;
            sleep(4);
            return [
                200,
                [
                    'Content-Type'   => 'text/plain',
                    'Content-Length' => 5,
                ],
                [ 'hello' ],
            ];
        });
    },
);