t/34process-handles.t - metacpan.org

#!/usr/bin/perl

use strict;
use warnings;

use IO::Async::Test;

use Test::More;

use IO::Async::Process;

use IO::Async::Loop;
use IO::Async::OS;

plan skip_all => "POSIX fork() is not available" unless IO::Async::OS->HAVE_POSIX_FORK;

use Socket qw( PF_INET sockaddr_family );

my $loop = IO::Async::Loop->new_builtin;

testing_loop( $loop );

{
   my $process = IO::Async::Process->new(
      code => sub { print "hello\n"; return 0 },
      stdout => { via => "pipe_read" },
      on_finish => sub { },
   );

   isa_ok( $process->stdout, "IO::Async::Stream", '$process->stdout' );

   is( $process->stdout->notifier_name, "stdout", '$process->stdout->notifier_name' );
   
   my @stdout_lines;

   $process->stdout->configure(
      on_read => sub {
         my ( undef, $buffref ) = @_;
         push @stdout_lines, $1 while $$buffref =~ s/^(.*\n)//;
         return 0;
      },
   );

   $loop->add( $process );

   ok( defined $process->stdout->read_handle, '$process->stdout has read_handle for sub { print }' );

   wait_for { !$process->is_running };

   ok( $process->is_exited,     '$process->is_exited after sub { print }' );
   is( $process->exitstatus, 0, '$process->exitstatus after sub { print }' );

   is_deeply( \@stdout_lines, [ "hello\n" ], '@stdout_lines after sub { print }' );
}

{
   my @stdout_lines;

   my $process = IO::Async::Process->new(
      code => sub { print "hello\n"; return 0 },
      stdout => {
         on_read => sub {
            my ( undef, $buffref ) = @_;
            push @stdout_lines, $1 while $$buffref =~ s/^(.*\n)//;
            return 0;
         },
      },
      on_finish => sub { },
   );

   isa_ok( $process->stdout, "IO::Async::Stream", '$process->stdout' );

   $loop->add( $process );

   ok( defined $process->stdout->read_handle, '$process->stdout has read_handle for sub { print } inline' );

   wait_for { !$process->is_running };

   ok( $process->is_exited,     '$process->is_exited after sub { print } inline' );
   is( $process->exitstatus, 0, '$process->exitstatus after sub { print } inline' );

   is_deeply( \@stdout_lines, [ "hello\n" ], '@stdout_lines after sub { print } inline' );
}

{
   my $stdout;

   my $process = IO::Async::Process->new(
      code => sub { print "hello\n"; return 0 },
      stdout => { into => \$stdout },
      on_finish => sub { },
   );

   isa_ok( $process->stdout, "IO::Async::Stream", '$process->stdout' );

   $loop->add( $process );

   ok( defined $process->stdout->read_handle, '$process->stdout has read_handle for sub { print } into' );

   wait_for { !$process->is_running };

   ok( $process->is_exited,     '$process->is_exited after sub { print } into' );
   is( $process->exitstatus, 0, '$process->exitstatus after sub { print } into' );

   is( $stdout, "hello\n", '$stdout after sub { print } into' )
}

{
   my $stdout;

   my $process = IO::Async::Process->new(
      command => [ $^X, "-e", 'print "hello\n"' ],
      stdout => { into => \$stdout },
      on_finish => sub { },
   );

   $loop->add( $process );

   wait_for { !$process->is_running };

   ok( $process->is_exited,     '$process->is_exited after perl STDOUT' );
   is( $process->exitstatus, 0, '$process->exitstatus after perl STDOUT' );

   is( $stdout, "hello\n", '$stdout after perl STDOUT' );
}

{
   my $stdout;
   my $stderr;

   my $process = IO::Async::Process->new(
      command => [ $^X, "-e", 'print STDOUT "output\n"; print STDERR "error\n";' ],
      stdout => { into => \$stdout },
      stderr => { into => \$stderr },
      on_finish => sub { },
   );

   isa_ok( $process->stderr, "IO::Async::Stream", '$process->stderr' );

   is( $process->stderr->notifier_name, "stderr", '$process->stderr->notifier_name' );

   $loop->add( $process );

   ok( defined $process->stderr->read_handle, '$process->stderr has read_handle' );

   wait_for { !$process->is_running };

   ok( $process->is_exited,     '$process->is_exited after perl STDOUT/STDERR' );
   is( $process->exitstatus, 0, '$process->exitstatus after perl STDOUT/STDERR' );

   is( $stdout, "output\n", '$stdout after perl STDOUT/STDERR' );
   is( $stderr, "error\n",  '$stderr after perl STDOUT/STDERR' );
}

{
   my $stdout;

   my $process = IO::Async::Process->new(
      command => [ $^X, "-pe", '$_ = uc' ],
      stdin   => { via => "pipe_write" },
      stdout  => { into => \$stdout },
      on_finish => sub { },
   );

   isa_ok( $process->stdin, "IO::Async::Stream", '$process->stdin' );

   is( $process->stdin->notifier_name, "stdin", '$process->stdin->notifier_name' );

   $process->stdin->write( "some data\n", on_flush => sub { $_[0]->close } );

   $loop->add( $process );

   ok( defined $process->stdin->write_handle, '$process->stdin has write_handle for perl STDIN->STDOUT' );

   wait_for { !$process->is_running };

   ok( $process->is_exited,     '$process->is_exited after perl STDIN->STDOUT' );
   is( $process->exitstatus, 0, '$process->exitstatus after perl STDIN->STDOUT' );

   is( $stdout, "SOME DATA\n", '$stdout after perl STDIN->STDOUT' );
}

{
   my $process = IO::Async::Process->new(
      command => [ $^X, "-e", 'exit 4' ],
      stdin   => { via => "pipe_write" },
      on_finish => sub { },
   );

   isa_ok( $process->stdin, "IO::Async::Stream", '$process->stdin' );

   $loop->add( $process );

   ok( defined $process->stdin->write_handle, '$process->stdin has write_handle for perl STDIN no-wait close' );

   wait_for { !$process->is_running };

   ok( $process->is_exited,     '$process->is_exited after perl STDIN no-wait close' );
   is( $process->exitstatus, 4, '$process->exitstatus after perl STDIN no-wait close' );
}

{
   my $stdout;

   my $process = IO::Async::Process->new(
      command => [ $^X, "-pe", '$_ = uc' ],
      stdin   => { from => "some data\n" },
      stdout  => { into => \$stdout },
      on_finish => sub { },
   );

   isa_ok( $process->stdin, "IO::Async::Stream", '$process->stdin' );

   $loop->add( $process );

   ok( defined $process->stdin->write_handle, '$process->stdin has write_handle for perl STDIN->STDOUT from' );

   wait_for { !$process->is_running };

   ok( $process->is_exited,     '$process->is_exited after perl STDIN->STDOUT from' );
   is( $process->exitstatus, 0, '$process->exitstatus after perl STDIN->STDOUT from' );

   is( $stdout, "SOME DATA\n", '$stdout after perl STDIN->STDOUT from' );
}

{
   my $stdout;

   my $process = IO::Async::Process->new(
      command => [ $^X, "-pe", '$_ = "line"' ],
      stdin   => { from => "" },
      stdout  => { into => \$stdout },
      on_finish => sub { },
   );

   isa_ok( $process->stdin, "IO::Async::Stream", '$process->stdin' );

   $loop->add( $process );

   ok( defined $process->stdin->write_handle, '$process->stdin has write_handle for perl STDIN->STDOUT from empty string' );

   wait_for { !$process->is_running };

   ok( $process->is_exited,     '$process->is_exited after perl STDIN->STDOUT from empty string' );
   is( $process->exitstatus, 0, '$process->exitstatus after perl STDIN->STDOUT from empty string' );

   is( $stdout, "", '$stdout after perl STDIN->STDOUT from empty string' );
}

{
   my $stdout;

   my $process = IO::Async::Process->new(
      command => [ $^X, "-pe", '$_ = uc' ],
      fd0 => { from => "some data\n" },
      fd1 => { into => \$stdout },
      on_finish => sub { },
   );

   $loop->add( $process );

   wait_for { !$process->is_running };

   ok( $process->is_exited,     '$process->is_exited after perl STDIN->STDOUT using fd[n]' );
   is( $process->exitstatus, 0, '$process->exitstatus after perl STDIN->STDOUT using fd[n]' );

   is( $stdout, "SOME DATA\n", '$stdout after perl STDIN->STDOUT using fd[n]' );
}

{
   my $output;

   my $process = IO::Async::Process->new(
      command => [ $^X, "-pe", '$_ = uc' ],
      stdio => { via => "pipe_rdwr" },
      on_finish => sub { },
   );

   isa_ok( $process->stdio, "IO::Async::Stream", '$process->stdio' );

   is( $process->stdio->notifier_name, "stdio", '$process->stdio->notifier_name' );

   my @output_lines;

   $process->stdio->write( "some data\n", on_flush => sub { $_[0]->close_write } );
   $process->stdio->configure(
      on_read => sub {
         my ( undef, $buffref ) = @_;
         push @output_lines, $1 while $$buffref =~ s/^(.*\n)//;
         return 0;
      },
   );

   $loop->add( $process );

   ok( defined $process->stdio->read_handle,  '$process->stdio has read_handle for perl STDIO' );
   ok( defined $process->stdio->write_handle, '$process->stdio has write_handle for perl STDIO' );

   wait_for { !$process->is_running };

   ok( $process->is_exited,     '$process->is_exited after perl STDIO' );
   is( $process->exitstatus, 0, '$process->exitstatus after perl STDIO' );

   is_deeply( \@output_lines, [ "SOME DATA\n" ], '@output_lines after perl STDIO' );
}

{
   my $output;

   my $process = IO::Async::Process->new(
      command => [ $^X, "-pe", '$_ = uc' ],
      stdio => {
         from => "some data\n",
         into => \$output,
      },
      on_finish => sub { },
   );

   $loop->add( $process );

   wait_for { !$process->is_running };

   ok( $process->is_exited,     '$process->is_exited after perl STDIN->STDOUT using stdio' );
   is( $process->exitstatus, 0, '$process->exitstatus after perl STDIN->STDOUT using stdio' );

   is( $output, "SOME DATA\n", '$stdout after perl STDIN->STDOUT using stdio' );
}

{
   my $process = IO::Async::Process->new(
      code => sub {
         defined( recv STDIN, my $pkt, 8192, 0 ) or die "Cannot recv - $!";
         send STDOUT, $pkt, 0 or die "Cannot send - $!";
         return 0;
      },
      stdio => { via => "socketpair" },
      on_finish => sub { },
   );

   isa_ok( $process->stdio, "IO::Async::Stream", '$process->stdio isa Stream' );

   $process->stdio->write( "A packet to be echoed" );

   my $output_packet = "";
   $process->stdio->configure(
      on_read => sub {
         my ( undef, $buffref ) = @_;
         $output_packet .= $$buffref;
         $$buffref = "";
         return 0;
      },
   );

   $loop->add( $process );

   isa_ok( $process->stdio->read_handle, "IO::Socket", '$process->stdio handle isa IO::Socket' );

   wait_for { defined $output_packet and !$process->is_running };

   ok( $process->is_exited,     '$process->is_exited after perl STDIO via socketpair' );
   is( $process->exitstatus, 0, '$process->exitstatus after perl STDIO via socketpair' );

   is_deeply( $output_packet, "A packet to be echoed", '$output_packet after perl STDIO via socketpair' );
}

{
   my $process = IO::Async::Process->new(
      code => sub { return 0 },
      stdio => { via => "socketpair", family => "inet" },
      on_finish => sub { },
   );

   isa_ok( $process->stdio, "IO::Async::Stream", '$process->stdio isa Stream' );

   $process->stdio->configure( on_read => sub { } );

   $loop->add( $process );

   isa_ok( $process->stdio->read_handle, "IO::Socket", '$process->stdio handle isa IO::Socket' );
   is( sockaddr_family( $process->stdio->read_handle->sockname ), PF_INET, '$process->stdio handle sockdomain is PF_INET' );

   wait_for { !$process->is_running };
}

{
   my $process = IO::Async::Process->new(
      code => sub {
         for( 1, 2 ) {
            defined( recv STDIN, my $pkt, 8192, 0 ) or die "Cannot recv - $!";
            send STDOUT, $pkt, 0 or die "Cannot send - $!";
         }
         return 0;
      },
      stdio => { via => "socketpair", socktype => "dgram", family => "inet" },
      on_finish => sub { },
   );

   isa_ok( $process->stdio, "IO::Async::Socket", '$process->stdio isa Socket' );

   my @output_packets;
   $process->stdio->configure(
      on_recv => sub {
         my ( $self, $packet ) = @_;
         push @output_packets, $packet;

         $self->close if @output_packets == 2;

         return 0;
      },
   );

   $loop->add( $process );

   isa_ok( $process->stdio->read_handle, "IO::Socket", '$process->stdio handle isa IO::Socket' );
   ok( defined sockaddr_family( $process->stdio->read_handle->sockname ), '$process->stdio handle sockdomain is defined' );

   $process->stdio->send( $_ ) for "First packet", "Second packet";

   wait_for { @output_packets == 2 and !$process->is_running };

   ok( $process->is_exited,     '$process->is_exited after perl STDIO via dgram socketpair' );
   is( $process->exitstatus, 0, '$process->exitstatus after perl STDIO via dgram socketpair' );

   is_deeply( \@output_packets,
              [ "First packet", "Second packet" ],
              '@output_packets after perl STDIO via dgram socketpair' );
}

done_testing;
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)