Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Removed IO::Pipe and non-blocking read for compatibility

  • Loading branch information...
commit 107994b27ebf6ea5a9643b1aa856e2aa0a37264b 1 parent c76c0ed
Chad Granum authored July 21, 2010
1  Build.PL
@@ -9,7 +9,6 @@ my $build = Module::Build->new(
9 9
     dist_author => 'Chad Granum <exodist7@gmail.com>',
10 10
     create_readme => 1,
11 11
     requires => {
12  
-        'IO::Pipe' => 0,
13 12
         'POSIX'    => 0,
14 13
     },
15 14
     build_requires => {
51  lib/Child.pm
@@ -141,11 +141,11 @@ sub kill {
141 141
 
142 142
 sub _gen_ipc {
143 143
     my $class = shift;
144  
-    # Only load if used;
145  
-    require IO::Pipe;
  144
+    pipe( my ( $ain, $aout ));
  145
+    pipe( my ( $bin, $bout ));
146 146
     return [
147  
-        IO::Pipe->new,
148  
-        IO::Pipe->new,
  147
+        [ $ain, $aout ],
  148
+        [ $bin, $bout ],
149 149
     ];
150 150
 }
151 151
 
@@ -158,10 +158,9 @@ sub _init_ipc {
158 158
             $self->_ipc->[0],
159 159
         ]);
160 160
     }
161  
-    $self->_read_handle->reader;
162  
-    $self->_read_handle->autoflush(1);
163  
-    $self->_write_handle->writer;
164  
-    $self->_write_handle->autoflush(1);
  161
+    $self->_ipc->[0] = $self->_ipc->[0]->[0];
  162
+    $self->_ipc->[1] = $self->_ipc->[1]->[1];
  163
+    $self->autoflush(1);
165 164
 }
166 165
 
167 166
 sub _read_handle  {
@@ -185,11 +184,32 @@ sub _no_pipe {
185 184
     );
186 185
 }
187 186
 
  187
+sub autoflush {
  188
+    my $self = shift;
  189
+    my ( $value ) = @_;
  190
+    my $write = $self->_write_handle;
  191
+
  192
+    my $selected = select( $write );
  193
+    $| = ($value || undef) if @_;
  194
+    my $out = $|;
  195
+
  196
+    select( $selected );
  197
+
  198
+    return $out;
  199
+}
  200
+
  201
+sub flush {
  202
+    my $self = shift;
  203
+    my $orig = $self->autoflush();
  204
+    $self->autoflush(1);
  205
+    my $write = $self->_write_handle;
  206
+    print $write "";
  207
+    $self->autoflush($orig);
  208
+}
  209
+
188 210
 sub read {
189 211
     my $self = shift;
190  
-    my ( $block ) = @_;
191 212
     my $handle = $self->_read_handle;
192  
-    $handle->blocking( $block ? 1 : 0 );
193 213
     return <$handle>;
194 214
 }
195 215
 
@@ -244,9 +264,7 @@ waiting, killing, checking, and even communicating with a child process.
244 264
     }, pipe => 1 );
245 265
 
246 266
     # Read (blocking)
247  
-    my $message1 = $child2->read(1);
248  
-
249  
-    # Read (non-blocking)
  267
+    my $message1 = $child2->read();
250 268
     my $message2 = $child2->read();
251 269
 
252 270
     $child2->say("reply");
@@ -285,7 +303,7 @@ How child() behaves regarding IPC is lexical to each importing class.
285 303
         $self->say("message1");
286 304
     };
287 305
 
288  
-    my $message1 = $child->read(1);
  306
+    my $message1 = $child->read();
289 307
 
290 308
 =head1 CLASS METHODS
291 309
 
@@ -338,10 +356,9 @@ Wait on the child (blocking)
338 356
 
339 357
 Send the $SIG signal to the child process.
340 358
 
341  
-=item $child->read($BLOCK)
  359
+=item $child->read()
342 360
 
343  
-Read a message from the child. Takes a single boolean argument; when true the
344  
-method blocks.
  361
+Read a message from the child.
345 362
 
346 363
 =item $child->write( @MESSAGES )
347 364
 
8  t/Child.t
@@ -25,13 +25,13 @@ $one = $CLASS->new( sub {
25 25
     my $self = shift;
26 26
     $self->say( "Have self" );
27 27
     $self->say( "parent: " . $self->parent );
28  
-    my $in = $self->read(1);
  28
+    my $in = $self->read();
29 29
     $self->say( $in );
30 30
 }, pipe => 1 );
31 31
 
32 32
 $one->start;
33  
-is( $one->read(1), "Have self\n", "child has self" );
34  
-is( $one->read(1), "parent: $$\n", "child has parent PID" );
  33
+is( $one->read(), "Have self\n", "child has self" );
  34
+is( $one->read(), "parent: $$\n", "child has parent PID" );
35 35
 {
36 36
     local $SIG{ALRM} = sub { die "non-blocking timeout" };
37 37
     alarm 5;
@@ -39,7 +39,7 @@ is( $one->read(1), "parent: $$\n", "child has parent PID" );
39 39
     alarm 0;
40 40
 }
41 41
 $one->say("XXX");
42  
-is( $one->read(1), "XXX\n", "Full IPC" );
  42
+is( $one->read(), "XXX\n", "Full IPC" );
43 43
 ok( $one->wait, "wait" );
44 44
 ok( $one->is_complete, "Complete" );
45 45
 is( $one->exit_status, 0, "Exit clean" );

0 notes on commit 107994b

Please sign in to comment.
Something went wrong with that request. Please try again.