in reply to Win32 fork using open3

finaly found a souloution that works its a bit different from my first approch but it works (in fact the solution is to use a socket and to "poll" the socket yourself ....) something like this :
#!/urs/bin/perl -w use strict; use warnings; use IO::Socket; use Tk; use subs qw/read_sock/; my $mw; my $sel; my $sock; my $text; my $line; my $scriptname = "my_script.pl"; #some Tk $mw = MainWindow->new(); $text = $mw->Text->pack; my $goButton = $mw->Button( -text=> "Accept", -command => \&go )->pack( -side=>"left", ); #"polling" socket $mw->repeat(50 => \&read_sock); MainLoop; sub read_sock{ return unless $sock; my $hand = $sock; my @ready = $sel->can_read(0); return if $#ready == -1; $hand = $ready[0]; my $numbytes = 1; my $buf; sysread $hand, $buf, $numbytes; print "read a $buf\n"; $line .= $buf; if ($buf eq "\n"){ if ($line eq "EOF\n"){ undef $sel; undef $sock; undef $line; return; } $text->insert('end',"$line"); undef $line; } } sub go{ my $ProcessObj; require Win32; require Win32::Process; Win32::Process::Create($ProcessObj, "c:\\perl\\bin\\perl.exe", "perl $scriptname", 0, 0, ".")|| die ErrorReport(); sleep 2; # let the script time to built the socket $sock = IO::Socket::INET->new(PeerAddr=> 'localhost:13579'); die "cannot connect: $!\n" unless defined $sock; use IO::Select; $sel = IO::Select->new(); $sel->add($sock); }
and in $scriptname
#!/usr/bin/perl -w use IO::Socket; use strict; my $socket = IO::Socket::INET->new( Listen => 5, Reuse => 1, LocalPort => 13579, Proto => 'tcp', )||die "couldn't open socket : $!\n"; my $new_socket = $socket -> accept(); #so far so good #if the is $something_to_say syswrite $new_socket, "$something_to_say\n";
and to sigal the end to the parent (since there is no sigchld when using Win32::Process)
END{ syswrite $new_socket, "EOF\n"; }

----
NaSe
:x

Replies are listed 'Best First'.
Re^2: Win32 fork using open3
by particle (Vicar) on Jun 19, 2002 at 12:02 UTC
    i'm sorry i can't look closely at your code now, but after a quick browse i noticed you aren't checking the return codes from sysread and syswrite -- you should.

    ~Particle *accelerates*

      that is right and a good idea ... did u have something like
      my $read_bytes = sysread $hand, $buf, $num_bytes; die "error occured reading from socket : $!\n" unless ($read_bytes && ($read_bytes == $num_bytes));
      and the same for the writing in mind ?

      ----
      NaSe
      :x

        not exactly. from the sysread doc:

        Returns the number of bytes actually read, 0 at end of file, or undef if there was an error.
        this is the full logic, but it can be condensed to fit your needs.

        if( defined $read_bytes ) { if( $read_bytes >= 0 ) { print 'read something'; if( $read_bytes == $num_bytes ) { print 'read full buffer'; } elsif( $read_bytes < $num_bytes ) { print 'buffer length: ', $num_bytes, ' read length: ', $read_by +tes; } else { die 'how did i get here?'; } } elsif( $read_bytes == 0 ) { print 'EOF'; } else { die 'how did i get here?'; } } else { die 'error reading socket'; }

        ~Particle *accelerates*