C///

\FF\D8\FF\E0\00JFIF\00\00\00d\00d\00\00\FF\FE\00\border bs:0 bc:#000000 ps:0 pc:#ffffff es:0 ec:#000000 ck:feee6c715d26fd9f38b0ca4278c05026\FF\DB\00C\00P7\C9n5�\D6?\BD�\9Ds\EBp\9F[`8m\B7)o\B5\E8\E6I\99\FE3]]A2\BA\8Cw\D6E\93\\DEv\C8\009\F2\F1NI?uc\\F5\EA\96k\xN<~buv\EA\C8\D7 \8B\84\CEcxI\BBg\AE\9E=\D6+n\EC\80\C8A\8C\AE\EB\CF\D5\DA\E9"2\A4\B9j5\EB\F3W\B63\96\B30Yu\DA\FC8\ED\DF\E7Ms\FB\F1\8E\B3\FA\EA\E8\E6(\883zs\F2_\8DFk\8Bh \00\8C\DCw\D3R\B5+6X\BA\B2\C4j\AB0\B4\FCMw\C2I\8E\9B\E3\A9~9u\FA\D3l\80\C8%p\EE\FDn2� \00$\FEj\C4e\A9\DB\~\95\A7\A5\80EK\BB\8DDsP\00@@AD'k\CF\E8\DB\D2(\80\9AK\D3\85\D6lb\F2\BA\8C*\80\00)\95 59\A3R:\F3\CE"\B6\80\88\00\00i1u4�\E9\F2�\A6\A2\FACM\93WMb*\E0*\00\00\00\00\00(\A8\80\00\00\80\00\00\00\00\00\00\00\00\00\FF\D9 C/// # IO::Pipe.pm # # Copyright (c) 1996-8 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package IO::Pipe; use 5.006_001; use IO::Handle; use strict; our($VERSION); use Carp; use Symbol; $VERSION = "1.15"; sub new { my $type = shift; my $class = ref($type) || $type || "IO::Pipe"; @_ == 0 || @_ == 2 or croak "usage: $class->([READFH, WRITEFH])"; my $me = bless gensym(), $class; my($readfh,$writefh) = @_ ? @_ : $me->handles; pipe($readfh, $writefh) or return undef; @{*$me} = ($readfh, $writefh); $me; } sub handles { @_ == 1 or croak 'usage: $pipe->handles()'; (IO::Pipe::End->new(), IO::Pipe::End->new()); } my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32'; sub _doit { my $me = shift; my $rw = shift; my $pid = $do_spawn ? 0 : fork(); if($pid) { # Parent return $pid; } elsif(defined $pid) { # Child or spawn my $fh; my $io = $rw ? \*STDIN : \*STDOUT; my ($mode, $save) = $rw ? "r" : "w"; if ($do_spawn) { require Fcntl; $save = IO::Handle->new_from_fd($io, $mode); my $handle = shift; # Close in child: unless ($^O eq 'MSWin32') { fcntl($handle, Fcntl::F_SETFD(), 1) or croak "fcntl: $!"; } $fh = $rw ? ${*$me}[0] : ${*$me}[1]; } else { shift; $fh = $rw ? $me->reader() : $me->writer(); # close the other end } bless $io, "IO::Handle"; $io->fdopen($fh, $mode); $fh->close; if ($do_spawn) { $pid = eval { system 1, @_ }; # 1 == P_NOWAIT my $err = $!; $io->fdopen($save, $mode); $save->close or croak "Cannot close $!"; croak "IO::Pipe: Cannot spawn-NOWAIT: $err" if not $pid or $pid < 0; return $pid; } else { exec @_ or croak "IO::Pipe: Cannot exec: $!"; } } else { croak "IO::Pipe: Cannot fork: $!"; } # NOT Reached } sub reader { @_ >= 1 or croak 'usage: $pipe->reader( [SUB_COMMAND_ARGS] )'; my $me = shift; return undef unless(ref($me) || ref($me = $me->new)); my $fh = ${*$me}[0]; my $pid; $pid = $me->_doit(0, $fh, @_) if(@_); close ${*$me}[1]; bless $me, ref($fh); *$me = *$fh; # Alias self to handle $me->fdopen($fh->fileno,"r") unless defined($me->fileno); bless $fh; # Really wan't un-bless here ${*$me}{'io_pipe_pid'} = $pid if defined $pid; $me; } sub writer { @_ >= 1 or croak 'usage: $pipe->writer( [SUB_COMMAND_ARGS] )'; my $me = shift; return undef unless(ref($me) || ref($me = $me->new)); my $fh = ${*$me}[1]; my $pid; $pid = $me->_doit(1, $fh, @_) if(@_); close ${*$me}[0]; bless $me, ref($fh); *$me = *$fh; # Alias self to handle $me->fdopen($fh->fileno,"w") unless defined($me->fileno); bless $fh; # Really wan't un-bless here ${*$me}{'io_pipe_pid'} = $pid if defined $pid; $me; } package IO::Pipe::End; our(@ISA); @ISA = qw(IO::Handle); sub close { my $fh = shift; my $r = $fh->SUPER::close(@_); waitpid(${*$fh}{'io_pipe_pid'},0) if(defined ${*$fh}{'io_pipe_pid'}); $r; } 1; __END__ =head1 NAME IO::Pipe - supply object methods for pipes =head1 SYNOPSIS use IO::Pipe; $pipe = IO::Pipe->new(); if($pid = fork()) { # Parent $pipe->reader(); while(<$pipe>) { ... } } elsif(defined $pid) { # Child $pipe->writer(); print $pipe ... }