1# You may distribute under the terms of either the GNU General Public License 2# or the Artistic License (the same terms as Perl itself) 3# 4# (C) Paul Evans, 2011-2018 -- leonerd@leonerd.org.uk 5 6package IO::Async::Process; 7 8use strict; 9use warnings; 10use base qw( IO::Async::Notifier ); 11 12our $VERSION = '0.800'; 13 14use Carp; 15 16use Socket qw( SOCK_STREAM ); 17 18use Future; 19 20use IO::Async::OS; 21 22=head1 NAME 23 24C<IO::Async::Process> - start and manage a child process 25 26=head1 SYNOPSIS 27 28 use IO::Async::Process; 29 30 use IO::Async::Loop; 31 my $loop = IO::Async::Loop->new; 32 33 my $process = IO::Async::Process->new( 34 command => [ "tr", "a-z", "n-za-m" ], 35 stdin => { 36 from => "hello world\n", 37 }, 38 stdout => { 39 on_read => sub { 40 my ( $stream, $buffref ) = @_; 41 while( $$buffref =~ s/^(.*)\n// ) { 42 print "Rot13 of 'hello world' is '$1'\n"; 43 } 44 45 return 0; 46 }, 47 }, 48 49 on_finish => sub { 50 $loop->stop; 51 }, 52 ); 53 54 $loop->add( $process ); 55 56 $loop->run; 57 58Also accessible via the L<IO::Async::Loop/open_process> method: 59 60 $loop->open_process( 61 command => [ "/bin/ping", "-c4", "some.host" ], 62 63 stdout => { 64 on_read => sub { 65 my ( $stream, $buffref, $eof ) = @_; 66 while( $$buffref =~ s/^(.*)\n// ) { 67 print "PING wrote: $1\n"; 68 } 69 return 0; 70 }, 71 }, 72 73 on_finish => sub { 74 my $process = shift; 75 my ( $exitcode ) = @_; 76 my $status = ( $exitcode >> 8 ); 77 ... 78 }, 79 ); 80 81=head1 DESCRIPTION 82 83This subclass of L<IO::Async::Notifier> starts a child process, and invokes a 84callback when it exits. The child process can either execute a given block of 85code (via C<fork(2)>), or a command. 86 87=cut 88 89=head1 EVENTS 90 91The following events are invoked, either using subclass methods or CODE 92references in parameters: 93 94=head2 on_finish $exitcode 95 96Invoked after the process has exited by normal means (i.e. an C<exit(2)> 97syscall from a process, or C<return>ing from the code block), and has closed 98all its file descriptors. 99 100=head2 on_exception $exception, $errno, $exitcode 101 102Invoked when the process exits by an exception from C<code>, or by failing to 103C<exec(2)> the given command. C<$errno> will be a dualvar, containing both 104number and string values. After a successful C<exec()> call, this condition 105can no longer happen. 106 107Note that this has a different name and a different argument order from 108C<< Loop->open_process >>'s C<on_error>. 109 110If this is not provided and the process exits with an exception, then 111C<on_finish> is invoked instead, being passed just the exit code. 112 113Since this is just the results of the underlying C<< $loop->spawn_child >> 114C<on_exit> handler in a different order it is possible that the C<$exception> 115field will be an empty string. It will however always be defined. This can be 116used to distinguish the two cases: 117 118 on_exception => sub { 119 my $self = shift; 120 my ( $exception, $errno, $exitcode ) = @_; 121 122 if( length $exception ) { 123 print STDERR "The process died with the exception $exception " . 124 "(errno was $errno)\n"; 125 } 126 elsif( ( my $status = W_EXITSTATUS($exitcode) ) == 255 ) { 127 print STDERR "The process failed to exec() - $errno\n"; 128 } 129 else { 130 print STDERR "The process exited with exit status $status\n"; 131 } 132 } 133 134=cut 135 136=head1 CONSTRUCTOR 137 138=cut 139 140=head2 new 141 142 $process = IO::Async::Process->new( %args ) 143 144Constructs a new C<IO::Async::Process> object and returns it. 145 146Once constructed, the C<Process> will need to be added to the C<Loop> before 147the child process is started. 148 149=cut 150 151sub _init 152{ 153 my $self = shift; 154 $self->SUPER::_init( @_ ); 155 156 $self->{to_close} = {}; 157 $self->{finish_futures} = []; 158} 159 160=head1 PARAMETERS 161 162The following named parameters may be passed to C<new> or C<configure>: 163 164=head2 on_finish => CODE 165 166=head2 on_exception => CODE 167 168CODE reference for the event handlers. 169 170Once the C<on_finish> continuation has been invoked, the C<IO::Async::Process> 171object is removed from the containing L<IO::Async::Loop> object. 172 173The following parameters may be passed to C<new>, or to C<configure> before 174the process has been started (i.e. before it has been added to the C<Loop>). 175Once the process is running these cannot be changed. 176 177=head2 command => ARRAY or STRING 178 179Either a reference to an array containing the command and its arguments, or a 180plain string containing the command. This value is passed into perl's 181C<exec(2)> function. 182 183=head2 code => CODE 184 185A block of code to execute in the child process. It will be called in scalar 186context inside an C<eval> block. 187 188=head2 setup => ARRAY 189 190Optional reference to an array to pass to the underlying C<Loop> 191C<spawn_child> method. 192 193=head2 fdI<n> => HASH 194 195A hash describing how to set up file descriptor I<n>. The hash may contain the 196following keys: 197 198=over 4 199 200=item via => STRING 201 202Configures how this file descriptor will be configured for the child process. 203Must be given one of the following mode names: 204 205=over 4 206 207=item pipe_read 208 209The child will be given the writing end of a C<pipe(2)>; the parent may read 210from the other. 211 212=item pipe_write 213 214The child will be given the reading end of a C<pipe(2)>; the parent may write 215to the other. Since an EOF condition of this kind of handle cannot reliably be 216detected, C<on_finish> will not wait for this type of pipe to be closed. 217 218=item pipe_rdwr 219 220Only valid on the C<stdio> filehandle. The child will be given the reading end 221of one C<pipe(2)> on STDIN and the writing end of another on STDOUT. A single 222Stream object will be created in the parent configured for both filehandles. 223 224=item socketpair 225 226The child will be given one end of a C<socketpair(2)>; the parent will be 227given the other. The family of this socket may be given by the extra key 228called C<family>; defaulting to C<unix>. The socktype of this socket may be 229given by the extra key called C<socktype>; defaulting to C<stream>. If the 230type is not C<SOCK_STREAM> then a L<IO::Async::Socket> object will be 231constructed for the parent side of the handle, rather than 232L<IO::Async::Stream>. 233 234=back 235 236Once the filehandle is set up, the C<fd> method (or its shortcuts of C<stdin>, 237C<stdout> or C<stderr>) may be used to access the 238L<IO::Async::Handle>-subclassed object wrapped around it. 239 240The value of this argument is implied by any of the following alternatives. 241 242=item on_read => CODE 243 244The child will be given the writing end of a pipe. The reading end will be 245wrapped by an L<IO::Async::Stream> using this C<on_read> callback function. 246 247=item into => SCALAR 248 249The child will be given the writing end of a pipe. The referenced scalar will 250be filled by data read from the child process. This data may not be available 251until the pipe has been closed by the child. 252 253=item from => STRING 254 255The child will be given the reading end of a pipe. The string given by the 256C<from> parameter will be written to the child. When all of the data has been 257written the pipe will be closed. 258 259=item prefork => CODE 260 261Only valid for handles with a C<via> of C<socketpair>. The code block runs 262after the C<socketpair(2)> is created, but before the child is forked. This 263is handy for when you adjust both ends of the created socket (for example, to 264use C<setsockopt(3)>) from the controlling parent, before the child code runs. 265The arguments passed in are the L<IO::Socket> objects for the parent and child 266ends of the socket. 267 268 $prefork->( $localfd, $childfd ) 269 270=back 271 272=head2 stdin => ... 273 274=head2 stdout => ... 275 276=head2 stderr => ... 277 278Shortcuts for C<fd0>, C<fd1> and C<fd2> respectively. 279 280=head2 stdio => ... 281 282Special filehandle to affect STDIN and STDOUT at the same time. This 283filehandle supports being configured for both reading and writing at the same 284time. 285 286=cut 287 288sub configure 289{ 290 my $self = shift; 291 my %params = @_; 292 293 foreach (qw( on_finish on_exception )) { 294 $self->{$_} = delete $params{$_} if exists $params{$_}; 295 } 296 297 # All these parameters can only be configured while the process isn't 298 # running 299 my %setup_params; 300 foreach (qw( code command setup stdin stdout stderr stdio ), grep { m/^fd\d+$/ } keys %params ) { 301 $setup_params{$_} = delete $params{$_} if exists $params{$_}; 302 } 303 304 if( $self->is_running ) { 305 keys %setup_params and croak "Cannot configure a running Process with " . join ", ", keys %setup_params; 306 } 307 308 defined( exists $setup_params{code} ? $setup_params{code} : $self->{code} ) + 309 defined( exists $setup_params{command} ? $setup_params{command} : $self->{command} ) <= 1 or 310 croak "Cannot have both 'code' and 'command'"; 311 312 foreach (qw( code command setup )) { 313 $self->{$_} = delete $setup_params{$_} if exists $setup_params{$_}; 314 } 315 316 $self->configure_fd( 0, %{ delete $setup_params{stdin} } ) if $setup_params{stdin}; 317 $self->configure_fd( 1, %{ delete $setup_params{stdout} } ) if $setup_params{stdout}; 318 $self->configure_fd( 2, %{ delete $setup_params{stderr} } ) if $setup_params{stderr}; 319 320 $self->configure_fd( 'io', %{ delete $setup_params{stdio} } ) if $setup_params{stdio}; 321 322 # All the rest are fd\d+ 323 foreach ( keys %setup_params ) { 324 my ( $fd ) = m/^fd(\d+)$/ or croak "Expected 'fd\\d+'"; 325 $self->configure_fd( $fd, %{ $setup_params{$_} } ); 326 } 327 328 $self->SUPER::configure( %params ); 329} 330 331# These are from the perspective of the parent 332use constant FD_VIA_PIPEREAD => 1; 333use constant FD_VIA_PIPEWRITE => 2; 334use constant FD_VIA_PIPERDWR => 3; # Only valid for stdio pseudo-fd 335use constant FD_VIA_SOCKETPAIR => 4; 336 337my %via_names = ( 338 pipe_read => FD_VIA_PIPEREAD, 339 pipe_write => FD_VIA_PIPEWRITE, 340 pipe_rdwr => FD_VIA_PIPERDWR, 341 socketpair => FD_VIA_SOCKETPAIR, 342); 343 344sub configure_fd 345{ 346 my $self = shift; 347 my ( $fd, %args ) = @_; 348 349 $self->is_running and croak "Cannot configure fd $fd in a running Process"; 350 351 if( $fd eq "io" ) { 352 exists $self->{fd_opts}{$_} and croak "Cannot configure stdio since fd$_ is already defined" for 0 .. 1; 353 } 354 elsif( $fd == 0 or $fd == 1 ) { 355 exists $self->{fd_opts}{io} and croak "Cannot configure fd$fd since stdio is already defined"; 356 } 357 358 my $opts = $self->{fd_opts}{$fd} ||= {}; 359 my $via = $opts->{via}; 360 361 my ( $wants_read, $wants_write ); 362 363 if( my $via_name = delete $args{via} ) { 364 defined $via and 365 croak "Cannot change the 'via' mode of fd$fd now that it is already configured"; 366 367 $via = $via_names{$via_name} or 368 croak "Unrecognised 'via' name of '$via_name'"; 369 } 370 371 if( my $on_read = delete $args{on_read} ) { 372 $opts->{handle}{on_read} = $on_read; 373 374 $wants_read++; 375 } 376 elsif( my $into = delete $args{into} ) { 377 $opts->{handle}{on_read} = sub { 378 my ( undef, $buffref, $eof ) = @_; 379 $$into .= $$buffref if $eof; 380 return 0; 381 }; 382 383 $wants_read++; 384 } 385 386 if( defined( my $from = delete $args{from} ) ) { 387 $opts->{from} = $from; 388 389 $wants_write++; 390 } 391 392 if( defined $via and $via == FD_VIA_SOCKETPAIR ) { 393 $self->{fd_opts}{$fd}{$_} = delete $args{$_} for qw( family socktype prefork ); 394 } 395 396 keys %args and croak "Unexpected extra keys for fd $fd - " . join ", ", keys %args; 397 398 if( !defined $via ) { 399 $via = FD_VIA_PIPEREAD if $wants_read and !$wants_write; 400 $via = FD_VIA_PIPEWRITE if !$wants_read and $wants_write; 401 $via = FD_VIA_PIPERDWR if $wants_read and $wants_write; 402 } 403 elsif( $via == FD_VIA_PIPEREAD ) { 404 $wants_write and $via = FD_VIA_PIPERDWR; 405 } 406 elsif( $via == FD_VIA_PIPEWRITE ) { 407 $wants_read and $via = FD_VIA_PIPERDWR; 408 } 409 elsif( $via == FD_VIA_PIPERDWR or $via == FD_VIA_SOCKETPAIR ) { 410 # Fine 411 } 412 else { 413 die "Need to check fd_via{$fd}\n"; 414 } 415 416 $via == FD_VIA_PIPERDWR and $fd ne "io" and 417 croak "Cannot both read and write simultaneously on fd$fd"; 418 419 defined $via and $opts->{via} = $via; 420} 421 422sub _prepare_fds 423{ 424 my $self = shift; 425 my ( $loop ) = @_; 426 427 my $fd_handle = $self->{fd_handle}; 428 my $fd_opts = $self->{fd_opts}; 429 430 my $finish_futures = $self->{finish_futures}; 431 432 my @setup; 433 434 foreach my $fd ( keys %$fd_opts ) { 435 my $opts = $fd_opts->{$fd}; 436 my $via = $opts->{via}; 437 438 my $handle = $self->fd( $fd ); 439 440 my $key = $fd eq "io" ? "stdio" : "fd$fd"; 441 my $write_only; 442 443 if( $via == FD_VIA_PIPEREAD ) { 444 my ( $myfd, $childfd ) = IO::Async::OS->pipepair or croak "Unable to pipe() - $!"; 445 $myfd->blocking( 0 ); 446 447 $handle->configure( read_handle => $myfd ); 448 449 push @setup, $key => [ dup => $childfd ]; 450 $self->{to_close}{$childfd->fileno} = $childfd; 451 } 452 elsif( $via == FD_VIA_PIPEWRITE ) { 453 my ( $childfd, $myfd ) = IO::Async::OS->pipepair or croak "Unable to pipe() - $!"; 454 $myfd->blocking( 0 ); 455 $write_only++; 456 457 $handle->configure( write_handle => $myfd ); 458 459 push @setup, $key => [ dup => $childfd ]; 460 $self->{to_close}{$childfd->fileno} = $childfd; 461 } 462 elsif( $via == FD_VIA_PIPERDWR ) { 463 $key eq "stdio" or croak "Oops - should only be FD_VIA_PIPERDWR on stdio"; 464 # Can't use pipequad here for now because we need separate FDs so we 465 # can ->close them properly 466 my ( $myread, $childwrite ) = IO::Async::OS->pipepair or croak "Unable to pipe() - $!"; 467 my ( $childread, $mywrite ) = IO::Async::OS->pipepair or croak "Unable to pipe() - $!"; 468 $_->blocking( 0 ) for $myread, $mywrite; 469 470 $handle->configure( read_handle => $myread, write_handle => $mywrite ); 471 472 push @setup, stdin => [ dup => $childread ], stdout => [ dup => $childwrite ]; 473 $self->{to_close}{$childread->fileno} = $childread; 474 $self->{to_close}{$childwrite->fileno} = $childwrite; 475 } 476 elsif( $via == FD_VIA_SOCKETPAIR ) { 477 my ( $myfd, $childfd ) = IO::Async::OS->socketpair( $opts->{family}, $opts->{socktype} ) or croak "Unable to socketpair() - $!"; 478 $myfd->blocking( 0 ); 479 480 $opts->{prefork}->( $myfd, $childfd ) if $opts->{prefork}; 481 482 $handle->configure( handle => $myfd ); 483 484 if( $key eq "stdio" ) { 485 push @setup, stdin => [ dup => $childfd ], stdout => [ dup => $childfd ]; 486 } 487 else { 488 push @setup, $key => [ dup => $childfd ]; 489 } 490 $self->{to_close}{$childfd->fileno} = $childfd; 491 } 492 else { 493 croak "Unsure what to do with fd_via==$via"; 494 } 495 496 $self->add_child( $handle ); 497 498 unless( $write_only ) { 499 push @$finish_futures, $handle->new_close_future; 500 } 501 } 502 503 return @setup; 504} 505 506sub _add_to_loop 507{ 508 my $self = shift; 509 my ( $loop ) = @_; 510 511 $self->{code} or $self->{command} or 512 croak "Require either 'code' or 'command' in $self"; 513 514 $self->can_event( "on_finish" ) or 515 croak "Expected either an on_finish callback or to be able to ->on_finish"; 516 517 my @setup; 518 push @setup, @{ $self->{setup} } if $self->{setup}; 519 520 push @setup, $self->_prepare_fds( $loop ); 521 522 my $finish_futures = delete $self->{finish_futures}; 523 524 my ( $exitcode, $dollarbang, $dollarat ); 525 push @$finish_futures, my $exit_future = $loop->new_future; 526 527 $self->{pid} = $loop->spawn_child( 528 code => $self->{code}, 529 command => $self->{command}, 530 531 setup => \@setup, 532 533 on_exit => $self->_capture_weakself( sub { 534 ( my $self, undef, $exitcode, $dollarbang, $dollarat ) = @_; 535 536 $self->debug_printf( "EXIT status=0x%04x", $exitcode ) if $self; 537 $exit_future->done unless $exit_future->is_cancelled; 538 } ), 539 ); 540 $self->{running} = 1; 541 542 $self->SUPER::_add_to_loop( @_ ); 543 544 $_->close for values %{ delete $self->{to_close} }; 545 546 my $is_code = defined $self->{code}; 547 548 my $f = $self->finish_future; 549 550 $self->{_finish_future} = Future->needs_all( @$finish_futures ) 551 ->on_done( $self->_capture_weakself( sub { 552 my $self = shift or return; 553 554 $self->debug_printf( "FINISH status=0x%04x%s", $exitcode, 555 join " ", '', ( $dollarbang ? '$!' : '' ), ( $dollarat ? '$@' : '' ) 556 ); 557 558 $self->{exitcode} = $exitcode; 559 $self->{dollarbang} = $dollarbang; 560 $self->{dollarat} = $dollarat; 561 562 undef $self->{running}; 563 564 if( $is_code ? $dollarat eq "" : $dollarbang == 0 ) { 565 $self->invoke_event( on_finish => $exitcode ); 566 } 567 else { 568 $self->maybe_invoke_event( on_exception => $dollarat, $dollarbang, $exitcode ) or 569 # Don't have a way to report dollarbang/dollarat 570 $self->invoke_event( on_finish => $exitcode ); 571 } 572 573 $f->done( $exitcode ); 574 575 $self->remove_from_parent; 576 } ), 577 ); 578} 579 580sub DESTROY 581{ 582 my $self = shift; 583 $self->{_finish_future}->cancel if $self->{_finish_future}; 584} 585 586sub notifier_name 587{ 588 my $self = shift; 589 if( length( my $name = $self->SUPER::notifier_name ) ) { 590 return $name; 591 } 592 593 return "nopid" unless my $pid = $self->pid; 594 return "[$pid]" unless $self->is_running; 595 return "$pid"; 596} 597 598=head1 METHODS 599 600=cut 601 602=head2 finish_future 603 604 $f = $process->finish_future 605 606I<Since version 0.75.> 607 608Returns a L<Future> that completes when the process finishes. It will yield 609the exit code from the process. 610 611=cut 612 613sub finish_future 614{ 615 my $self = shift; 616 return $self->{finish_future} //= $self->loop->new_future; 617} 618 619=head2 pid 620 621 $pid = $process->pid 622 623Returns the process ID of the process, if it has been started, or C<undef> if 624not. Its value is preserved after the process exits, so it may be inspected 625during the C<on_finish> or C<on_exception> events. 626 627=cut 628 629sub pid 630{ 631 my $self = shift; 632 return $self->{pid}; 633} 634 635=head2 kill 636 637 $process->kill( $signal ) 638 639Sends a signal to the process 640 641=cut 642 643sub kill 644{ 645 my $self = shift; 646 my ( $signal ) = @_; 647 648 kill $signal, $self->pid or croak "Cannot kill() - $!"; 649} 650 651=head2 is_running 652 653 $running = $process->is_running 654 655Returns true if the Process has been started, and has not yet finished. 656 657=cut 658 659sub is_running 660{ 661 my $self = shift; 662 return $self->{running}; 663} 664 665=head2 is_exited 666 667 $exited = $process->is_exited 668 669Returns true if the Process has finished running, and finished due to normal 670C<exit(2)>. 671 672=cut 673 674sub is_exited 675{ 676 my $self = shift; 677 return defined $self->{exitcode} ? ( $self->{exitcode} & 0x7f ) == 0 : undef; 678} 679 680=head2 exitstatus 681 682 $status = $process->exitstatus 683 684If the process exited due to normal C<exit(2)>, returns the value that was 685passed to C<exit(2)>. Otherwise, returns C<undef>. 686 687=cut 688 689sub exitstatus 690{ 691 my $self = shift; 692 return defined $self->{exitcode} ? ( $self->{exitcode} >> 8 ) : undef; 693} 694 695=head2 exception 696 697 $exception = $process->exception 698 699If the process exited due to an exception, returns the exception that was 700thrown. Otherwise, returns C<undef>. 701 702=cut 703 704sub exception 705{ 706 my $self = shift; 707 return $self->{dollarat}; 708} 709 710=head2 errno 711 712 $errno = $process->errno 713 714If the process exited due to an exception, returns the numerical value of 715C<$!> at the time the exception was thrown. Otherwise, returns C<undef>. 716 717=cut 718 719sub errno 720{ 721 my $self = shift; 722 return $self->{dollarbang}+0; 723} 724 725=head2 errstr 726 727 $errstr = $process->errstr 728 729If the process exited due to an exception, returns the string value of 730C<$!> at the time the exception was thrown. Otherwise, returns C<undef>. 731 732=cut 733 734sub errstr 735{ 736 my $self = shift; 737 return $self->{dollarbang}.""; 738} 739 740=head2 fd 741 742 $stream = $process->fd( $fd ) 743 744Returns the L<IO::Async::Stream> or L<IO::Async::Socket> associated with the 745given FD number. This must have been set up by a C<configure> argument prior 746to adding the C<Process> object to the C<Loop>. 747 748The returned object have its read or write handle set to the other end of a 749pipe or socket connected to that FD number in the child process. Typically, 750this will be used to call the C<write> method on, to write more data into the 751child, or to set an C<on_read> handler to read data out of the child. 752 753The C<on_closed> event for these streams must not be changed, or it will break 754the close detection used by the C<Process> object and the C<on_finish> event 755will not be invoked. 756 757=cut 758 759sub fd 760{ 761 my $self = shift; 762 my ( $fd ) = @_; 763 764 return $self->{fd_handle}{$fd} ||= do { 765 my $opts = $self->{fd_opts}{$fd} or 766 croak "$self does not have an fd Stream for $fd"; 767 768 my $handle_class; 769 if( defined $opts->{socktype} && IO::Async::OS->getsocktypebyname( $opts->{socktype} ) != SOCK_STREAM ) { 770 require IO::Async::Socket; 771 $handle_class = "IO::Async::Socket"; 772 } 773 else { 774 require IO::Async::Stream; 775 $handle_class = "IO::Async::Stream"; 776 } 777 778 my $handle = $handle_class->new( 779 notifier_name => $fd eq "0" ? "stdin" : 780 $fd eq "1" ? "stdout" : 781 $fd eq "2" ? "stderr" : 782 $fd eq "io" ? "stdio" : "fd$fd", 783 %{ $opts->{handle} }, 784 ); 785 786 if( defined $opts->{from} ) { 787 $handle->write( $opts->{from}, 788 on_flush => sub { 789 my ( $handle ) = @_; 790 $handle->close_write; 791 }, 792 ); 793 } 794 795 $handle 796 }; 797} 798 799=head2 stdin 800 801=head2 stdout 802 803=head2 stderr 804 805=head2 stdio 806 807 $stream = $process->stdin 808 809 $stream = $process->stdout 810 811 $stream = $process->stderr 812 813 $stream = $process->stdio 814 815Shortcuts for calling C<fd> with 0, 1, 2 or C<io> respectively, to obtain the 816L<IO::Async::Stream> representing the standard input, output, error, or 817combined input/output streams of the child process. 818 819=cut 820 821sub stdin { shift->fd( 0 ) } 822sub stdout { shift->fd( 1 ) } 823sub stderr { shift->fd( 2 ) } 824sub stdio { shift->fd( 'io' ) } 825 826=head1 EXAMPLES 827 828=head2 Capturing the STDOUT stream of a process 829 830By configuring the C<stdout> filehandle of the process using the C<into> key, 831data written by the process can be captured. 832 833 my $stdout; 834 my $process = IO::Async::Process->new( 835 command => [ "writing-program", "arguments" ], 836 stdout => { into => \$stdout }, 837 on_finish => sub { 838 my $process = shift; 839 my ( $exitcode ) = @_; 840 print "Process has exited with code $exitcode, and wrote:\n"; 841 print $stdout; 842 } 843 ); 844 845 $loop->add( $process ); 846 847Note that until C<on_finish> is invoked, no guarantees are made about how much 848of the data actually written by the process is yet in the C<$stdout> scalar. 849 850See also the C<run_child> method of L<IO::Async::Loop>. 851 852To handle data more interactively as it arrives, the C<on_read> key can 853instead be used, to provide a callback function to invoke whenever more data 854is available from the process. 855 856 my $process = IO::Async::Process->new( 857 command => [ "writing-program", "arguments" ], 858 stdout => { 859 on_read => sub { 860 my ( $stream, $buffref ) = @_; 861 while( $$buffref =~ s/^(.*)\n// ) { 862 print "The process wrote a line: $1\n"; 863 } 864 865 return 0; 866 }, 867 }, 868 on_finish => sub { 869 print "The process has finished\n"; 870 } 871 ); 872 873 $loop->add( $process ); 874 875If the code to handle data read from the process isn't available yet when 876the object is constructed, it can be supplied later by using the C<configure> 877method on the C<stdout> filestream at some point before it gets added to the 878Loop. In this case, C<stdin> should be configured using C<pipe_read> in the 879C<via> key. 880 881 my $process = IO::Async::Process->new( 882 command => [ "writing-program", "arguments" ], 883 stdout => { via => "pipe_read" }, 884 on_finish => sub { 885 print "The process has finished\n"; 886 } 887 ); 888 889 $process->stdout->configure( 890 on_read => sub { 891 my ( $stream, $buffref ) = @_; 892 while( $$buffref =~ s/^(.*)\n// ) { 893 print "The process wrote a line: $1\n"; 894 } 895 896 return 0; 897 }, 898 ); 899 900 $loop->add( $process ); 901 902=head2 Sending data to STDIN of a process 903 904By configuring the C<stdin> filehandle of the process using the C<from> key, 905data can be written into the C<STDIN> stream of the process. 906 907 my $process = IO::Async::Process->new( 908 command => [ "reading-program", "arguments" ], 909 stdin => { from => "Here is the data to send\n" }, 910 on_finish => sub { 911 print "The process has finished\n"; 912 } 913 ); 914 915 $loop->add( $process ); 916 917The data in this scalar will be written until it is all consumed, then the 918handle will be closed. This may be useful if the program waits for EOF on 919C<STDIN> before it exits. 920 921To have the ability to write more data into the process once it has started. 922the C<write> method on the C<stdin> stream can be used, when it is configured 923using the C<pipe_write> value for C<via>: 924 925 my $process = IO::Async::Process->new( 926 command => [ "reading-program", "arguments" ], 927 stdin => { via => "pipe_write" }, 928 on_finish => sub { 929 print "The process has finished\n"; 930 } 931 ); 932 933 $loop->add( $process ); 934 935 $process->stdin->write( "Here is some more data\n" ); 936 937=head2 Setting socket options 938 939By using the C<prefork> code block you can change the socket receive buffer 940size at both ends of the socket before the child is forked (at which point it 941would be too late for the parent to be able to change the child end of the 942socket). 943 944 use Socket qw( SOL_SOCKET SO_RCVBUF ); 945 946 my $process = IO::Async::Process->new( 947 command => [ "command-to-read-from-and-write-to", "arguments" ], 948 stdio => { 949 via => "socketpair", 950 prefork => sub { 951 my ( $parentfd, $childfd ) = @_; 952 953 # Set parent end of socket receive buffer to 3 MB 954 $parentfd->setsockopt(SOL_SOCKET, SO_RCVBUF, 3 * 1024 * 1024); 955 # Set child end of socket receive buffer to 3 MB 956 $childfd ->setsockopt(SOL_SOCKET, SO_RCVBUF, 3 * 1024 * 1024); 957 }, 958 }, 959 ); 960 961 $loop->add( $process ); 962 963=cut 964 965=head1 AUTHOR 966 967Paul Evans <leonerd@leonerd.org.uk> 968 969=cut 970 9710x55AA; 972