home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / IO / Pipe.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  4.9 KB  |  233 lines

  1.  
  2. package IO::Pipe;
  3.  
  4. require 5.000;
  5.  
  6. use IO::Handle;
  7. use strict;
  8. use vars qw($VERSION);
  9. use Carp;
  10. use Symbol;
  11.  
  12. $VERSION = "1.0901";
  13.  
  14. sub new {
  15.     my $type = shift;
  16.     my $class = ref($type) || $type || "IO::Pipe";
  17.     @_ == 0 || @_ == 2 or croak "usage: new $class [READFH, WRITEFH]";
  18.  
  19.     my $me = bless gensym(), $class;
  20.  
  21.     my($readfh,$writefh) = @_ ? @_ : $me->handles;
  22.  
  23.     pipe($readfh, $writefh)
  24.     or return undef;
  25.  
  26.     @{*$me} = ($readfh, $writefh);
  27.  
  28.     $me;
  29. }
  30.  
  31. sub handles {
  32.     @_ == 1 or croak 'usage: $pipe->handles()';
  33.     (IO::Pipe::End->new(), IO::Pipe::End->new());
  34. }
  35.  
  36. my $do_spawn = $^O eq 'os2';
  37.  
  38. sub _doit {
  39.     my $me = shift;
  40.     my $rw = shift;
  41.  
  42.     my $pid = $do_spawn ? 0 : fork();
  43.  
  44.     if($pid) { # Parent
  45.         return $pid;
  46.     }
  47.     elsif(defined $pid) { # Child or spawn
  48.         my $fh;
  49.         my $io = $rw ? \*STDIN : \*STDOUT;
  50.         my ($mode, $save) = $rw ? "r" : "w";
  51.         if ($do_spawn) {
  52.           require Fcntl;
  53.           $save = IO::Handle->new_from_fd($io, $mode);
  54.           fcntl(shift, Fcntl::F_SETFD(), 1) or croak "fcntl: $!";
  55.           $fh = $rw ? ${*$me}[0] : ${*$me}[1];
  56.         } else {
  57.           shift;
  58.           $fh = $rw ? $me->reader() : $me->writer(); # close the other end
  59.         }
  60.         bless $io, "IO::Handle";
  61.         $io->fdopen($fh, $mode);
  62.         $fh->close;
  63.  
  64.         if ($do_spawn) {
  65.           $pid = eval { system 1, @_ }; # 1 == P_NOWAIT
  66.           my $err = $!;
  67.     
  68.           $io->fdopen($save, $mode);
  69.           $save->close or croak "Cannot close $!";
  70.           croak "IO::Pipe: Cannot spawn-NOWAIT: $err" if not $pid or $pid < 0;
  71.           return $pid;
  72.         } else {
  73.           exec @_ or
  74.             croak "IO::Pipe: Cannot exec: $!";
  75.         }
  76.     }
  77.     else {
  78.         croak "IO::Pipe: Cannot fork: $!";
  79.     }
  80.  
  81. }
  82.  
  83. sub reader {
  84.     @_ >= 1 or croak 'usage: $pipe->reader()';
  85.     my $me = shift;
  86.     my $fh  = ${*$me}[0];
  87.     my $pid = $me->_doit(0, $fh, @_)
  88.         if(@_);
  89.  
  90.     close ${*$me}[1];
  91.     bless $me, ref($fh);
  92.     *{*$me} = *{*$fh};          # Alias self to handle
  93.     bless $fh;                  # Really wan't un-bless here
  94.     ${*$me}{'io_pipe_pid'} = $pid
  95.         if defined $pid;
  96.  
  97.     $me;
  98. }
  99.  
  100. sub writer {
  101.     @_ >= 1 or croak 'usage: $pipe->writer()';
  102.     my $me = shift;
  103.     my $fh  = ${*$me}[1];
  104.     my $pid = $me->_doit(1, $fh, @_)
  105.         if(@_);
  106.  
  107.     close ${*$me}[0];
  108.     bless $me, ref($fh);
  109.     *{*$me} = *{*$fh};          # Alias self to handle
  110.     bless $fh;                  # Really wan't un-bless here
  111.     ${*$me}{'io_pipe_pid'} = $pid
  112.         if defined $pid;
  113.  
  114.     $me;
  115. }
  116.  
  117. package IO::Pipe::End;
  118.  
  119. use vars qw(@ISA);
  120.  
  121. @ISA = qw(IO::Handle);
  122.  
  123. sub close {
  124.     my $fh = shift;
  125.     my $r = $fh->SUPER::close(@_);
  126.  
  127.     waitpid(${*$fh}{'io_pipe_pid'},0)
  128.     if(defined ${*$fh}{'io_pipe_pid'});
  129.  
  130.     $r;
  131. }
  132.  
  133. 1;
  134.  
  135. __END__
  136.  
  137. =head1 NAME
  138.  
  139. IO::pipe - supply object methods for pipes
  140.  
  141. =head1 SYNOPSIS
  142.  
  143.     use IO::Pipe;
  144.  
  145.     $pipe = new IO::Pipe;
  146.  
  147.     if($pid = fork()) { # Parent
  148.         $pipe->reader();
  149.  
  150.         while(<$pipe> {
  151.         ....
  152.         }
  153.  
  154.     }
  155.     elsif(defined $pid) { # Child
  156.         $pipe->writer();
  157.  
  158.         print $pipe ....
  159.     }
  160.  
  161.     or
  162.  
  163.     $pipe = new IO::Pipe;
  164.  
  165.     $pipe->reader(qw(ls -l));
  166.  
  167.     while(<$pipe>) {
  168.         ....
  169.     }
  170.  
  171. =head1 DESCRIPTION
  172.  
  173. C<IO::Pipe> provides an interface to createing pipes between
  174. processes.
  175.  
  176. =head1 CONSTRCUTOR
  177.  
  178. =over 4
  179.  
  180. =item new ( [READER, WRITER] )
  181.  
  182. Creates a C<IO::Pipe>, which is a reference to a newly created symbol
  183. (see the C<Symbol> package). C<IO::Pipe::new> optionally takes two
  184. arguments, which should be objects blessed into C<IO::Handle>, or a
  185. subclass thereof. These two objects will be used for the system call
  186. to C<pipe>. If no arguments are given then method C<handles> is called
  187. on the new C<IO::Pipe> object.
  188.  
  189. These two handles are held in the array part of the GLOB until either
  190. C<reader> or C<writer> is called.
  191.  
  192. =back
  193.  
  194. =head1 METHODS
  195.  
  196. =over 4
  197.  
  198. =item reader ([ARGS])
  199.  
  200. The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a
  201. handle at the reading end of the pipe. If C<ARGS> are given then C<fork>
  202. is called and C<ARGS> are passed to exec.
  203.  
  204. =item writer ([ARGS])
  205.  
  206. The object is re-blessed into a sub-class of C<IO::Handle>, and becomes a
  207. handle at the writing end of the pipe. If C<ARGS> are given then C<fork>
  208. is called and C<ARGS> are passed to exec.
  209.  
  210. =item handles ()
  211.  
  212. This method is called during construction by C<IO::Pipe::new>
  213. on the newly created C<IO::Pipe> object. It returns an array of two objects
  214. blessed into C<IO::Pipe::End>, or a subclass thereof.
  215.  
  216. =back
  217.  
  218. =head1 SEE ALSO
  219.  
  220. L<IO::Handle>
  221.  
  222. =head1 AUTHOR
  223.  
  224. Graham Barr <bodg@tiuk.ti.com>
  225.  
  226. =head1 COPYRIGHT
  227.  
  228. Copyright (c) 1996 Graham Barr. All rights reserved. This program is free
  229. software; you can redistribute it and/or modify it under the same terms
  230. as Perl itself.
  231.  
  232. =cut
  233.