tools/cmake/scripts/IPC/Run/Win32Pump.pm

   1 package IPC::Run::Win32Pump;
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 IPC::Run::Win32Pump - helper processes to shovel data to/from parent, child
   8
   9 =head1 SYNOPSIS
  10
  11 Internal use only; see IPC::Run::Win32IO and best of luck to you.
  12
  13 =head1 DESCRIPTION
  14
  15 See L<IPC::Run::Win32Helper|IPC::Run::Win32Helper> for details.  This
  16 module is used in subprocesses that are spawned to shovel data to/from
  17 parent processes from/to their child processes.  Where possible, pumps
  18 are optimized away.
  19
  20 NOTE: This is not a real module: it's a script in module form, designed
  21 to be run like
  22
  23    $^X -MIPC::Run::Win32Pumper -e 1 ...
  24
  25 It parses a bunch of command line parameters from IPC::Run::Win32IO.
  26
  27 =cut
  28
  29 use strict;
  30 use vars qw{$VERSION};
  31 BEGIN {
  32         $VERSION = '0.90';
  33 }
  34
  35 use Win32API::File qw(
  36    OsFHandleOpen
  37 );
  38
  39
  40 my ( $stdin_fh, $stdout_fh, $debug_fh, $binmode, $parent_pid, $parent_start_time, $debug, $child_label );
  41 BEGIN {
  42    ( $stdin_fh, $stdout_fh, $debug_fh, $binmode, $parent_pid, $parent_start_time, $debug, $child_label ) = @ARGV;
  43    ## Rather than letting IPC::Run::Debug export all-0 constants
  44    ## when not debugging, we do it manually in order to not even
  45    ## load IPC::Run::Debug.
  46    if ( $debug ) {
  47       eval "use IPC::Run::Debug qw( :default _debug_init ); 1;"
  48          or die $@;
  49    }
  50    else {
  51       eval <<STUBS_END or die $@;
  52          sub _debug {}
  53          sub _debug_init {}
  54          sub _debugging() { 0 }
  55          sub _debugging_data() { 0 }
  56          sub _debugging_details() { 0 }
  57          sub _debugging_gory_details() { 0 }
  58          1;
  59 STUBS_END
  60    }
  61 }
  62
  63 ## For some reason these get created with binmode on.  AAargh, gotta       #### REMOVE
  64 ## do it by hand below.       #### REMOVE
  65 if ( $debug ) {       #### REMOVE
  66 close STDERR;       #### REMOVE
  67 OsFHandleOpen( \*STDERR, $debug_fh, "w" )       #### REMOVE
  68  or print "$! opening STDERR as Win32 handle $debug_fh in pumper $$";       #### REMOVE
  69 }       #### REMOVE
  70 close STDIN;       #### REMOVE
  71 OsFHandleOpen( \*STDIN, $stdin_fh, "r" )       #### REMOVE
  72 or die "$! opening STDIN as Win32 handle $stdin_fh in pumper $$";       #### REMOVE
  73 close STDOUT;       #### REMOVE
  74 OsFHandleOpen( \*STDOUT, $stdout_fh, "w" )       #### REMOVE
  75 or die "$! opening STDOUT as Win32 handle $stdout_fh in pumper $$";       #### REMOVE
  76
  77 binmode STDIN;
  78 binmode STDOUT;
  79 $| = 1;
  80 select STDERR; $| = 1; select STDOUT;
  81
  82 $child_label ||= "pump";
  83 _debug_init(
  84 $parent_pid,
  85 $parent_start_time,
  86 $debug,
  87 fileno STDERR,
  88 $child_label,
  89 );
  90
  91 _debug "Entered" if _debugging_details;
  92
  93 # No need to close all fds; win32 doesn't seem to pass any on to us.
  94 $| = 1;
  95 my $buf;
  96 my $total_count = 0;
  97 while (1) {
  98 my $count = sysread STDIN, $buf, 10_000;
  99 last unless $count;
 100 if ( _debugging_gory_details ) {
 101  my $msg = "'$buf'";
 102  substr( $msg, 100, -1 ) = '...' if length $msg > 100;
 103  $msg =~ s/\n/\\n/g;
 104  $msg =~ s/\r/\\r/g;
 105  $msg =~ s/\t/\\t/g;
 106  $msg =~ s/([\000-\037\177-\277])/sprintf "\0x%02x", ord $1/eg;
 107  _debug sprintf( "%5d chars revc: ", $count ), $msg;
 108 }
 109 $total_count += $count;
 110 $buf =~ s/\r//g unless $binmode;
 111 if ( _debugging_gory_details ) {
 112  my $msg = "'$buf'";
 113  substr( $msg, 100, -1 ) = '...' if length $msg > 100;
 114  $msg =~ s/\n/\\n/g;
 115  $msg =~ s/\r/\\r/g;
 116  $msg =~ s/\t/\\t/g;
 117  $msg =~ s/([\000-\037\177-\277])/sprintf "\0x%02x", ord $1/eg;
 118  _debug sprintf( "%5d chars sent: ", $count ), $msg;
 119 }
 120 print $buf;
 121 }
 122
 123 _debug "Exiting, transferred $total_count chars" if _debugging_details;
 124
 125 ## Perform a graceful socket shutdown.  Windows defaults to SO_DONTLINGER,
 126 ## which should cause a "graceful shutdown in the background" on sockets.
 127 ## but that's only true if the process closes the socket manually, it
 128 ## seems; if the process exits and lets the OS clean up, the OS is not
 129 ## so kind.  STDOUT is not always a socket, of course, but it won't hurt
 130 ## to close a pipe and may even help.  With a closed source OS, who
 131 ## can tell?
 132 ##
 133 ## In any case, this close() is one of the main reasons we have helper
 134 ## processes; if the OS closed socket fds gracefully when an app exits,
 135 ## we'd just redirect the client directly to what is now the pump end
 136 ## of the socket.  As it is, however, we need to let the client play with
 137 ## pipes, which don't have the abort-on-app-exit behavior, and then
 138 ## adapt to the sockets in the helper processes to allow the parent to
 139 ## select.
 140 ##
 141 ## Possible alternatives / improvements:
 142 ##
 143 ## 1) use helper threads instead of processes.  I don't trust perl's threads
 144 ## as of 5.005 or 5.6 enough (which may be myopic of me).
 145 ##
 146 ## 2) figure out if/how to get at WaitForMultipleObjects() with pipe
 147 ## handles.  May be able to take the Win32 handle and pass it to
 148 ## Win32::Event::wait_any, dunno.
 149 ##
 150 ## 3) Use Inline::C or a hand-tooled XS module to do helper threads.
 151 ## This would be faster than #1, but would require a ppm distro.
 152 ##
 153 close STDOUT;
 154 close STDERR;
 155
 156 1;
 157
 158 =pod
 159
 160 =head1 AUTHOR
 161
 162 Barries Slaymaker <barries@slaysys.com>.  Funded by Perforce Software, Inc.
 163
 164 =head1 COPYRIGHT
 165
 166 Copyright 2001, Barrie Slaymaker, All Rights Reserved.
 167
 168 You may use this under the terms of either the GPL 2.0 ir the Artistic License.
 169
 170 =cut