5 IPC::Run::IO -- I/O channels for IPC::Run.
9 B<NOT IMPLEMENTED YET ON Win32! Win32 does not allow select() on
10 normal file descriptors; IPC::RUN::IO needs to use IPC::Run::Win32Helper
13 use IPC::Run qw( io );
15 ## The sense of '>' and '<' is opposite of perl's open(),
16 ## but agrees with IPC::Run.
17 $io = io( "filename", '>', \$recv );
18 $io = io( "filename", 'r', \$recv );
21 $io = io( "filename", '>>', \$recv );
22 $io = io( "filename", 'ra', \$recv );
24 $io = io( "filename", '<', \$send );
25 $io = io( "filename", 'w', \$send );
27 $io = io( "filename", '<<', \$send );
28 $io = io( "filename", 'wa', \$send );
30 ## Handles / IO objects that the caller opens:
31 $io = io( \*HANDLE, '<', \$send );
33 $f = IO::Handle->new( ... ); # Any subclass of IO::Handle
34 $io = io( $f, '<', \$send );
37 $io = IPC::Run::IO->new( ... );
39 ## Then run(), harness(), or start():
42 ## You can, of course, use io() or IPC::Run::IO->new() as an
43 ## argument to run(), harness, or start():
48 This class and module allows filehandles and filenames to be harnessed for
49 I/O when used IPC::Run, independent of anything else IPC::Run is doing
50 (except that errors & exceptions can affect all things that IPC::Run is
55 INCOMPATIBLE CHANGE: due to the awkwardness introduced in ripping pseudohashes
56 out of Perl, this class I<no longer> uses the fields pragma.
60 ## This class is also used internally by IPC::Run in a very intimate way,
61 ## since this is a partial factoring of code from IPC::Run plus some code
62 ## needed to do standalone channels. This factoring process will continue
63 ## at some point. Don't know how far how fast.
71 use IPC::Run qw( Win32_MODE );
73 use vars qw{$VERSION};
77 eval "use IPC::Run::Win32Helper; require IPC::Run::Win32IO; 1"
78 or ( $@ && die ) or die "$!";
83 *_empty = \&IPC::Run::_empty;
91 I think it takes >> or << along with some other data.
93 TODO: Needs more thorough documentation. Patches welcome.
99 $class = ref $class || $class;
101 my ( $external, $type, $internal ) = ( shift, shift, pop );
103 croak "$class: '$_' is not a valid I/O operator"
104 unless $type =~ /^(?:<<?|>>?)$/;
106 my IPC::Run::IO $self = $class->_new_internal(
107 $type, undef, undef, $internal, undef, @_
110 if ( ! ref $external ) {
111 $self->{FILENAME} = $external;
113 elsif ( ref eq 'GLOB' || UNIVERSAL::isa( $external, 'IO::Handle' ) ) {
114 $self->{HANDLE} = $external;
115 $self->{DONT_CLOSE} = 1;
118 croak "$class: cannot accept " . ref( $external ) . " to do I/O with";
125 ## IPC::Run uses this ctor, since it preparses things and needs more
129 $class = ref $class || $class;
131 $class = "IPC::Run::Win32IO"
132 if Win32_MODE && $class eq "IPC::Run::IO";
134 my IPC::Run::IO $self;
135 $self = bless {}, $class;
137 my ( $type, $kfd, $pty_id, $internal, $binmode, @filters ) = @_;
139 # Older perls (<=5.00503, at least) don't do list assign to
140 # psuedo-hashes well.
141 $self->{TYPE} = $type;
143 $self->{PTY_ID} = $pty_id;
144 $self->binmode( $binmode );
145 $self->{FILTERS} = [ @filters ];
147 ## Add an adapter to the end of the filter chain (which is usually just the
148 ## read/writer sub pushed by IPC::Run) to the DEST or SOURCE, if need be.
149 if ( $self->op =~ />/ ) {
150 croak "'$_' missing a destination" if _empty $internal;
151 $self->{DEST} = $internal;
152 if ( UNIVERSAL::isa( $self->{DEST}, 'CODE' ) ) {
153 ## Put a filter on the end of the filter chain to pass the
154 ## output on to the CODE ref. For SCALAR refs, the last
155 ## filter in the chain writes directly to the scalar itself. See
156 ## _init_filters(). For CODE refs, however, we need to adapt from
157 ## the SCALAR to calling the CODE.
163 return IPC::Run::input_avail() && do {
164 $self->{DEST}->( $$in_ref );
173 croak "'$_' missing a source" if _empty $internal;
174 $self->{SOURCE} = $internal;
175 if ( UNIVERSAL::isa( $internal, 'CODE' ) ) {
179 my ( $in_ref, $out_ref ) = @_;
180 return 0 if length $$out_ref;
183 if $self->{SOURCE_EMPTY};
185 my $in = $internal->();
186 unless ( defined $in ) {
187 $self->{SOURCE_EMPTY} = 1;
190 return 0 unless length $in;
197 elsif ( UNIVERSAL::isa( $internal, 'SCALAR' ) ) {
201 my ( $in_ref, $out_ref ) = @_;
202 return 0 if length $$out_ref;
204 ## pump() clears auto_close_ins, finish() sets it.
205 return $self->{HARNESS}->{auto_close_ins} ? undef : 0
206 if IPC::Run::_empty ${$self->{SOURCE}}
207 || $self->{SOURCE_EMPTY};
209 $$out_ref = $$internal;
210 eval { $$internal = '' }
211 if $self->{HARNESS}->{clear_ins};
213 $self->{SOURCE_EMPTY} = $self->{HARNESS}->{auto_close_ins};
226 Gets/sets the filename. Returns the value after the name change, if
232 my IPC::Run::IO $self = shift;
233 $self->{FILENAME} = shift if @_;
234 return $self->{FILENAME};
239 Does initialization required before this can be run. This includes open()ing
240 the file, if necessary, and clearing the destination scalar if necessary.
245 my IPC::Run::IO $self = shift;
247 $self->{SOURCE_EMPTY} = 0;
248 ${$self->{DEST}} = ''
249 if $self->mode =~ /r/ && ref $self->{DEST} eq 'SCALAR';
251 $self->open if defined $self->filename;
252 $self->{FD} = $self->fileno;
254 if ( ! $self->{FILTERS} ) {
255 $self->{FBUFS} = undef;
258 @{$self->{FBUFS}} = map {
261 } ( @{$self->{FILTERS}}, '' );
263 $self->{FBUFS}->[0] = $self->{DEST}
264 if $self->{DEST} && ref $self->{DEST} eq 'SCALAR';
265 push @{$self->{FBUFS}}, $self->{SOURCE};
274 If a filename was passed in, opens it. Determines if the handle is open
275 via fileno(). Throws an exception on error.
282 '<' => O_WRONLY | O_CREAT | O_TRUNC,
283 '<<' => O_WRONLY | O_CREAT | O_APPEND,
287 my IPC::Run::IO $self = shift;
289 croak "IPC::Run::IO: Can't open() a file with no name"
290 unless defined $self->{FILENAME};
291 $self->{HANDLE} = gensym unless $self->{HANDLE};
294 "opening '", $self->filename, "' mode '", $self->mode, "'"
299 $open_flags{$self->op},
301 "IPC::Run::IO: $! opening '$self->{FILENAME}', mode '" . $self->mode . "'";
309 If this is a redirection IO object, this opens the pipe in a platform
316 my ( $child_debug_fd, $parent_handle ) = @_;
319 if ( $self->dir eq "<" ) {
320 ( $self->{TFD}, $self->{FD} ) = IPC::Run::_pipe_nb;
321 if ( $parent_handle ) {
322 CORE::open $parent_handle, ">&=$self->{FD}"
323 or croak "$! duping write end of pipe for caller";
327 ( $self->{FD}, $self->{TFD} ) = IPC::Run::_pipe;
328 if ( $parent_handle ) {
329 CORE::open $parent_handle, "<&=$self->{FD}"
330 or croak "$! duping read end of pipe for caller";
336 my IPC::Run::IO $self = shift;
338 ## Hmmm, Maybe allow named pipes one day. But until then...
339 croak "IPC::Run::IO: Can't pipe() when a file name has been set"
340 if defined $self->{FILENAME};
342 $self->_do_open( @_ );
344 ## return ( child_fd, parent_fd )
345 return $self->dir eq "<"
346 ? ( $self->{TFD}, $self->{FD} )
347 : ( $self->{FD}, $self->{TFD} );
351 sub _cleanup { ## Called from Run.pm's _cleanup
353 undef $self->{FAKE_PIPE};
359 Closes the handle. Throws an exception on failure.
365 my IPC::Run::IO $self = shift;
367 if ( defined $self->{HANDLE} ) {
368 close $self->{HANDLE}
369 or croak( "IPC::Run::IO: $! closing "
370 . ( defined $self->{FILENAME}
371 ? "'$self->{FILENAME}'"
377 IPC::Run::_close( $self->{FD} );
387 Returns the fileno of the handle. Throws an exception on failure.
393 my IPC::Run::IO $self = shift;
395 my $fd = fileno $self->{HANDLE};
396 croak( "IPC::Run::IO: $! "
397 . ( defined $self->{FILENAME}
398 ? "'$self->{FILENAME}'"
401 ) unless defined $fd;
408 Returns the operator in terms of 'r', 'w', and 'a'. There is a state
409 'ra', unlike Perl's open(), which indicates that data read from the
410 handle or file will be appended to the output if the output is a scalar.
411 This is only meaningful if the output is a scalar, it has no effect if
412 the output is a subroutine.
414 The redirection operators can be a little confusing, so here's a reference
417 > r Read from handle in to process
418 < w Write from process out to handle
419 >> ra Read from handle in to process, appending it to existing
420 data if the destination is a scalar.
421 << wa Write from process out to handle, appending to existing
422 data if IPC::Run::IO opened a named file.
427 my IPC::Run::IO $self = shift;
429 croak "IPC::Run::IO: unexpected arguments for mode(): @_" if @_;
431 ## TODO: Optimize this
432 return ( $self->{TYPE} =~ /</ ? 'w' : 'r' ) .
433 ( $self->{TYPE} =~ /<<|>>/ ? 'a' : '' );
439 Returns the operation: '<', '>', '<<', '>>'. See L</mode> if you want
440 to spell these 'r', 'w', etc.
445 my IPC::Run::IO $self = shift;
447 croak "IPC::Run::IO: unexpected arguments for op(): @_" if @_;
449 return $self->{TYPE};
454 Sets/gets whether this pipe is in binmode or not. No effect off of Win32
455 OSs, of course, and on Win32, no effect after the harness is start()ed.
460 my IPC::Run::IO $self = shift;
462 $self->{BINMODE} = shift if @_;
464 return $self->{BINMODE};
470 Returns the first character of $self->op. This is either "<" or ">".
475 my IPC::Run::IO $self = shift;
477 croak "IPC::Run::IO: unexpected arguments for dir(): @_" if @_;
479 return substr $self->{TYPE}, 0, 1;
484 ## Filter Scaffolding
486 #my $filter_op ; ## The op running a filter chain right now
487 #my $filter_num; ## Which filter is being run right now.
490 '$filter_op', ## The op running a filter chain right now
491 '$filter_num' ## Which filter is being run right now.
495 my IPC::Run::IO $self = shift;
497 confess "\$self not an IPC::Run::IO" unless UNIVERSAL::isa( $self, "IPC::Run::IO" );
500 $self->{FBUFS}->[0] = $self->{DEST}
501 if $self->{DEST} && ref $self->{DEST} eq 'SCALAR';
503 return unless $self->{FILTERS} && @{$self->{FILTERS}};
505 push @{$self->{FBUFS}}, map {
508 } ( @{$self->{FILTERS}}, '' );
510 push @{$self->{FBUFS}}, $self->{SOURCE};
515 TODO: Needs confirmation that this is correct. Was previously undocumented.
517 I believe this is polling the IO for new input and then returns undef if there will never be any more input, 0 if there is none now, but there might be in the future, and TRUE if more input was gotten.
522 my IPC::Run::IO $self = shift;
523 my ( $harness ) = @_;
525 if ( defined $self->{FD} ) {
528 if ( vec $harness->{WOUT}, $self->{FD}, 1 ) {
529 _debug_desc_fd( "filtering data to", $self )
530 if _debugging_details;
531 return $self->_do_filters( $harness );
534 elsif ( $d eq ">" ) {
535 if ( vec $harness->{ROUT}, $self->{FD}, 1 ) {
536 _debug_desc_fd( "filtering data from", $self )
537 if _debugging_details;
538 return $self->_do_filters( $harness );
547 my IPC::Run::IO $self = shift;
549 ( $self->{HARNESS} ) = @_;
551 my ( $saved_op, $saved_num ) =($IPC::Run::filter_op,$IPC::Run::filter_num);
552 $IPC::Run::filter_op = $self;
553 $IPC::Run::filter_num = -1;
558 $r = eval { IPC::Run::get_more_input(); };
560 # Detect Resource temporarily unavailable and re-try 200 times (2 seconds), assuming select behaves (which it doesn't always? need ref)
561 if(($@||'') =~ $IPC::Run::_EAGAIN && $redos++ < 200) {
562 select(undef, undef, undef, 0.01);
566 ( $IPC::Run::filter_op, $IPC::Run::filter_num ) = ( $saved_op, $saved_num );
567 $self->{HARNESS} = undef;
568 die "ack ", $@ if $@;
576 Barrie Slaymaker <barries@slaysys.com>
580 Implement bidirectionality.