File: rt65460-forking.t

package info (click to toggle)
libpoe-perl 2%3A1.3670-1
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 1,996 kB
  • ctags: 1,416
  • sloc: perl: 22,865; makefile: 9
file content (184 lines) | stat: -rw-r--r-- 4,461 bytes parent folder | download | duplicates (7)
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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
#!/usr/bin/perl -w
# vim: ts=2 sw=2 expandtab

# POE::Kernel should be able to handle daemonization with no issues

# enable this to get debugging output
sub DEBUG () { 0 }

BEGIN {
  my $error;
  if ($^O eq "MSWin32") {
    $error = "$^O does not support fork()";
  } elsif ( ! $ENV{RELEASE_TESTING} && ! $ENV{AUTOMATED_TESTING} ) {
    $error = "enable by setting (AUTOMATED|RELEASE)_TESTING";
  }

  if ($error) {
    print "1..0 # Skip $error\n";
    exit;
  }
}

use strict;

use lib qw(./mylib ../mylib);

use POE;
use POE::Wheel::Run;
use POE::Wheel::FollowTail;
use POE::Filter::Reference;
use POE::Filter::Line;
use File::Temp qw( tempfile );

# 3 sets of daemonization methods * 2 timing of daemonization * run has_forked() or not?
use Test::More tests => 12;

my @tests;
foreach my $t ( qw( nsd dd mxd ) ) {
  # nsd = Net::Server::Daemonize ( single-fork )
  # dd = Daemon::Daemonize ( double-fork )
  # mxd = MooseX::Daemonize ( single-fork with some extra stuff )

  foreach my $timing ( qw( before after ) ) {
    foreach my $forked ( qw( has_fork no_fork ) ) {
      push( @tests, [ $t, $timing, $forked ] );
    }
  }
}
my_spawn( @{ pop @tests } );

sub my_spawn {
  POE::Session->create(
    package_states => [
      'main' => [qw(_start _stop _timeout _wheel_stdout _wheel_stderr _wheel_closed _wheel_child _daemon_input _child)],
    ],
    'args' => [ @_ ],
  );
}

POE::Kernel->run();

sub _child {
  return;
}

sub _start {
  my ($kernel,$heap,$type,$timing,$forked) = @_[KERNEL,HEAP,ARG0 .. ARG2];
  $heap->{type} = $type;
  $heap->{timing} = $timing;
  $heap->{forked} = $forked;

  # Create a tempfile to communicate with the daemon
  my ($fh,$filename) = tempfile( UNLINK => 1 );
  $heap->{follow} = POE::Wheel::FollowTail->new(
    Handle => $fh,
    InputEvent => '_daemon_input',
  );

  my $program = [ $^X, '-e', 'use lib qw(./mylib ../mylib); require "ForkingDaemon.pm";' ];

  $heap->{wheel} = POE::Wheel::Run->new(
    Program      => $program,
    StdoutEvent  => '_wheel_stdout',
    StdinFilter  => POE::Filter::Reference->new,
    StderrEvent  => '_wheel_stderr',
    StdoutFilter => POE::Filter::Line->new,
    ErrorEvent   => '_wheel_error',
    CloseEvent   => '_wheel_closed',
  );

  # tell the daemon to go do it's stuff and communicate with us via the tempfile
  $heap->{wheel}->put( {
    file => $filename,
    timing => $timing,
    type => $type,
    forked => $forked,
    debug => DEBUG(),
  } );

  $kernel->sig_child( $heap->{wheel}->PID, '_wheel_child' );
  $kernel->delay( '_timeout', 10 );
  return;
}

sub _daemon_input {
  my ($kernel,$heap,$input) = @_[KERNEL,HEAP,ARG0];

  if ( $input eq 'DONE' ) {
    # we are done testing!
    pass( "POE ($heap->{type}|$heap->{timing}|$heap->{forked}) successfully exited" );

    # cleanup
    undef $heap->{wheel};
    undef $heap->{follow};
    $kernel->delay( '_timeout' );

    # process the next test combination!
    my_spawn( @{ pop @tests } ) if @tests;
  } elsif ( $input =~ /^OLDPID\s+(.+)$/ ) {
    # got the PID before daemonization
    warn "Got OLDPID($heap->{type}|$heap->{timing}|$heap->{forked}): $1" if DEBUG;
    $heap->{daemon} = $1;
  } elsif ( $input =~ /^PID\s+(.+)$/ ) {
    # got the PID of the daemonized process
    my $pid = $1;
    warn "Got PID($heap->{type}|$heap->{timing}|$heap->{forked}): $pid" if DEBUG;
    if ( $heap->{daemon} == $pid ) {
      die "Failed to fork!";
    }
    $heap->{daemon} = $pid;
  } else {
    warn "daemon($heap->{type}|$heap->{timing}|$heap->{forked}): $input\n" if DEBUG;
  }

  return;
}

sub _wheel_stdout {
  my ($heap) = $_[HEAP];
  warn "daemon($heap->{type}|$heap->{timing}|$heap->{forked}) STDOUT: " . $_[ARG0] if DEBUG;
  return;
}

sub _wheel_stderr {
  my ($heap) = $_[HEAP];
  warn "daemon($heap->{type}|$heap->{timing}|$heap->{forked}) STDERR: " . $_[ARG0] if DEBUG;
  return;
}

sub _wheel_closed {
  undef $_[HEAP]->{wheel};
  return;
}

sub _wheel_child {
  $poe_kernel->sig_handled();
  return;
}

sub _stop {
  return;
}

sub _timeout {
  my $heap = $_[HEAP];

  # argh, we have to kill the daemonized process
  if ( exists $heap->{daemon} ) {
    CORE::kill( 9, $heap->{daemon} );
  } else {
    die "Something went seriously wrong";
  }

  fail( "POE ($heap->{type}|$heap->{timing}|$heap->{forked}) successfully exited" );

  # cleanup
  undef $heap->{wheel};
  undef $heap->{follow};

  # process the next test combination!
  my_spawn( @{ pop @tests } ) if @tests;

  return;
}