File Coverage

blib/lib/Tak/STDIOSetup.pm
Criterion Covered Total %
statement 21 43 48.8
branch 0 14 0.0
condition n/a
subroutine 7 11 63.6
pod 0 1 0.0
total 28 69 40.5


line stmt bran cond sub pod time code
1             package Tak::STDIOSetup;
2              
3 1     1   4794 use Log::Contextual qw(:log);
  1         2  
  1         9  
4 1     1   1407 use Log::Contextual::SimpleLogger;
  1         2  
  1         22  
5 1     1   6 use Tak::ConnectionService;
  1         2  
  1         25  
6 1     1   5 use Tak::Router;
  1         2  
  1         19  
7 1     1   6 use Tak;
  1         2  
  1         22  
8 1     1   6 use IO::Handle;
  1         2  
  1         49  
9 1     1   4 use strictures 1;
  1         9  
  1         57  
10              
11             sub run {
12 0 0   0 0   open my $stdin, '<&', \*STDIN or die "Duping stdin: $!";
13 0 0         open my $stdout, '>&', \*STDOUT or die "Duping stdout: $!";
14 0           $stdout->autoflush(1);
15             # if we don't re-open them then 0 and 1 get re-used - which is not
16             # only potentially bloody confusing but results in warnings like:
17             # "Filehandle STDOUT reopened as STDIN only for input"
18 0 0         close STDIN or die "Closing stdin: $!";
19 0 0         open STDIN, '<', '/dev/null' or die "Re-opening stdin: $!";
20 0 0         close STDOUT or die "Closing stdout: $!";
21 0 0         open STDOUT, '>', '/dev/null' or die "Re-opening stdout: $!";
22 0           my ($host, $level) = @ARGV;
23 0           my $sig = '<'.join ':', $host, $$.'> ';
24             Log::Contextual::set_logger(
25             Log::Contextual::SimpleLogger->new({
26             levels_upto => $level,
27 0     0     coderef => sub { print STDERR $sig, @_; }
28             })
29 0           );
30 0           my $done;
31             my $connection = Tak::ConnectionService->new(
32             read_fh => $stdin, write_fh => $stdout,
33             listening_service => Tak::Router->new,
34 0     0     on_close => sub { $done = 1 }
35 0           );
36 0           $connection->receiver->service->register_weak(remote => $connection);
37 0           $0 = 'tak-stdio-node';
38 0     0     log_debug { "Node starting" };
  0            
39             # Tell the other end that we've finished messing around with file
40             # descriptors and that it's therefore safe to start sending requests.
41 0           print $stdout "Shere\n";
42 0           Tak->loop_until($done);
43 0 0         if (our $Next) { goto &$Next }
  0            
44             }
45              
46             1;