File Coverage

blib/lib/Doit/Fork.pm
Criterion Covered Total %
statement 68 76 89.4
branch 10 16 62.5
condition n/a
subroutine 12 14 85.7
pod 0 3 0.0
total 90 109 82.5


line stmt bran cond sub pod time code
1             # -*- perl -*-
2              
3             #
4             # Author: Slaven Rezic
5             #
6             # Copyright (C) 2017,2023 Slaven Rezic. All rights reserved.
7             # This package is free software; you can redistribute it and/or
8             # modify it under the same terms as Perl itself.
9             #
10             # Mail: slaven@rezic.de
11             # WWW: http://www.rezic.de/eserte/
12             #
13              
14             package Doit::Fork;
15              
16 2     2   16 use Doit;
  2         4  
  2         16  
17              
18 2     2   14 use strict;
  2         4  
  2         58  
19 2     2   10 use warnings;
  2         4  
  2         146  
20             our $VERSION = '0.02';
21              
22 2     2   14 use vars '@ISA'; @ISA = ('Doit::_AnyRPCImpl');
  2         6  
  2         174  
23              
24 2     2   18 use Doit::Log;
  2         6  
  2         1318  
25              
26 2     2 0 30 sub new { bless {}, shift }
27 2     2 0 8 sub functions { qw() }
28              
29             sub do_connect {
30 2     2 0 10 my($class, %opts) = @_;
31              
32 2         6 my $dry_run = delete $opts{dry_run};
33 2         4 my $debug = delete $opts{debug};
34 2 50       8 die "Unhandled options: " . join(" ", %opts) if %opts;
35              
36 2         6 my $self = bless { }, $class;
37              
38 2         1898 require IO::Pipe;
39 2         4146 my $pipe_to_fork = IO::Pipe->new;
40 2         478 my $pipe_from_fork = IO::Pipe->new;
41 2         6198 my $worker_pid = fork;
42 2 50       340 if (!defined $worker_pid) {
    100          
43 0         0 error "fork failed: $!";
44             } elsif ($worker_pid == 0) {
45 1         38 my $d = do {
46 1 50       80 local @ARGV = $dry_run ? '--dry-run' : ();
47 1         110 Doit->init;
48             };
49 1         30 $pipe_to_fork->reader;
50 1         128 $pipe_from_fork->writer;
51 1         53 $pipe_from_fork->autoflush(1);
52 1         118 Doit::RPC::PipeServer->new($d, $pipe_to_fork, $pipe_from_fork, debug => $debug)->run;
53 1         364 CORE::exit(0);
54             }
55              
56 1         108 $pipe_to_fork->writer;
57 1         438 $pipe_from_fork->reader;
58 1         290 $self->{rpc} = Doit::RPC::Client->new($pipe_from_fork, $pipe_to_fork, label => "fork:", debug => $debug);
59 1         46 $self->{pid} = $worker_pid;
60              
61 1         35 $self;
62             }
63              
64       0     sub DESTROY { }
65              
66             {
67             package Doit::RPC::PipeServer;
68 2     2   22 use vars '@ISA'; @ISA = ('Doit::RPC');
  2         2  
  2         1274  
69              
70             sub new {
71 1     1   6 my($class, $runner, $pipe_to_server, $pipe_from_server, %options) = @_;
72              
73 1         4 my $debug = delete $options{debug};
74 1 50       3 die "Unhandled options: " . join(" ", %options) if %options;
75              
76 1         36 bless {
77             runner => $runner,
78             pipe_to_server => $pipe_to_server,
79             pipe_from_server => $pipe_from_server,
80             debug => $debug,
81             }, $class;
82             }
83              
84             sub run {
85 1     1   2 my($self) = @_;
86              
87 1         5 my $d;
88 1 50       17 if ($self->{debug}) {
89             $d = sub ($) {
90 0     0   0 Doit::Log::info("WORKER: $_[0]");
91 0         0 };
92             } else {
93 1     15   40 $d = sub ($) { };
94             }
95              
96 1         61 $d->("Start worker ($$)...");
97 1         3 my $pipe_to_server = $self->{pipe_to_server};
98 1         2 my $pipe_from_server = $self->{pipe_from_server};
99              
100 1         8 $self->{infh} = $pipe_to_server;
101 1         5 $self->{outfh} = $pipe_from_server;
102 1         18 while () {
103 5         16 $d->(" waiting for line from comm");
104 5         45 my($context, @data) = $self->receive_data;
105 5 100       221 if (!defined $context) {
    50          
106 1         7 $d->(" got eof");
107 1         10 $pipe_to_server->close;
108 1         114 $pipe_from_server->close;
109 1         37 return;
110             } elsif ($data[0] =~ m{^exit$}) {
111 0         0 $d->(" got exit command");
112 0         0 $self->send_data('r', 'bye-bye');
113 0         0 $pipe_to_server->close;
114 0         0 $pipe_from_server->close;
115 0         0 return;
116             }
117 4         31 $d->(" calling method $data[0]");
118 4         36 my($rettype, @ret) = $self->{runner}->call_wrapped_method($context, @data);
119 4         21 $d->(" sending result back");
120 4         63 $self->send_data($rettype, @ret);
121             }
122             }
123             }
124              
125             1;
126              
127             __END__