File: 07-envdir.t

package info (click to toggle)
libserver-starter-perl 0.17-2
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 332 kB
  • ctags: 176
  • sloc: perl: 2,545; makefile: 2
file content (100 lines) | stat: -rw-r--r-- 2,977 bytes parent folder | download
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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
use strict;
use warnings;

use File::Temp ();
use Test::TCP;
use Test::More tests => 4;

use Server::Starter qw(start_server);

$SIG{PIPE} = sub {};

my $tempdir = File::Temp::tempdir(CLEANUP => 1);

# Prepare envdir
mkdir "$tempdir/env" or die $!;
open my $envfh, ">", "$tempdir/env/FOO" or die $!;
print $envfh "foo-value1";
close $envfh;
undef $envfh;
sleep 1;

test_tcp(
    server => sub {
        my $port = shift;
        start_server(
            port        => $port,
            exec        => [
                $^X, qw(t/07-envdir-print.pl),
            ],
            status_file => "$tempdir/status",
            envdir => "$tempdir/env",
        );
    },
    client => sub {
        my ($port, $server_pid) = @_;
        #sleep 1;
        my $fetch_env = sub {
            my $sock = IO::Socket::INET->new(
                PeerAddr => "127.0.0.1:$port",
                Proto    => 'tcp',
            ) or die $!;
            my $buf;
            $sock->sysread($buf, 1048576)
                or die $!;
            undef $sock;
            $buf;
        };
        my $restart = sub {
            sub getstatus {
                my ($file, $value);
                open($file, '<', "$tempdir/status") or return '';
                do { local $/ = undef; $value = <$file>; };
                close $file;
                $value // '';
            }
            sub getsinglegeneration {
                my $status;
                do {
                    sleep 1 if defined $status;
                    $status = getstatus;
                } until ($status =~ /\A\d+:\d+\n\z/);
                chomp $status;
                $status;
            }
            my $previous_generation = getsinglegeneration;
            kill "HUP", $server_pid;
            my $current_generation;
            while (($current_generation = getsinglegeneration) eq
                    $previous_generation) {
                sleep 1;
            }
            diag "Server changed from <$previous_generation> ",
                "to <$current_generation>\n";
        };
        # Initial worker does not read envdir
        my $buf = $fetch_env->();
        unlike($buf, qr/^FOO=foo-value1$/m,
            'environment not read for the first time');
        # rewrite envdir
        open my $envfh, ">", "$tempdir/env/FOO" or die $!;
        print $envfh "foo-value2";
        close $envfh;
        undef $envfh;
        # switch to next gen
        $restart->();
        # new worker reads the rewritten envdir
        $buf = $fetch_env->();
        like($buf, qr/^FOO=foo-value2$/m, 'changed env');
        # remove the env file and check that the removal gets reflected
        unlink "$tempdir/env/FOO"
            or die $!;
        # switch to next gen
        $restart->();
        # new worker reads the rewritten envdir
        $buf = $fetch_env->();
        unlike($buf, qr/^FOO=foo-value2$/m, 'removed env');
    },
);

ok ! -e "$tempdir/status", 'no more status file';