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         2  
  2         20  
17              
18 2     2   28 use strict;
  2         4  
  2         50  
19 2     2   12 use warnings;
  2         4  
  2         74  
20             our $VERSION = '0.02';
21              
22 2     2   10 use vars '@ISA'; @ISA = ('Doit::_AnyRPCImpl');
  2         4  
  2         96  
23              
24 2     2   28 use Doit::Log;
  2         4  
  2         756  
25              
26 2     2 0 28 sub new { bless {}, shift }
27 2     2 0 8 sub functions { qw() }
28              
29             sub do_connect {
30 2     2 0 24 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       14 die "Unhandled options: " . join(" ", %opts) if %opts;
35              
36 2         4 my $self = bless { }, $class;
37              
38 2         1058 require IO::Pipe;
39 2         2628 my $pipe_to_fork = IO::Pipe->new;
40 2         330 my $pipe_from_fork = IO::Pipe->new;
41 2         2451 my $worker_pid = fork;
42 2 50       274 if (!defined $worker_pid) {
    100          
43 0         0 error "fork failed: $!";
44             } elsif ($worker_pid == 0) {
45 1         12 my $d = do {
46 1 50       49 local @ARGV = $dry_run ? '--dry-run' : ();
47 1         83 Doit->init;
48             };
49 1         16 $pipe_to_fork->reader;
50 1         157 $pipe_from_fork->writer;
51 1         71 $pipe_from_fork->autoflush(1);
52 1         152 Doit::RPC::PipeServer->new($d, $pipe_to_fork, $pipe_from_fork, debug => $debug)->run;
53 1         382 CORE::exit(0);
54             }
55              
56 1         71 $pipe_to_fork->writer;
57 1         282 $pipe_from_fork->reader;
58 1         129 $self->{rpc} = Doit::RPC::Client->new($pipe_from_fork, $pipe_to_fork, label => "fork:", debug => $debug);
59 1         16 $self->{pid} = $worker_pid;
60              
61 1         22 $self;
62             }
63              
64       0     sub DESTROY { }
65              
66             {
67             package Doit::RPC::PipeServer;
68 2     2   14 use vars '@ISA'; @ISA = ('Doit::RPC');
  2         4  
  2         864  
69              
70             sub new {
71 1     1   10 my($class, $runner, $pipe_to_server, $pipe_from_server, %options) = @_;
72              
73 1         11 my $debug = delete $options{debug};
74 1 50       5 die "Unhandled options: " . join(" ", %options) if %options;
75              
76 1         19 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   7 my($self) = @_;
86              
87 1         3 my $d;
88 1 50       29 if ($self->{debug}) {
89             $d = sub ($) {
90 0     0   0 Doit::Log::info("WORKER: $_[0]");
91 0         0 };
92             } else {
93 1     15   21 $d = sub ($) { };
94             }
95              
96 1         27 $d->("Start worker ($$)...");
97 1         2 my $pipe_to_server = $self->{pipe_to_server};
98 1         1 my $pipe_from_server = $self->{pipe_from_server};
99              
100 1         6 $self->{infh} = $pipe_to_server;
101 1         7 $self->{outfh} = $pipe_from_server;
102 1         2 while () {
103 5         25 $d->(" waiting for line from comm");
104 5         47 my($context, @data) = $self->receive_data;
105 5 100       217 if (!defined $context) {
    50          
106 1         15 $d->(" got eof");
107 1         16 $pipe_to_server->close;
108 1         102 $pipe_from_server->close;
109 1         53 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         23 $d->(" calling method $data[0]");
118 4         26 my($rettype, @ret) = $self->{runner}->call_wrapped_method($context, @data);
119 4         53 $d->(" sending result back");
120 4         405 $self->send_data($rettype, @ret);
121             }
122             }
123             }
124              
125             1;
126              
127             __END__